Better helpers for Purescript's Newtype class

NewtypeHelpers.purs

module Data.Newtype.Helpers
  ( (#<)
  , flipViaR
  , over
  , over''
  , under
  , under''
  , viaR
  , viaR''
  , viaW
  , viaW''
  )
  where

import Contract.Address (ByteArray)
import Contract.Prim.ByteArray (byteArrayToHex)
import Data.Function (const, flip, (<<<))
import Data.Newtype (class Newtype, unwrap, wrap)


over :: forall (w :: Type) (r :: Type). Newtype w r => (r -> r) -> w -> w
over f = wrap <<< f <<< unwrap

over'' :: forall w2 w1 r. Newtype w2 w1 => Newtype w1 r => (r -> r) -> w2 -> w2
over'' = over <<< over

viaR :: forall (a :: Type) (w :: Type) (r :: Type). Newtype w r => (r -> a) -> w -> a
viaR f = f <<< unwrap

flipViaR = flip viaR
infixl 5 flipViaR as #<

flipViaR'' = flip viaR''
infixl 5 flipViaR as #<<

viaR'' :: forall w1 w2 a r. Newtype w2 w1 => Newtype w1 r => (r -> a) -> w2 -> a
viaR'' f = f <<< unwrap <<< unwrap

under :: forall (w :: Type) (r :: Type). Newtype w r => (w -> w) -> r -> r
under f = unwrap <<< f <<< wrap

under'' :: forall w2 w1 r. Newtype w2 w1 => Newtype w1 r => (w2 -> w2) -> r -> r
under'' = under <<< under

viaW :: forall (a :: Type) (w :: Type) (r :: Type). Newtype w r => (w -> a) -> r -> a
viaW f = f <<< wrap

viaW'' :: forall w1 w2 a r. Newtype w2 w1 => Newtype w1 r => (w2 -> a) -> r -> a
viaW'' f = f <<< wrap <<< wrap


-------- A Showcase

---- (#< op)
newtype A = A { bb :: B }
derive instance Newtype A _
newtype B = B { b :: Boolean, s :: String }
derive instance Newtype B _

getN x = x #< _.bb #< _.b

getN' x = x #<< _.bb <<< _.b


---- via representation
newtype CborBytes = CborBytes ByteArray
derive instance Newtype CborBytes _

newtype TxCbor = TxCbor CborBytes
derive instance Newtype TxCbor _

txCborToHex :: TxCbor -> String
txCborToHex = viaR'' byteArrayToHex


---- via wrapper
newtype Email = Email String
derive instance Newtype Email _

validEmail :: Email -> Boolean
validEmail = const false

isValidEmailString :: String -> Boolean
isValidEmailString = viaW validEmail