Add fieldTransform to Options (#32)

* Add fieldTransform to Options

* Add comment about fieldTransform

Author: jacereda

src/Data/Foreign/Generic.purs

@@ -24,6 +24,7 @@ import Global.Unsafe (unsafeStringify)
 -- | - Unwrap single arguments
 -- | - Don't unwrap single constructors
 -- | - Use the constructor names as-is
+-- | - Use the field names as-is
 defaultOptions :: Options
 defaultOptions =
   { sumEncoding:
@@ -34,6 +35,7 @@ defaultOptions =
         }
   , unwrapSingleConstructors: false
   , unwrapSingleArguments: true
+  , fieldTransform: id
   }
 
 -- | Read a value which has a `Generic` type.

src/Data/Foreign/Generic/Class.purs

@@ -25,19 +25,19 @@ class GenericEncode a where
   encodeOpts :: Options -> a -> Foreign
 
 class GenericDecodeArgs a where
-  decodeArgs :: Int -> List Foreign -> F { result :: a
-                                         , rest :: List Foreign
-                                         , next :: Int
-                                         }
+  decodeArgs :: Options -> Int -> List Foreign -> F { result :: a
+                                                    , rest :: List Foreign
+                                                    , next :: Int
+                                                    }
 
 class GenericEncodeArgs a where
-  encodeArgs :: a -> List Foreign
+  encodeArgs :: Options -> a -> List Foreign
 
 class GenericDecodeFields a where
-  decodeFields :: Foreign -> F a
+  decodeFields :: Options -> Foreign -> F a
 
 class GenericEncodeFields a where
-  encodeFields :: a -> S.StrMap Foreign
+  encodeFields :: Options -> a -> S.StrMap Foreign
 
 class GenericCountArgs a where
   countArgs :: Proxy a -> Either a Int
@@ -74,13 +74,13 @@ instance genericDecodeConstructor
         case numArgs of
           Left a -> pure a
           Right 1 | opts.unwrapSingleArguments -> do
-            { result, rest } <- decodeArgs 0 (singleton args)
+            { result, rest } <- decodeArgs opts 0 (singleton args)
             unless (null rest) $
               fail (ForeignError "Expected a single argument")
             pure result
           Right n -> do
             vals <- readArray args
-            { result, rest } <- decodeArgs 0 (fromFoldable vals)
+            { result, rest } <- decodeArgs opts 0 (fromFoldable vals)
             unless (null rest) $
               fail (ForeignError ("Expected " <> show n <> " constructor arguments"))
             pure result
@@ -99,7 +99,7 @@ instance genericEncodeConstructor
       ctorName = reflectSymbol (SProxy :: SProxy name)
 
       encodeArgsArray :: rep -> Maybe Foreign
-      encodeArgsArray = unwrapArguments <<< toUnfoldable <<< encodeArgs
+      encodeArgsArray = unwrapArguments <<< toUnfoldable <<< encodeArgs opts
 
       unwrapArguments :: Array Foreign -> Maybe Foreign
       unwrapArguments [] = Nothing
@@ -122,75 +122,75 @@ instance genericEncodeSum
   encodeOpts opts (Inr b) = encodeOpts (opts { unwrapSingleConstructors = false }) b
 
 instance genericDecodeArgsNoArguments :: GenericDecodeArgs NoArguments where
-  decodeArgs i Nil = pure { result: NoArguments, rest: Nil, next: i }
-  decodeArgs _ _ = fail (ForeignError "Too many constructor arguments")
+  decodeArgs _ i Nil = pure { result: NoArguments, rest: Nil, next: i }
+  decodeArgs _ _ _ = fail (ForeignError "Too many constructor arguments")
 
 instance genericEncodeArgsNoArguments :: GenericEncodeArgs NoArguments where
   encodeArgs _ = mempty
 
 instance genericDecodeArgsArgument
   :: Decode a
   => GenericDecodeArgs (Argument a) where
-  decodeArgs i (x : xs) = do
+  decodeArgs _ i (x : xs) = do
     a <- mapExcept (lmap (map (ErrorAtIndex i))) (decode x)
     pure { result: Argument a, rest: xs, next: i + 1 }
-  decodeArgs _ _ = fail (ForeignError "Not enough constructor arguments")
+  decodeArgs _ _ _ = fail (ForeignError "Not enough constructor arguments")
 
 instance genericEncodeArgsArgument
   :: Encode a
   => GenericEncodeArgs (Argument a) where
-  encodeArgs (Argument a) = singleton (encode a)
+  encodeArgs _ (Argument a) = singleton (encode a)
 
 instance genericDecodeArgsProduct
   :: (GenericDecodeArgs a, GenericDecodeArgs b)
   => GenericDecodeArgs (Product a b) where
-  decodeArgs i xs = do
-    { result: resA, rest: xs1, next: i1 } <- decodeArgs i xs
-    { result: resB, rest, next } <- decodeArgs i1 xs1
+  decodeArgs opts i xs = do
+    { result: resA, rest: xs1, next: i1 } <- decodeArgs opts i xs
+    { result: resB, rest, next } <- decodeArgs opts i1 xs1
     pure { result: Product resA resB, rest, next }
 
 instance genericEncodeArgsProduct
   :: (GenericEncodeArgs a, GenericEncodeArgs b)
   => GenericEncodeArgs (Product a b) where
-  encodeArgs (Product a b) = encodeArgs a <> encodeArgs b
+  encodeArgs opts (Product a b) = encodeArgs opts a <> encodeArgs opts b
 
 instance genericDecodeArgsRec
   :: GenericDecodeFields fields
   => GenericDecodeArgs (Rec fields) where
-  decodeArgs i (x : xs) = do
-    fields <- mapExcept (lmap (map (ErrorAtIndex i))) (decodeFields x)
+  decodeArgs opts i (x : xs) = do
+    fields <- mapExcept (lmap (map (ErrorAtIndex i))) (decodeFields opts x)
     pure { result: Rec fields, rest: xs, next: i + 1 }
-  decodeArgs _ _ = fail (ForeignError "Not enough constructor arguments")
+  decodeArgs _ _ _ = fail (ForeignError "Not enough constructor arguments")
 
 instance genericEncodeArgsRec
   :: GenericEncodeFields fields
   => GenericEncodeArgs (Rec fields) where
-  encodeArgs (Rec fs) = singleton (toForeign (encodeFields fs))
+  encodeArgs opts (Rec fs) = singleton (toForeign (encodeFields opts fs))
 
 instance genericDecodeFieldsField
   :: (IsSymbol name, Decode a)
   => GenericDecodeFields (Field name a) where
-  decodeFields x = do
-    let name = reflectSymbol (SProxy :: SProxy name)
+  decodeFields opts x = do
+    let name = opts.fieldTransform $ reflectSymbol (SProxy :: SProxy name)
     -- If `name` field doesn't exist, then `y` will be `undefined`.
     Field <$> (index x name >>= mapExcept (lmap (map (ErrorAtProperty name))) <<< decode)
 
 instance genericEncodeFieldsField
   :: (IsSymbol name, Encode a)
   => GenericEncodeFields (Field name a) where
-  encodeFields (Field a) =
-    let name = reflectSymbol (SProxy :: SProxy name)
+  encodeFields opts (Field a) =
+    let name = opts.fieldTransform $ reflectSymbol (SProxy :: SProxy name)
     in S.singleton name (encode a)
 
 instance genericDecodeFieldsProduct
   :: (GenericDecodeFields a, GenericDecodeFields b)
   => GenericDecodeFields (Product a b) where
-  decodeFields x = Product <$> decodeFields x <*> decodeFields x
+  decodeFields opts x = Product <$> decodeFields opts x <*> decodeFields opts x
 
 instance genericEncodeFieldsProduct
   :: (GenericEncodeFields a, GenericEncodeFields b)
   => GenericEncodeFields (Product a b) where
-  encodeFields (Product a b) = encodeFields a `S.union` encodeFields b
+  encodeFields opts (Product a b) = encodeFields opts a `S.union` encodeFields opts b
 
 instance genericCountArgsNoArguments :: GenericCountArgs NoArguments where
   countArgs _ = Left NoArguments

src/Data/Foreign/Generic/Types.purs

@@ -4,6 +4,7 @@ type Options =
   { sumEncoding :: SumEncoding
   , unwrapSingleConstructors :: Boolean
   , unwrapSingleArguments :: Boolean
+  , fieldTransform :: String -> String
   }
 
 -- | The encoding of sum types for your type.

test/Main.purs

@@ -8,8 +8,10 @@ import Control.Monad.Except (runExcept)
 import Data.Bifunctor (bimap)
 import Data.Either (Either(..))
 import Data.Foreign.Class (class Encode, class Decode)
-import Data.Foreign.Generic (decodeJSON, encodeJSON)
+import Data.Foreign.Generic (decodeJSON, defaultOptions, encodeJSON, genericDecodeJSON, genericEncodeJSON)
+import Data.Foreign.Generic.Class (class GenericDecode, class GenericEncode, encodeFields)
 import Data.Foreign.Generic.EnumEncoding (class GenericDecodeEnum, class GenericEncodeEnum, GenericEnumOptions, genericDecodeEnum, genericEncodeEnum)
+import Data.Foreign.Generic.Types (Options, SumEncoding(..))
 import Data.Foreign.JSON (parseJSON)
 import Data.Foreign.NullOrUndefined (NullOrUndefined(..))
 import Data.Generic.Rep (class Generic)
@@ -49,6 +51,25 @@ testRoundTrip x = do
     Right y -> assert (x == y)
     Left err -> throw (show err)
 
+testGenericRoundTrip
+  :: ∀ a r eff
+   . Eq a
+  => Generic a r
+  => GenericDecode r
+  => GenericEncode r
+  => Options
+  -> a
+  -> Eff ( console :: CONSOLE
+         , assert :: ASSERT
+         | eff
+         ) Unit
+testGenericRoundTrip opts x = do
+  let json = genericEncodeJSON opts x
+  log json
+  case runExcept (genericDecodeJSON opts json) of
+    Right y -> assert (x == y)
+    Left err -> throw (show err)
+
 testOption
   :: ∀ a rep eff
    . Eq a
@@ -99,3 +120,7 @@ main = do
   testRoundTrip (makeTree 5)
   testRoundTrip (StrMap.fromFoldable [Tuple "one" 1, Tuple "two" 2])
   testUnaryConstructorLiteral
+  let opts = defaultOptions { fieldTransform = toUpper }
+  testGenericRoundTrip opts (RecordTest { foo: 1, bar: "test", baz: 'a' })
+
+