Code reuse

Author: m-bock

src/Data/Codec/Argonaut.purs

@@ -288,45 +288,25 @@ 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'
-  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 $ 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 RecordUnsafe.unsafeGet key val of
-      Just a → Tuple key (Codec.encode codecA a) : w
-      Nothing → w
-
-  unsafeForget ∷ Record r' → Record r
-  unsafeForget = unsafeCoerce
+recordPropOptional = recordPropOptionalWith identity identity
 
 recordPropOptionalWith
   ∷ ∀ p a b r r'
   . IsSymbol p
   ⇒ Row.Cons p b r r'
   ⇒ Row.Lacks p r
-  ⇒ Proxy p
-  → (Maybe a → b)
+  ⇒ (Maybe a → b)
   → (b → Maybe a)
+  → Proxy p
   → JsonCodec a
   → JPropCodec (Record r)
   → JPropCodec (Record r')
-recordPropOptionalWith p normalize denormalize codecA codecR = Codec.codec dec' enc'
+recordPropOptionalWith normalize denormalize p codecA codecR = Codec.codec dec' enc'
   where
   key ∷ String
   key = reflectSymbol p

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,30 +49,27 @@ 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
 
--- | Like `Optional`, but allows you to provide a function to transform the
+-- | 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.
-newtype OptionalWith a b = OptionalWith
-  { normalize ∷ Maybe a → b
-  , denormalize ∷ b → Maybe 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 → Maybe a) → CA.JsonCodec a → OptionalWith a b
 optionalWith normalize denormalize codec = OptionalWith { normalize, denormalize, codec }
 
@@ -74,23 +81,7 @@ class RowListCodec (rl ∷ RL.RowList Type) (ri ∷ Row Type) (ro ∷ Row Type)
 instance rowListCodecNil ∷ RowListCodec RL.Nil () () where
   rowListCodec _ _ = CA.record
 
-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 rowListCodecConsOptionalWith ∷
+instance rowListCodecConsOptionalWith ∷
   ( RowListCodec rs ri' ro'
   , R.Cons sym (OptionalWith a b) ri' ri
   , R.Cons sym b ro' ro
@@ -100,7 +91,7 @@ else instance rowListCodecConsOptionalWith ∷
   ) ⇒
   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
+    CA.recordPropOptionalWith ret.normalize ret.denormalize (Proxy ∷ Proxy sym) ret.codec tail
 
     where
     ret ∷ { normalize ∷ Maybe a → b, denormalize ∷ b → Maybe a, codec ∷ CA.JsonCodec a }

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