add optionalWith

Author: m-bock

src/Data/Codec/Argonaut.purs

@@ -23,6 +23,7 @@ module Data.Codec.Argonaut
   , record
   , recordProp
   , recordPropOptional
+  , recordPropOptionalWith
   , fix
   , named
   , coercible
@@ -32,6 +33,7 @@ module Data.Codec.Argonaut
 
 import Prelude
 
+import Data.Argonaut.Core (Json)
 import Data.Argonaut.Core as J
 import Data.Array as A
 import Data.Bifunctor (bimap, lmap)
@@ -41,7 +43,7 @@ import Data.Codec (Codec(..), Codec', codec, codec', decode, encode, hoist, iden
 import Data.Either (Either(..), note)
 import Data.Generic.Rep (class Generic)
 import Data.Int as I
-import Data.List ((:))
+import Data.List (List, (:))
 import Data.List as L
 import Data.Maybe (Maybe(..), maybe)
 import Data.String as S
@@ -52,7 +54,8 @@ import Data.Tuple (Tuple(..))
 import Foreign.Object as FO
 import Prim.Coerce (class Coercible)
 import Prim.Row as Row
-import Record.Unsafe as Record
+import Record as Record
+import Record.Unsafe as RecordUnsafe
 import Safe.Coerce (coerce)
 import Type.Proxy (Proxy)
 import Unsafe.Coerce (unsafeCoerce)
@@ -264,11 +267,11 @@ recordProp p codecA codecR =
     a ← BF.lmap (AtKey key) case FO.lookup key obj of
       Just val → Codec.decode codecA val
       Nothing → Left MissingValue
-    pure $ Record.unsafeSet key a r
+    pure $ RecordUnsafe.unsafeSet key a r
 
   enc' ∷ String → Record r' → L.List (Tuple String J.Json)
   enc' key val =
-    Tuple key (Codec.encode codecA (Record.unsafeGet key val))
+    Tuple key (Codec.encode codecA (RecordUnsafe.unsafeGet key val))
       : Codec.encode codecR (unsafeForget val)
 
   unsafeForget ∷ Record r' → Record r
@@ -300,18 +303,58 @@ recordPropOptional p codecA codecR = Codec.codec dec' enc'
     a ← BF.lmap (AtKey key) case FO.lookup key obj of
       Just val → Just <$> Codec.decode codecA val
       _ → Right Nothing
-    pure $ Record.unsafeSet key a r
+    pure $ RecordUnsafe.unsafeSet key a r
 
   enc' ∷ Record r' → L.List (Tuple String J.Json)
   enc' val = do
     let w = Codec.encode codecR (unsafeForget val)
-    case Record.unsafeGet key val of
+    case RecordUnsafe.unsafeGet key val of
       Just a → Tuple key (Codec.encode codecA a) : w
       Nothing → w
 
   unsafeForget ∷ Record r' → Record r
   unsafeForget = unsafeCoerce
 
+recordPropOptionalWith
+  ∷ ∀ p a b r r'
+  . IsSymbol p
+  ⇒ Row.Cons p b r r'
+  ⇒ Row.Lacks p r
+  ⇒ Proxy p
+  → (Maybe a → b)
+  → (b → a)
+  → JsonCodec a
+  → JPropCodec (Record r)
+  → JPropCodec (Record r')
+recordPropOptionalWith p normalize denormalize codecA codecR = Codec.codec dec' enc'
+  where
+  key ∷ String
+  key = reflectSymbol p
+
+  dec' ∷ FO.Object J.Json → Either JsonDecodeError (Record r')
+  dec' obj = do
+    r ∷ Record r ← Codec.decode codecR obj
+    b ∷ b ← BF.lmap (AtKey key) case FO.lookup key obj of
+      Just j → do
+        ret ∷ a ← Codec.decode codecA j
+        pure $ normalize (Just ret)
+      Nothing → pure $ normalize Nothing
+    pure $ Record.insert p b r
+
+  enc' ∷ Record r' → L.List (Tuple String J.Json)
+  enc' val = do
+    let
+      w ∷ List (Tuple String Json)
+      w = Codec.encode codecR (unsafeForget val)
+
+      b ∷ b
+      b = Record.get p val
+
+    Tuple key (Codec.encode codecA $ denormalize b) : w
+
+  unsafeForget ∷ Record r' → Record r
+  unsafeForget = unsafeCoerce
+
 jsonPrimCodec ∷ ∀ a. String → (J.Json → Maybe a) → (a → J.Json) → JsonCodec a
 jsonPrimCodec ty f = Codec.codec' (maybe (Left (TypeMismatch ty)) pure <<< f)
 

src/Data/Codec/Argonaut/Record.purs

@@ -48,10 +48,24 @@ record = rowListCodec (Proxy ∷ Proxy rl)
 -- | The property will be omitted when encoding and the value is `Nothing`.
 newtype Optional a = Optional (CA.JsonCodec a)
 
+-- | Like `Optional`, but allows you to provide a function to transform the
+-- | `Maybe a` value into a different type `b`. This is useful when you want to
+-- | provide a default value or perform some other transformation when the
+-- | property is not present in the JSON object.
+newtype OptionalWith a b = OptionalWith
+  { normalize ∷ Maybe a → b
+  , denormalize ∷ b → a
+  , codec ∷ CA.JsonCodec a
+  }
+
 -- | A lowercase alias for `Optional`, provided for stylistic reasons only.
 optional ∷ ∀ a. CA.JsonCodec a → Optional a
 optional = Optional
 
+-- | A lowercase alias for `OptionalWith`, provided for stylistic reasons only.
+optionalWith ∷ ∀ a b. (Maybe a → b) → (b → a) → CA.JsonCodec a → OptionalWith a b
+optionalWith normalize denormalize codec = OptionalWith { normalize, denormalize, codec }
+
 -- | The class used to enable the building of `Record` codecs by providing a
 -- | record of codecs.
 class RowListCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type) | rl → ri ro where
@@ -76,6 +90,25 @@ instance rowListCodecConsOptional ∷
     tail ∷ CA.JPropCodec (Record ro')
     tail = rowListCodec (Proxy ∷ Proxy rs) ((unsafeCoerce ∷ Record ri → Record ri') codecs)
 
+else instance rowListCodecConsOptionalWith ∷
+  ( RowListCodec rs ri' ro'
+  , R.Cons sym (OptionalWith a b) ri' ri
+  , R.Cons sym b ro' ro
+  , R.Lacks sym ro'
+  , R.Lacks sym ri'
+  , IsSymbol sym
+  ) ⇒
+  RowListCodec (RL.Cons sym (OptionalWith a b) rs) ri ro where
+  rowListCodec _ codecs =
+    CA.recordPropOptionalWith (Proxy ∷ Proxy sym) ret.normalize ret.denormalize ret.codec tail
+
+    where
+    ret ∷ { normalize ∷ Maybe a → b, denormalize ∷ b → a, codec ∷ CA.JsonCodec a }
+    ret = coerce (Rec.get (Proxy ∷ Proxy sym) codecs ∷ OptionalWith a b)
+
+    tail ∷ CA.JPropCodec (Record ro')
+    tail = rowListCodec (Proxy ∷ Proxy rs) ((unsafeCoerce ∷ Record ri → Record ri') codecs)
+
 else instance rowListCodecCons ∷
   ( RowListCodec rs ri' ro'
   , R.Cons sym (CA.JsonCodec a) ri' ri