optionalWith: A generalized optional modifier.

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
@@ -285,27 +288,49 @@ recordPropOptional
   ∷ ∀ p a r r'
   . IsSymbol p
   ⇒ Row.Cons p (Maybe a) r r'
+  ⇒ Row.Lacks p r
   ⇒ Proxy p
   → JsonCodec a
   → JPropCodec (Record r)
   → JPropCodec (Record r')
-recordPropOptional p codecA codecR = Codec.codec dec' enc'
+recordPropOptional = recordPropOptionalWith identity identity
+
+recordPropOptionalWith
+  ∷ ∀ p a b r r'
+  . IsSymbol p
+  ⇒ Row.Cons p b r r'
+  ⇒ Row.Lacks p r
+  ⇒ (Maybe a → b)
+  → (b → Maybe a)
+  → Proxy p
+  → JsonCodec a
+  → JPropCodec (Record r)
+  → JPropCodec (Record r')
+recordPropOptionalWith normalize denormalize p 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 ← Codec.decode codecR obj
-    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
+    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 = Codec.encode codecR (unsafeForget val)
-    case Record.unsafeGet key val of
+    let
+      w ∷ List (Tuple String Json)
+      w = Codec.encode codecR (unsafeForget val)
+
+      b ∷ b
+      b = Record.get p val
+
+    case denormalize b of
       Just a → Tuple key (Codec.encode codecA a) : w
       Nothing → w
 

src/Data/Codec/Argonaut/Record.purs

@@ -1,6 +1,16 @@
-module Data.Codec.Argonaut.Record where
+module Data.Codec.Argonaut.Record
+  ( OptionalWith
+  , class RowListCodec
+  , object
+  , optional
+  , optionalWith
+  , record
+  , rowListCodec
+  )
+  where
 
 import Data.Codec.Argonaut as CA
+import Data.Function (identity)
 import Data.Maybe (Maybe)
 import Data.Symbol (class IsSymbol)
 import Prim.Row as R
@@ -39,18 +49,29 @@ record
   → CA.JPropCodec (Record ro)
 record = rowListCodec (Proxy ∷ Proxy rl)
 
+
+newtype OptionalWith a b = OptionalWith
+  { normalize ∷ Maybe a → b
+  , denormalize ∷ b → Maybe a
+  , codec ∷ CA.JsonCodec a
+  }
+
 -- | Used to wrap codec values provided in `record` to indicate the field is optional.
 -- |
 -- | This will only decode the property as `Nothing` if the field does not exist
 -- | in the object - having a values such as `null` assigned will need handling
 -- | separately.
 -- |
 -- | The property will be omitted when encoding and the value is `Nothing`.
-newtype Optional a = Optional (CA.JsonCodec a)
+optional ∷ ∀ a. CA.JsonCodec a → OptionalWith a (Maybe a)
+optional = optionalWith identity identity
 
--- | A lowercase alias for `Optional`, provided for stylistic reasons only.
-optional ∷ ∀ a. CA.JsonCodec a → Optional a
-optional = Optional
+-- | Like `Optional`, but more general. It 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.
+optionalWith ∷ ∀ a b. (Maybe a → b) → (b → Maybe 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.
@@ -60,18 +81,21 @@ class RowListCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type)
 instance rowListCodecNil ∷ RowListCodec RL.Nil () () where
   rowListCodec _ _ = CA.record
 
-instance rowListCodecConsOptional ∷
+instance rowListCodecConsOptionalWith ∷
   ( RowListCodec rs ri' ro'
-  , R.Cons sym (Optional a) ri' ri
-  , R.Cons sym (Maybe a) ro' 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 (Optional a) rs) ri ro where
+  RowListCodec (RL.Cons sym (OptionalWith a b) rs) ri ro where
   rowListCodec _ codecs =
-    CA.recordPropOptional (Proxy ∷ Proxy sym) codec tail
+    CA.recordPropOptionalWith ret.normalize ret.denormalize (Proxy ∷ Proxy sym) ret.codec tail
+
     where
-    codec ∷ CA.JsonCodec a
-    codec = coerce (Rec.get (Proxy ∷ Proxy sym) codecs ∷ Optional a)
+    ret ∷ { normalize ∷ Maybe a → b, denormalize ∷ b → Maybe 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)

test/Test/Record.purs

@@ -7,8 +7,9 @@ import Control.Monad.Gen.Common as GenC
 import Data.Argonaut.Core (stringify)
 import Data.Argonaut.Core as Json
 import Data.Codec.Argonaut.Common as CA
+import Data.Codec.Argonaut.Common as Car
 import Data.Codec.Argonaut.Record as CAR
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Profunctor (dimap)
 import Data.String.Gen (genAsciiString)
@@ -31,6 +32,11 @@ type InnerR =
   , o ∷ Maybe Boolean
   }
 
+type Sample =
+  { p ∷ Int
+  , q ∷ Boolean
+  }
+
 newtype Outer = Outer OuterR
 
 derive instance newtypeOuter ∷ Newtype Outer _
@@ -59,10 +65,17 @@ innerCodec ∷ CA.JsonCodec InnerR
 innerCodec =
   CA.object "Inner" $ CAR.record
     { n: CA.int
-    , m: CA.boolean
+    , m: Car.boolean
     , o: CAR.optional CA.boolean
     }
 
+sampleCodec ∷ CA.JsonCodec Sample
+sampleCodec =
+  CA.object "Sample" $ CAR.record
+    { p: CA.int
+    , q: CAR.optionalWith (fromMaybe false) (if _ then Just true else Nothing) CA.boolean
+    }
+
 genOuter ∷ Gen OuterR
 genOuter = do
   a ← genInt
@@ -77,6 +90,12 @@ genInner = do
   o ← GenC.genMaybe Gen.chooseBool
   pure { n, m, o }
 
+genSample ∷ Gen Sample
+genSample = do
+  p ← genInt
+  q ← Gen.chooseBool
+  pure { p, q }
+
 main ∷ Effect Unit
 main = do
   log "Checking record codec"
@@ -95,4 +114,16 @@ main = do
     let obj = Json.toObject $ CA.encode innerCodec (v { o = Just b })
     pure $ assertEquals (Just [ "m", "n", "o" ]) (Object.keys <$> obj)
 
+  log "Check `false` is not present in the json"
+  quickCheckGen do
+    v ← genSample
+    let obj = Json.toObject $ CA.encode sampleCodec (v { q = false })
+    pure $ assertEquals (Just [ "p" ]) (Object.keys <$> obj)
+
+  log "Check `true` is present in the json"
+  quickCheckGen do
+    v ← genSample
+    let obj = Json.toObject $ CA.encode sampleCodec (v { q = true })
+    pure $ assertEquals (Just [ "p", "q" ]) (Object.keys <$> obj)
+
   pure unit