Merge pull request garyb#51 from garyb/optional-record-sugar

Add `Optional` helper for record sugar

Author: garyb

README.md

@@ -35,9 +35,9 @@ decodeStringArray ∷ J.Json → Either CA.JsonDecodeError (Array String)
 decodeStringArray = CA.decode codec
 ```
 
-To parse a serialized `String` into a `J.Json` structure use the [`Parser.jsonParser`](https://pursuit.purescript.org/packages/purescript-argonaut-core/5.1.0/docs/Data.Argonaut.Parser).
+To parse a serialized `String` into a `J.Json` structure use the [`Parser.jsonParser`](https://pursuit.purescript.org/packages/purescript-argonaut-core/docs/Data.Argonaut.Parser).
 
-To /"stringify"/ (serialize) your `Array String` to a serialized JSON `String` we would use the [`stringify`](https://pursuit.purescript.org/packages/purescript-argonaut-core/5.1.0/docs/Data.Argonaut.Core#v:stringify) like so:
+To "stringify" (serialize) your `Array String` to a serialized JSON `String` we would use the [`stringify`](https://pursuit.purescript.org/packages/purescript-argonaut-core/docs/Data.Argonaut.Core#v:stringify) like so:
 
 ```purescript
 import Control.Category ((>>>))
@@ -110,6 +110,33 @@ codec =
       })
 ```
 
+#### Optional properties
+
+Objects with optional properties can be defined using the [`CAR.optional`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Record#v:optional): 
+
+```purescript
+type Person = 
+  { name ∷ String
+  , age ∷ Int
+  , active ∷ Boolean
+  , email ∷ Maybe String
+  }
+
+codec ∷ CA.JsonCodec Person
+codec =
+  CA.object "Person"
+    (CAR.record
+      { name: CA.string
+      , age: CA.int
+      , active: CA.boolean
+      , email: CAR.optional CA.string
+      })
+```
+
+If the value being decoded has no `email` field, the resulting `Person` will have `Nothing` for `email` now rather than failing to decode. When encoding, if an optional value is `Nothing`, the field will be omitted from the resulting JSON object.
+
+This combinator only deals with entirely missing properties, so values like `null` will still need to be handled explicitly.
+
 ### Sum types and variants
 
 This library comes with codec support for [`purescript-variant`](https://github.com/natefaubion/purescript-variant) out of the box and codecs for sums are often based on the variant codec.

src/Data/Codec/Argonaut/Record.purs

@@ -1,11 +1,12 @@
 module Data.Codec.Argonaut.Record where
 
 import Data.Codec.Argonaut as CA
+import Data.Maybe (Maybe)
 import Data.Symbol (class IsSymbol)
 import Prim.Row as R
 import Prim.RowList as RL
 import Record as Rec
-import Type.Equality as TE
+import Safe.Coerce (coerce)
 import Type.Proxy (Proxy(..))
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -38,6 +39,19 @@ record
   → CA.JPropCodec (Record ro)
 record = rowListCodec (Proxy ∷ Proxy rl)
 
+-- | 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)
+
+-- | A lowercase alias for `Optional`, provided for stylistic reasons only.
+optional ∷ ∀ a. CA.JsonCodec a → Optional a
+optional = Optional
+
 -- | 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
@@ -46,19 +60,34 @@ class RowListCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type)
 instance rowListCodecNil ∷ RowListCodec RL.Nil () () where
   rowListCodec _ _ = CA.record
 
-instance rowListCodecCons ∷
+instance rowListCodecConsOptional ∷
+  ( RowListCodec rs ri' ro'
+  , R.Cons sym (Optional a) ri' ri
+  , R.Cons sym (Maybe a) ro' ro
+  , IsSymbol sym
+  ) ⇒
+  RowListCodec (RL.Cons sym (Optional a) rs) ri ro where
+  rowListCodec _ codecs =
+    CA.recordPropOptional (Proxy ∷ Proxy sym) codec tail
+    where
+    codec ∷ CA.JsonCodec a
+    codec = coerce (Rec.get (Proxy ∷ Proxy sym) codecs ∷ Optional a)
+
+    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
   , R.Cons sym a ro' ro
   , IsSymbol sym
-  , TE.TypeEquals co (CA.JsonCodec a)
   ) ⇒
-  RowListCodec (RL.Cons sym co rs) ri ro where
+  RowListCodec (RL.Cons sym (CA.JsonCodec a) rs) ri ro where
   rowListCodec _ codecs =
     CA.recordProp (Proxy ∷ Proxy sym) codec tail
     where
     codec ∷ CA.JsonCodec a
-    codec = TE.from (Rec.get (Proxy ∷ Proxy sym) codecs)
+    codec = Rec.get (Proxy ∷ Proxy sym) codecs
 
     tail ∷ CA.JPropCodec (Record ro')
     tail = rowListCodec (Proxy ∷ Proxy rs) ((unsafeCoerce ∷ Record ri → Record ri') codecs)

test/Test/Record.purs

@@ -5,15 +5,18 @@ import Prelude
 import Control.Monad.Gen as Gen
 import Control.Monad.Gen.Common as GenC
 import Data.Argonaut.Core (stringify)
-import Data.Codec.Argonaut.Common as JA
-import Data.Codec.Argonaut.Record as JAR
-import Data.Maybe (Maybe(..))
+import Data.Argonaut.Core as Json
+import Data.Codec.Argonaut.Common as CA
+import Data.Codec.Argonaut.Record as CAR
+import Data.Maybe (Maybe(..), fromJust)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Profunctor (dimap)
 import Data.String.Gen (genAsciiString)
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck)
+import Foreign.Object as Object
+import Partial.Unsafe (unsafePartial)
+import Test.QuickCheck (assertEquals, quickCheck, quickCheckGen)
 import Test.QuickCheck.Gen (Gen)
 import Test.Util (genInt, propCodec)
 
@@ -26,14 +29,15 @@ type OuterR =
 type InnerR =
   { n ∷ Int
   , m ∷ Boolean
+  , o ∷ Maybe Boolean
   }
 
 newtype Outer = Outer OuterR
 
 derive instance newtypeOuter ∷ Newtype Outer _
 
 instance showOuter ∷ Show Outer where
-  show (Outer r) = "Outer " <> stringify (JA.encode outerCodec r)
+  show (Outer r) = "Outer " <> stringify (CA.encode outerCodec r)
 
 instance eqOuter ∷ Eq Outer where
   eq (Outer o1) (Outer o2) =
@@ -44,19 +48,20 @@ instance eqOuter ∷ Eq Outer where
         Just i1, Just i2 → i1.n == i2.n && i1.m == i2.m
         _, _ → false
 
-outerCodec ∷ JA.JsonCodec OuterR
+outerCodec ∷ CA.JsonCodec OuterR
 outerCodec =
-  JA.object "Outer" $ JAR.record
-    { a: JA.int
-    , b: JA.string
-    , c: JA.maybe innerCodec
+  CA.object "Outer" $ CAR.record
+    { a: CA.int
+    , b: CA.string
+    , c: CA.maybe innerCodec
     }
 
-innerCodec ∷ JA.JsonCodec InnerR
+innerCodec ∷ CA.JsonCodec InnerR
 innerCodec =
-  JA.object "Inner" $ JAR.record
-    { n: JA.int
-    , m: JA.boolean
+  CA.object "Inner" $ CAR.record
+    { n: CA.int
+    , m: CA.boolean
+    , o: CAR.optional CA.boolean
     }
 
 genOuter ∷ Gen OuterR
@@ -70,9 +75,25 @@ genInner ∷ Gen InnerR
 genInner = do
   n ← genInt
   m ← Gen.chooseBool
-  pure { n, m }
+  o ← GenC.genMaybe Gen.chooseBool
+  pure { n, m, o }
 
 main ∷ Effect Unit
 main = do
   log "Checking record codec"
   quickCheck $ propCodec (Outer <$> genOuter) (dimap unwrap wrap outerCodec)
+
+  log "Check optional Nothing is missing from json"
+  quickCheckGen do
+    v ← genInner
+    let obj = unsafePartial $ fromJust $ Json.toObject $ CA.encode innerCodec (v { o = Nothing })
+    pure $ assertEquals [ "m", "n" ] (Object.keys obj)
+
+  log "Check optional Just is present in the json"
+  quickCheckGen do
+    b ← Gen.chooseBool
+    v ← genInner
+    let obj = unsafePartial $ fromJust $ Json.toObject $ CA.encode innerCodec (v { o = Just b })
+    pure $ assertEquals [ "m", "n", "o" ] (Object.keys obj)
+
+  pure unit