diff --git a/src/Data/Codec/Argonaut/Generic.purs b/src/Data/Codec/Argonaut/Generic.purs index 4653183..33b129e 100644 --- a/src/Data/Codec/Argonaut/Generic.purs +++ b/src/Data/Codec/Argonaut/Generic.purs @@ -23,28 +23,59 @@ import Type.Proxy (Proxy(..)) -- | decode (nullarySum "MySum") (J.fromString "MoarCtors") == Right MoarCtors -- |``` nullarySum ∷ ∀ a r. Generic a r ⇒ NullarySumCodec r ⇒ String → CA.JsonCodec a -nullarySum name = +nullarySum name = nullarySumWith defaultNullarySumEncoding name + +type NullarySumEncoding = + { mapTag ∷ String → String + } + +defaultNullarySumEncoding ∷ NullarySumEncoding +defaultNullarySumEncoding = + { mapTag: identity + } + +-- | Like nullarySum, but allows customizing the encoding with options. +-- | +-- | ```purescript +-- | import Data.Argonaut as J +-- | +-- | data MySum = Ctor1 | Ctor2 | MoarCtors +-- | derive instance genericMySum ∷ Generic MySum _ +-- | +-- | let opts = { mapTag: \tag → "My" <> tag } +-- | +-- | encode (nullarySumWith opts "MySum") Ctor1 == J.fromString "MyCtor1" +-- | decode (nullarySumWith opts "MySum") (J.fromString "MyMoarCtors") == Right MoarCtors +-- |``` +nullarySumWith ∷ ∀ a r. Generic a r ⇒ NullarySumCodec r ⇒ NullarySumEncoding → String → CA.JsonCodec a +nullarySumWith encoding name = C.codec' - (map to <<< nullarySumDecode name) - (nullarySumEncode <<< from) + (map to <<< nullarySumDecode encoding name) + (nullarySumEncode encoding <<< from) class NullarySumCodec r where - nullarySumEncode ∷ r → J.Json - nullarySumDecode ∷ String → J.Json → Either CA.JsonDecodeError r + nullarySumEncode ∷ NullarySumEncoding → r → J.Json + nullarySumDecode ∷ NullarySumEncoding → String → J.Json → Either CA.JsonDecodeError r instance nullarySumCodecSum ∷ (NullarySumCodec a, NullarySumCodec b) ⇒ NullarySumCodec (Sum a b) where - nullarySumEncode = case _ of - Inl a → nullarySumEncode a - Inr b → nullarySumEncode b - nullarySumDecode name j = Inl <$> nullarySumDecode name j - <|> Inr <$> nullarySumDecode name j + nullarySumEncode encoding = case _ of + Inl a → nullarySumEncode encoding a + Inr b → nullarySumEncode encoding b + nullarySumDecode encoding name j = Inl <$> nullarySumDecode encoding name j + <|> Inr <$> nullarySumDecode encoding name j instance nullarySumCodecCtor ∷ IsSymbol name ⇒ NullarySumCodec (Constructor name NoArguments) where - nullarySumEncode _ = - J.fromString $ reflectSymbol (Proxy ∷ Proxy name) - nullarySumDecode name j = do - tag ← note (CA.Named name (CA.TypeMismatch "String")) (J.toString j) - if tag /= reflectSymbol (Proxy ∷ Proxy name) then + nullarySumEncode encoding _ = + let + tagRaw = reflectSymbol (Proxy ∷ Proxy name) + tag = encoding.mapTag tagRaw + in + J.fromString tag + nullarySumDecode encoding name j = do + actualTag ← note (CA.Named name (CA.TypeMismatch "String")) (J.toString j) + let expectedTagRaw = reflectSymbol (Proxy ∷ Proxy name) + let expectedTag = encoding.mapTag expectedTagRaw + if expectedTag /= actualTag then Left (CA.Named name (CA.UnexpectedValue j)) else Right (Constructor NoArguments) diff --git a/test/Test/Generic.purs b/test/Test/Generic.purs index 05efe0e..9ad049c 100644 --- a/test/Test/Generic.purs +++ b/test/Test/Generic.purs @@ -2,7 +2,7 @@ module Test.Generic where import Prelude -import Data.Codec.Argonaut.Generic (nullarySum) +import Data.Codec.Argonaut.Generic (nullarySum, nullarySumWith) import Data.Generic.Rep (class Generic) import Data.Show.Generic (genericShow) import Effect (Effect) @@ -10,6 +10,7 @@ import Effect.Console (log) import Test.QuickCheck (quickCheck) import Test.QuickCheck.Arbitrary (genericArbitrary) import Test.QuickCheck.Gen (Gen) +import Test.Sum (check) import Test.Util (propCodec) data MySum = Ctor1 | Ctor2 | MoarCtors @@ -27,3 +28,9 @@ main ∷ Effect Unit main = do log "Check nullarySum" quickCheck (propCodec genMySum (nullarySum "MySum")) + + let opts = { mapTag: \tag → "My" <> tag } + + check (nullarySumWith opts "MySum") Ctor1 "\"MyCtor1\"" + check (nullarySumWith opts "MySum") MoarCtors "\"MyMoarCtors\"" + \ No newline at end of file