diff --git a/README.md b/README.md index 719e6d9..995aa0c 100644 --- a/README.md +++ b/README.md @@ -141,9 +141,57 @@ If the value being decoded has no `email` field, the resulting `Person` will hav This combinator only deals with entirely missing properties, so values like `null` will still need to be handled explicitly. -### Sum types and variants +### Sum types -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. +Codecs for sum types can be easily defined by using the [`sum`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Sum#v:sum) function. You need to provide a record of the case constructor names, whereas each record value holds a (nested) tuple of codecs for the constructor fields. + +Let's look at an example sum type, it has 3 constructors. The first one has zero fields, the seconds has one field and the third one has three fields. + +```purescript +data Sample + = Foo + | Bar Int + | Baz Boolean String Int + +derive instance Generic Sample _ +``` + +A simple codec for `Sample` can be created like this in a type safe way: + +```purescript +import Data.Codec.Argonaut.Sum as CAS +import Data.Codec.Argonaut as CA + +codecSample ∷ JsonCodec Sample +codecSample = CAS.sum "Sample" + { "Foo": unit + , "Bar": CA.int + , "Baz": CA.boolean /\ CA.string /\ CA.int + } +``` + +The special case of a constructor with zero arguments like `Foo`, we just use `unit` instead of a tuple. + +#### Custom encodings + +If you need control of the actual encoding being used, there's also [`sumWith`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Sum.Sum#v:sumWith). It takes an extra argument of type [`Encoding`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Sum#v:Encoding) + +Generally two types of encodings are supported: + +- Nested + `{"Baz": [true, "abc", 42]}` +- Tagged + `{"tag": "Baz", "values": [true, "abc", 42]}` + +There are also a couple of extra options that can be specified. E.g. for custom field names instead of `"tag"` and `"value"`. + +#### Sum types with only nullary constructors + +If you have a sum type that only consists of nullary constructors and it has a [`Generic`](https://pursuit.purescript.org/packages/purescript-generics-rep/docs/Data.Generic.Rep#t:Generic) instance defined, [`nullarySum`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Generic#v:nullarySum) provided by [`Data.Codec.Argonaut.Generic`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Generic) can generate a codec that will encode the constructors as string values matching the constructor names in the JSON. + +### Variant types + +This library comes with codec support for [`purescript-variant`](https://github.com/natefaubion/purescript-variant) out of the box. First of all, variants. Similar to the object/record case there are a few options for defining variant codecs, but most commonly they will be defined with [`variantMatch`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Variant#v:variantMatch) provided by [`Data.Codec.Argonaut.Variant`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Variant): @@ -179,44 +227,6 @@ The variant codec is a little opinionated since there's no exactly corresponding `value` will be omitted for nullary / `Left`-defined constructors. At the moment it is not possible to customise the encoding for variant types, so they may not be suitable if you are not in control of the serialization format. -Sum type encoding is usually handled by building a variant codec, and then using [`dimap`](https://pursuit.purescript.org/packages/purescript-profunctor/docs/Data.Profunctor#v:dimap) to inject into/project out of a corresponding sum type: - -```purescript -import Prelude - -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Variant as CAV -import Data.Either (Either(..)) -import Data.Profunctor (dimap) -import Data.Variant as V -import Type.Proxy (Proxy(..)) - -data SomeValue2 = Str String | Int Int | Neither - -codec ∷ CA.JsonCodec SomeValue2 -codec = - dimap toVariant fromVariant $ CAV.variantMatch - { str: Right CA.string - , int: Right CA.int - , neither: Left unit - } - where - toVariant = case _ of - Str s → V.inj (Proxy ∷ _ "str") s - Int i → V.inj (Proxy ∷ _ "int") i - Neither → V.inj (Proxy ∷ _ "neither") unit - fromVariant = V.match - { str: Str - , int: Int - , neither: \_ → Neither - } -``` - -This certainly is a little boilerplate-y, but at least when defining codecs this way you do gain the benefits of having a single definition that aligns the encoding and decoding behaviour. This means, assuming there are no mixups in `toVariant`/`fromVariant`, the guaranteed roundtripping is preserved. Often it's not even possible to have mixups during `dimap`, since the sum constructor types will all differ. - -If you have a sum type that only consists of nullary constructors and it has a [`Generic`](https://pursuit.purescript.org/packages/purescript-generics-rep/docs/Data.Generic.Rep#t:Generic) instance defined, [`nullarySum`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Generic#v:nullarySum) provided by [`Data.Codec.Argonaut.Generic`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Generic) can generate a codec that will encode the constructors as string values matching the constructor names in the JSON. - -The story for sum type codecs outside of these options isn't great just now. There are some functions provided in [`Data.Codec.Argonaut.Sum`](https://pursuit.purescript.org/packages/purescript-codec-argonaut/docs/Data.Codec.Argonaut.Sum) for defining them, but these are more error prone than the variant method, and use the same encoding methods described above. Often it's just as easy to construct a codec from scratch with [`basicCodec`](https://pursuit.purescript.org/packages/purescript-codec/docs/Data.Codec#v:basicCodec) from [`Data.Codec`](https://pursuit.purescript.org/packages/purescript-codec/docs/Data.Codec), although means it's up to you to ensure the roundtrip succeeds. ### Other common types diff --git a/src/Data/Codec/Argonaut/Sum.purs b/src/Data/Codec/Argonaut/Sum.purs index d1415d4..607125e 100644 --- a/src/Data/Codec/Argonaut/Sum.purs +++ b/src/Data/Codec/Argonaut/Sum.purs @@ -1,19 +1,45 @@ module Data.Codec.Argonaut.Sum - ( enumSum + ( Encoding(..) + , class GCases + , class GFields + , defaultEncoding + , enumSum + , gCasesDecode + , gCasesEncode + , gFieldsDecode + , gFieldsEncode + , sum + , sumWith , taggedSum ) where import Prelude -import Data.Argonaut.Core as J +import Control.Alt ((<|>)) +import Data.Argonaut.Core (Json) +import Data.Argonaut.Core (Json, fromString) as J +import Data.Array (catMaybes) +import Data.Array as Array import Data.Bifunctor (lmap) +import Data.Codec (codec', encode) import Data.Codec as Codec +import Data.Codec.Argonaut (JsonCodec, JsonDecodeError(..), jobject) import Data.Codec.Argonaut as CA -import Data.Either (Either(..)) +import Data.Either (Either(..), note) +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) import Data.Maybe (Maybe(..), maybe) +import Data.Profunctor (dimap) +import Data.Symbol (class IsSymbol, reflectSymbol) import Data.Tuple (Tuple(..)) +import Data.Tuple.Nested (type (/\), (/\)) +import Foreign.Object (Object) import Foreign.Object as FO +import Foreign.Object as Obj import Foreign.Object.ST as FOST +import Prim.Row as Row +import Record as Record +import Type.Proxy (Proxy(..)) +import Unsafe.Coerce (unsafeCoerce) -- | A helper for defining JSON codecs for "enum" sum types, where every -- | constructor is nullary, and the type will be encoded as a string. @@ -70,3 +96,304 @@ taggedSum name printTag parseTag f g = Codec.codec decodeCase encodeCase obj ← FOST.new _ ← FOST.poke "tag" (Codec.encode CA.string (printTag tag)) obj maybe (pure obj) (\v → FOST.poke "value" v obj) value + +-------------------------------------------------------------------------------- + +data Encoding + = EncodeNested + { unwrapSingleArguments ∷ Boolean } + | EncodeTagged + { tagKey ∷ String + , valuesKey ∷ String + , omitEmptyArguments ∷ Boolean + , unwrapSingleArguments ∷ Boolean + } + +defaultEncoding ∷ Encoding +defaultEncoding = EncodeTagged + { tagKey: "tag" + , valuesKey: "values" + , unwrapSingleArguments: false + , omitEmptyArguments: false + } + +-------------------------------------------------------------------------------- + +sum ∷ ∀ r rep a. Generic a rep ⇒ GCases r rep ⇒ String → Record r → JsonCodec a +sum = sumWith defaultEncoding + +sumWith ∷ ∀ r rep a. GCases r rep ⇒ Generic a rep ⇒ Encoding → String → Record r → JsonCodec a +sumWith encoding name r = + dimap from to $ codec' decode encode + where + decode = gCasesDecode encoding r >>> (lmap $ Named name) + encode = gCasesEncode encoding r + +-------------------------------------------------------------------------------- + +class GCases ∷ Row Type → Type → Constraint +class + GCases r rep + where + gCasesEncode ∷ Encoding → Record r → rep → Json + gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError rep + +instance gCasesConstructorNoArgs ∷ + ( Row.Cons name Unit () r + , IsSymbol name + ) ⇒ + GCases r (Constructor name NoArguments) where + gCasesEncode ∷ Encoding → Record r → Constructor name NoArguments → Json + gCasesEncode encoding _ _ = + let + name = reflectSymbol @name Proxy ∷ String + in + encodeSumCase encoding name [] + + gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name NoArguments) + gCasesDecode encoding _ json = do + let name = reflectSymbol @name Proxy ∷ String + + parseNoFields encoding json name + pure $ Constructor NoArguments + +else instance gCasesConstructorSingleArg ∷ + ( Row.Cons name (JsonCodec a) () r + , IsSymbol name + ) ⇒ + GCases r (Constructor name (Argument a)) where + gCasesEncode ∷ Encoding → Record r → Constructor name (Argument a) → Json + gCasesEncode encoding r (Constructor (Argument x)) = + let + codec = Record.get (Proxy @name) r ∷ JsonCodec a + name = reflectSymbol @name Proxy ∷ String + in + encodeSumCase encoding name [ CA.encode codec x ] + + gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name (Argument a)) + gCasesDecode encoding r json = do + let name = reflectSymbol @name Proxy ∷ String + + field ← parseSingleField encoding json name ∷ _ Json + let codec = Record.get (Proxy @name) r ∷ JsonCodec a + result ← CA.decode codec field ∷ _ a + pure $ Constructor (Argument result) + +else instance gCasesConstructorManyArgs ∷ + ( Row.Cons name codecs () r + , GFields codecs args + , IsSymbol name + ) ⇒ + GCases r (Constructor name args) where + gCasesEncode ∷ Encoding → Record r → Constructor name args → Json + gCasesEncode encoding r (Constructor rep) = + let + codecs = Record.get (Proxy @name) r ∷ codecs + name = reflectSymbol @name Proxy ∷ String + jsons = gFieldsEncode encoding codecs rep ∷ Array Json + in + encodeSumCase encoding name jsons + + gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name args) + gCasesDecode encoding r json = do + let name = reflectSymbol @name Proxy ∷ String + + jsons ← parseManyFields encoding json name ∷ _ (Array Json) + let codecs = Record.get (Proxy @name) r ∷ codecs + result ← gFieldsDecode encoding codecs jsons ∷ _ args + pure $ Constructor result + +instance gCasesSum ∷ + ( GCases r1 (Constructor name lhs) + , GCases r2 rhs + , Row.Cons name codecs1 () r1 + , Row.Cons name codecs1 r2 r + , Row.Union r1 r2 r + , Row.Lacks name r2 + , IsSymbol name + ) ⇒ + GCases r (Sum (Constructor name lhs) rhs) where + gCasesEncode ∷ Encoding → Record r → Sum (Constructor name lhs) rhs → Json + gCasesEncode encoding r = + let + codecs1 = Record.get (Proxy @name) r ∷ codecs1 + r1 = Record.insert (Proxy @name) codecs1 {} ∷ Record r1 + r2 = unsafeDelete (Proxy @name) r ∷ Record r2 + in + case _ of + Inl lhs → gCasesEncode encoding r1 lhs + Inr rhs → gCasesEncode encoding r2 rhs + + gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Sum (Constructor name lhs) rhs) + gCasesDecode encoding r tagged = do + let + codecs1 = Record.get (Proxy @name) r ∷ codecs1 + r1 = Record.insert (Proxy @name) codecs1 {} ∷ Record r1 + r2 = Record.delete (Proxy @name) r ∷ Record r2 + let + lhs = gCasesDecode encoding r1 tagged ∷ _ (Constructor name lhs) + rhs = gCasesDecode encoding r2 tagged ∷ _ rhs + (Inl <$> lhs) <|> (Inr <$> rhs) + +-------------------------------------------------------------------------------- + +class GFields ∷ Type → Type → Constraint +class GFields codecs rep where + gFieldsEncode ∷ Encoding → codecs → rep → Array Json + gFieldsDecode ∷ Encoding → codecs → Array Json → Either JsonDecodeError rep + +instance gFieldsArgument ∷ GFields (JsonCodec a) (Argument a) where + gFieldsEncode ∷ Encoding → JsonCodec a → Argument a → Array Json + gFieldsEncode _ codec (Argument val) = [ CA.encode codec val ] + + gFieldsDecode ∷ Encoding → JsonCodec a → Array Json → Either JsonDecodeError (Argument a) + gFieldsDecode _ codec jsons = do + json ← + ( case jsons of + [ head ] → pure head + _ → Left $ TypeMismatch "Expecting exactly one element" + ) ∷ _ Json + res ← CA.decode codec json ∷ _ a + pure $ Argument res + +instance gFieldsProduct ∷ + ( GFields codec rep + , GFields codecs reps + ) ⇒ + GFields (codec /\ codecs) (Product rep reps) where + gFieldsEncode ∷ Encoding → (codec /\ codecs) → Product rep reps → Array Json + gFieldsEncode encoding (codec /\ codecs) (Product rep reps) = + let + r1 = gFieldsEncode encoding codec rep ∷ Array Json + r2 = gFieldsEncode encoding codecs reps ∷ Array Json + in + r1 <> r2 + + gFieldsDecode ∷ Encoding → (codec /\ codecs) → Array Json → Either JsonDecodeError (Product rep reps) + gFieldsDecode encoding (codec /\ codecs) jsons = do + { head, tail } ← + (Array.uncons jsons # note (TypeMismatch "Expecting at least one element")) + ∷ _ { head ∷ Json, tail ∷ Array Json } + rep ← gFieldsDecode encoding codec [ head ] ∷ _ rep + reps ← gFieldsDecode encoding codecs tail ∷ _ reps + pure $ Product rep reps + +-------------------------------------------------------------------------------- + +checkTag ∷ String → Object Json → String → Either JsonDecodeError Unit +checkTag tagKey obj expectedTag = do + val ← + ( Obj.lookup tagKey obj + # note (TypeMismatch ("Expecting a tag property `" <> tagKey <> "`")) + ) ∷ _ Json + tag ← CA.decode CA.string val ∷ _ String + unless (tag == expectedTag) + $ Left + $ TypeMismatch ("Expecting tag `" <> expectedTag <> "`, got `" <> tag <> "`") + +parseNoFields ∷ Encoding → Json → String → Either JsonDecodeError Unit +parseNoFields encoding json expectedTag = + case encoding of + EncodeNested {} → do + obj ← CA.decode jobject json + val ← + ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) + ) ∷ _ Json + fields ← CA.decode CA.jarray val ∷ _ (Array Json) + when (fields /= []) + $ Left + $ TypeMismatch "Expecting an empty array" + + EncodeTagged { tagKey, valuesKey, omitEmptyArguments } → do + obj ← CA.decode jobject json + checkTag tagKey obj expectedTag + when (not omitEmptyArguments) do + val ← + ( Obj.lookup valuesKey obj + # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) + ) ∷ _ Json + fields ← CA.decode CA.jarray val ∷ _ (Array Json) + when (fields /= []) + $ Left + $ TypeMismatch "Expecting an empty array" + +parseSingleField ∷ Encoding → Json → String → Either JsonDecodeError Json +parseSingleField encoding json expectedTag = case encoding of + EncodeNested { unwrapSingleArguments } → do + obj ← CA.decode jobject json + val ← + ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) + ) ∷ _ Json + if unwrapSingleArguments then + pure val + else do + fields ← CA.decode CA.jarray val + case fields of + [ head ] → pure head + _ → Left $ TypeMismatch "Expecting exactly one element" + + EncodeTagged { tagKey, valuesKey, unwrapSingleArguments } → do + obj ← CA.decode jobject json + checkTag tagKey obj expectedTag + val ← + ( Obj.lookup valuesKey obj + # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) + ) ∷ _ Json + if unwrapSingleArguments then + pure val + else do + fields ← CA.decode CA.jarray val + case fields of + [ head ] → pure head + _ → Left $ TypeMismatch "Expecting exactly one element" + +parseManyFields ∷ Encoding → Json → String → Either JsonDecodeError (Array Json) +parseManyFields encoding json expectedTag = + case encoding of + EncodeNested {} → do + obj ← CA.decode jobject json + val ← + ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) + ) ∷ _ Json + CA.decode CA.jarray val + + EncodeTagged { tagKey, valuesKey } → do + obj ← CA.decode jobject json + checkTag tagKey obj expectedTag + val ← + ( Obj.lookup valuesKey obj + # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) + ) ∷ _ Json + CA.decode CA.jarray val + +encodeSumCase ∷ Encoding → String → Array Json → Json +encodeSumCase encoding tag jsons = + case encoding of + EncodeNested { unwrapSingleArguments } → + let + val = case jsons of + [] → CA.encode CA.jarray [] + [ json ] | unwrapSingleArguments → json + manyJsons → CA.encode CA.jarray manyJsons + in + encode jobject $ Obj.fromFoldable + [ tag /\ val + ] + + EncodeTagged { tagKey, valuesKey, unwrapSingleArguments, omitEmptyArguments } → + let + tagEntry = + Just (tagKey /\ CA.encode CA.string tag) ∷ Maybe (String /\ Json) + valEntry = + case jsons of + [] | omitEmptyArguments → Nothing + [ json ] | unwrapSingleArguments → Just (valuesKey /\ json) + manyJsons → Just (valuesKey /\ CA.encode CA.jarray manyJsons) + in + encode jobject $ Obj.fromFoldable $ catMaybes + [ tagEntry, valEntry ] + +-- | Same as `Record.delete` but deleting only happens at the type level +-- | and the value is left untouched. +unsafeDelete ∷ ∀ r1 r2 l a. IsSymbol l ⇒ Row.Lacks l r1 ⇒ Row.Cons l a r1 r2 ⇒ Proxy l → Record r2 → Record r1 +unsafeDelete _ r = unsafeCoerce r \ No newline at end of file diff --git a/test/Test/Main.purs b/test/Test/Main.purs index adce659..659d819 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -10,6 +10,7 @@ import Test.Generic as Generic import Test.Migration as Migration import Test.Prim as TestPrim import Test.Record as Record +import Test.Sum as Sum import Test.Variant as Variant main ∷ Effect Unit @@ -32,6 +33,10 @@ main = do log "" log "Checking Record codecs" log "------------------------------------------------------------" + Sum.main + log "" + log "Checking Sume codecs" + log "------------------------------------------------------------" Record.main log "" log "Checking Migration codecs" diff --git a/test/Test/Sum.purs b/test/Test/Sum.purs new file mode 100644 index 0000000..fd1ff6e --- /dev/null +++ b/test/Test/Sum.purs @@ -0,0 +1,317 @@ +module Test.Sum where + +import Prelude + +import Control.Monad.Error.Class (liftEither) +import Data.Argonaut.Core (stringifyWithIndent) +import Data.Argonaut.Decode (parseJson) +import Data.Bifunctor (lmap) +import Data.Codec (decode, encode) +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as C +import Data.Codec.Argonaut.Sum (Encoding(..), defaultEncoding, sumWith) +import Data.Generic.Rep (class Generic) +import Data.Show.Generic (genericShow) +import Data.String as Str +import Data.Tuple.Nested ((/\)) +import Effect (Effect) +import Effect.Console (log) +import Effect.Exception (error, throw) +import Test.QuickCheck (quickCheck) +import Test.QuickCheck.Arbitrary (genericArbitrary) +import Test.QuickCheck.Gen (Gen) +import Test.Util (propCodec) + +data Sample + = Foo + | Bar Int + | Baz Boolean String Int + +derive instance Generic Sample _ +derive instance Eq Sample + +genMySum ∷ Gen Sample +genMySum = genericArbitrary + +instance Show Sample where + show = genericShow + +codecSample ∷ Encoding → JsonCodec Sample +codecSample encoding = sumWith encoding "Sample" + { "Foo": unit + , "Bar": C.int + , "Baz": C.boolean /\ C.string /\ C.int + } + +check ∷ ∀ a. Show a ⇒ Eq a ⇒ JsonCodec a → a → String → Effect Unit +check codec val expectEncoded = do + let encodedStr = stringifyWithIndent 2 $ encode codec val + when (encodedStr /= expectEncoded) $ + throw ("check failed, expected: " <> expectEncoded <> ", got: " <> encodedStr) + + json ← liftEither $ lmap (show >>> error) $ parseJson encodedStr + + decoded ← liftEither $ lmap (show >>> error) $ decode codec json + + when (decoded /= val) $ + throw ("check failed, expected: " <> show val <> ", got: " <> show decoded) + +main ∷ Effect Unit +main = do + log "Check sum" + + log " - Default encoding" + do + + -- Encode/Decode constructor without arguments + check (codecSample defaultEncoding) Foo + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Foo\"," + , " \"values\": []" + , "}" + ] + + -- Encode/Decode constructor with single argument + check (codecSample defaultEncoding) (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Bar\"," + , " \"values\": [" + , " 42" + , " ]" + , "}" + ] + + -- Encode/Decode constructor with multiple arguments + check (codecSample defaultEncoding) (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Baz\"," + , " \"values\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + log " - EncodeTagged" + do + log " - Custom tag and values keys" + do + let + opts = EncodeTagged + { tagKey: "customTag" + , valuesKey: "customValues" + , omitEmptyArguments: false + , unwrapSingleArguments: false + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"customTag\": \"Foo\"," + , " \"customValues\": []" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"customTag\": \"Bar\"," + , " \"customValues\": [" + , " 42" + , " ]" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"customTag\": \"Baz\"," + , " \"customValues\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + log " - Option: Omit empty arguments" + do + let + opts = EncodeTagged + { tagKey: "tag" + , valuesKey: "values" + , omitEmptyArguments: true + , unwrapSingleArguments: false + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Foo\"" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Bar\"," + , " \"values\": [" + , " 42" + , " ]" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Baz\"," + , " \"values\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + log " - Option: Unwrap single arguments" + do + let + opts = EncodeTagged + { tagKey: "tag" + , valuesKey: "values" + , omitEmptyArguments: false + , unwrapSingleArguments: true + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Foo\"," + , " \"values\": []" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Bar\"," + , " \"values\": 42" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Baz\"," + , " \"values\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + log " - EncodeNested" + do + log " - default" + do + let + opts = EncodeNested + { unwrapSingleArguments: false + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"Foo\": []" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"Bar\": [" + , " 42" + , " ]" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"Baz\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + log " - Option: Unwrap single arguments" + do + let + opts = EncodeNested + { unwrapSingleArguments: true + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"Foo\": []" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"Bar\": 42" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"Baz\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + + quickCheck (propCodec genMySum (codecSample defaultEncoding)) +