Add nullarySumWith

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)

test/Test/Generic.purs

@@ -2,14 +2,15 @@ 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)
 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\""
+