diff --git a/src/Data/Codec/Argonaut.purs b/src/Data/Codec/Argonaut.purs index d1761e2..39a717b 100644 --- a/src/Data/Codec/Argonaut.purs +++ b/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 diff --git a/src/Data/Codec/Argonaut/Record.purs b/src/Data/Codec/Argonaut/Record.purs index 72ffa90..07af640 100644 --- a/src/Data/Codec/Argonaut/Record.purs +++ b/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,6 +49,13 @@ 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 @@ -46,11 +63,15 @@ record = rowListCodec (Proxy ∷ Proxy rl) -- | 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) diff --git a/test/Test/Record.purs b/test/Test/Record.purs index 3483fb0..fe32c40 100644 --- a/test/Test/Record.purs +++ b/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