Merge pull request #15 from LiamGoodacre/feature/config

Add encoding options for which tag & values keys to use

Author: thomashoneyman

src/Data/Argonaut/Decode/Generic/Rep.purs

@@ -3,14 +3,17 @@ module Data.Argonaut.Decode.Generic.Rep (
   class DecodeRepArgs,
   class DecodeLiteral,
   decodeRep,
+  decodeRepWith,
   decodeRepArgs,
   genericDecodeJson,
+  genericDecodeJsonWith,
   decodeLiteralSum,
   decodeLiteralSumWithTransform,
   decodeLiteral
 ) where
 
 import Prelude
+import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)
 
 import Control.Alt ((<|>))
 import Data.Argonaut.Core (Json, toArray, toObject, toString)
@@ -26,28 +29,31 @@ import Partial.Unsafe (unsafeCrashWith)
 import Prim.TypeError (class Fail, Text)
 
 class DecodeRep r where
-  decodeRep :: Json -> Either String r
+  decodeRepWith :: Encoding -> Json -> Either String r
+
+decodeRep :: forall r. DecodeRep r => Json -> Either String r
+decodeRep = decodeRepWith defaultEncoding
 
 instance decodeRepNoConstructors :: DecodeRep Rep.NoConstructors where
-  decodeRep _ = Left "Cannot decode empty data type"
+  decodeRepWith e _ = Left "Cannot decode empty data type"
 
 instance decodeRepSum :: (DecodeRep a, DecodeRep b) => DecodeRep (Rep.Sum a b) where
-  decodeRep j = Rep.Inl <$> decodeRep j <|> Rep.Inr <$> decodeRep j
+  decodeRepWith e j = Rep.Inl <$> decodeRepWith e j <|> Rep.Inr <$> decodeRepWith e j
 
 instance decodeRepConstructor :: (IsSymbol name, DecodeRepArgs a) => DecodeRep (Rep.Constructor name a) where
-  decodeRep j = do
+  decodeRepWith e j = do
     let name = reflectSymbol (SProxy :: SProxy name)
     let decodingErr msg = "When decoding a " <> name <> ": " <> msg
     jObj <- mFail (decodingErr "expected an object") (toObject j)
-    jTag <- mFail (decodingErr "'tag' property is missing") (FO.lookup "tag" jObj)
-    tag <- mFail (decodingErr "'tag' property is not a string") (toString jTag)
+    jTag <- mFail (decodingErr $ "'" <> e.tagKey <> "' property is missing") (FO.lookup e.tagKey jObj)
+    tag <- mFail (decodingErr $ "'" <> e.tagKey <> "' property is not a string") (toString jTag)
     when (tag /= name) $
-      Left $ decodingErr "'tag' property has an incorrect value"
-    jValues <- mFail (decodingErr "'values' property is missing") (FO.lookup "values" jObj)
-    values <- mFail (decodingErr "'values' property is not an array") (toArray jValues)
+      Left $ decodingErr $ "'" <> e.tagKey <> "' property has an incorrect value"
+    jValues <- mFail (decodingErr $ "'" <> e.valuesKey <> "' property is missing") (FO.lookup e.valuesKey jObj)
+    values <- mFail (decodingErr $ "'" <> e.valuesKey <> "' property is not an array") (toArray jValues)
     {init, rest} <- lmap decodingErr $ decodeRepArgs values
     when (rest /= []) $
-      Left $ decodingErr "'values' property had too many values"
+      Left $ decodingErr $ "'" <> e.valuesKey <> "' property had too many values"
     pure $ Rep.Constructor init
 
 class DecodeRepArgs r where
@@ -69,7 +75,11 @@ instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument
 
 -- | Decode `Json` representation of a value which has a `Generic` type.
 genericDecodeJson :: forall a r. Rep.Generic a r => DecodeRep r => Json -> Either String a
-genericDecodeJson = map Rep.to <<< decodeRep
+genericDecodeJson = genericDecodeJsonWith defaultEncoding
+
+-- | Decode `Json` representation of a value which has a `Generic` type.
+genericDecodeJsonWith :: forall a r. Rep.Generic a r => DecodeRep r => Encoding -> Json -> Either String a
+genericDecodeJsonWith e = map Rep.to <<< decodeRepWith e
 
 mFail :: forall a. String -> Maybe a -> Either String a
 mFail msg = maybe (Left msg) Right

src/Data/Argonaut/Encode/Generic/Rep.purs

@@ -4,15 +4,18 @@ module Data.Argonaut.Encode.Generic.Rep (
   class EncodeRepFields,
   class EncodeLiteral,
   encodeRep,
+  encodeRepWith,
   encodeRepArgs,
   encodeRepFields,
   genericEncodeJson,
+  genericEncodeJsonWith,
   encodeLiteralSum,
   encodeLiteralSumWithTransform,
   encodeLiteral
 ) where
 
 import Prelude
+import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)
 
 import Data.Argonaut.Core (Json, fromArray, fromObject, fromString)
 import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
@@ -23,20 +26,23 @@ import Partial.Unsafe (unsafeCrashWith)
 import Prim.TypeError (class Fail, Text)
 
 class EncodeRep r where
-  encodeRep :: r -> Json
+  encodeRepWith :: Encoding -> r -> Json
+
+encodeRep :: forall r. EncodeRep r => r -> Json
+encodeRep = encodeRepWith defaultEncoding
 
 instance encodeRepNoConstructors :: EncodeRep Rep.NoConstructors where
-  encodeRep r = encodeRep r
+  encodeRepWith e = encodeRepWith e
 
 instance encodeRepSum :: (EncodeRep a, EncodeRep b) => EncodeRep (Rep.Sum a b) where
-  encodeRep (Rep.Inl a) = encodeRep a
-  encodeRep (Rep.Inr b) = encodeRep b
+  encodeRepWith e (Rep.Inl a) = encodeRepWith e a
+  encodeRepWith e (Rep.Inr b) = encodeRepWith e b
 
 instance encodeRepConstructor :: (IsSymbol name, EncodeRepArgs a) => EncodeRep (Rep.Constructor name a) where
-  encodeRep (Rep.Constructor a) =
+  encodeRepWith e (Rep.Constructor a) =
     fromObject
-      $ FO.insert "tag" (fromString (reflectSymbol (SProxy :: SProxy name)))
-      $ FO.insert "values" (fromArray (encodeRepArgs a))
+      $ FO.insert e.tagKey (fromString (reflectSymbol (SProxy :: SProxy name)))
+      $ FO.insert e.valuesKey (fromArray (encodeRepArgs a))
       $ FO.empty
 
 class EncodeRepArgs r where
@@ -61,7 +67,11 @@ instance encodeRepFieldsProduct :: (EncodeRepFields a, EncodeRepFields b) => Enc
 
 -- | Encode any `Generic` data structure into `Json`.
 genericEncodeJson :: forall a r. Rep.Generic a r => EncodeRep r => a -> Json
-genericEncodeJson = encodeRep <<< Rep.from
+genericEncodeJson = genericEncodeJsonWith defaultEncoding
+
+-- | Encode any `Generic` data structure into `Json`.
+genericEncodeJsonWith :: forall a r. Rep.Generic a r => EncodeRep r => Encoding -> a -> Json
+genericEncodeJsonWith e = encodeRepWith e <<< Rep.from
 
 -- | A function for encoding `Generic` sum types using string literal representations
 encodeLiteralSum :: forall a r. Rep.Generic a r => EncodeLiteral r => a -> Json

src/Data/Argonaut/Types/Generic/Rep.purs

@@ -0,0 +1,16 @@
+module Data.Argonaut.Types.Generic.Rep (
+  Encoding(..),
+  defaultEncoding
+) where
+
+type Encoding =
+  { tagKey :: String
+  , valuesKey :: String
+  }
+
+defaultEncoding :: Encoding
+defaultEncoding =
+  { tagKey: "tag"
+  , valuesKey: "values"
+  }
+

test/Main.purs

@@ -8,9 +8,10 @@ import Effect (Effect)
 import Effect.Console (log)
 import Data.Argonaut.Core (stringify)
 import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
-import Data.Argonaut.Decode.Generic.Rep (class DecodeLiteral, decodeLiteralSumWithTransform, genericDecodeJson)
+import Data.Argonaut.Decode.Generic.Rep (class DecodeLiteral, decodeLiteralSumWithTransform, genericDecodeJson, genericDecodeJsonWith)
 import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
-import Data.Argonaut.Encode.Generic.Rep (class EncodeLiteral, encodeLiteralSumWithTransform, genericEncodeJson)
+import Data.Argonaut.Encode.Generic.Rep (class EncodeLiteral, encodeLiteralSumWithTransform, genericEncodeJson, genericEncodeJsonWith)
+import Data.Argonaut.Types.Generic.Rep (Encoding, defaultEncoding)
 import Data.Argonaut.Parser (jsonParser)
 import Data.Either (Either(..), fromRight)
 import Data.Generic.Rep (class Generic)
@@ -48,6 +49,22 @@ instance encodeJsonLiteralStringExample :: EncodeJson LiteralStringExample where
 instance decodeJsonLiteralStringExample :: DecodeJson LiteralStringExample where
   decodeJson a = decodeLiteralSumWithTransform identity a
 
+diffEncodingOptions :: Encoding
+diffEncodingOptions = defaultEncoding
+  { tagKey = "type"
+  , valuesKey = "value"
+  }
+
+data DiffEncoding = A | B Int
+derive instance eqDiffEncoding :: Eq DiffEncoding
+derive instance genericDiffEncoding :: Generic DiffEncoding _
+instance showDiffENcoding :: Show DiffEncoding where
+  show a = genericShow a
+instance encodeJsonDiffEncoding :: EncodeJson DiffEncoding where
+  encodeJson a = genericEncodeJsonWith diffEncodingOptions a
+instance decodeJsonDiffEncoding :: DecodeJson DiffEncoding where
+  decodeJson a = genericDecodeJsonWith diffEncodingOptions a
+
 main :: Effect Unit
 main = do
   example $ Either $ Left "foo"
@@ -56,6 +73,8 @@ main = do
   example $ Nested {foo: {nested: 42}, bar: "bar"}
   example $ Product 1 2 $ Either $ Left "foo"
   example $ Frikandel
+  example $ A
+  example $ B 42
   testLiteralSumWithTransform identity Frikandel "\"Frikandel\""
   testLiteralSumWithTransform toUpper Frikandel "\"FRIKANDEL\""
   testLiteralSumWithTransform toLower Frikandel "\"frikandel\""