From 5093e34cb360e2bf93b33cce1337a888c5ffff9a Mon Sep 17 00:00:00 2001 From: jacereda Date: Sun, 6 Aug 2017 21:06:34 +0200 Subject: [PATCH] Add fieldTransform to Options (#32) * Add fieldTransform to Options * Add comment about fieldTransform --- src/Data/Foreign/Generic.purs | 2 + src/Data/Foreign/Generic/Class.purs | 58 ++++++++++++++--------------- src/Data/Foreign/Generic/Types.purs | 1 + test/Main.purs | 27 +++++++++++++- 4 files changed, 58 insertions(+), 30 deletions(-) diff --git a/src/Data/Foreign/Generic.purs b/src/Data/Foreign/Generic.purs index 46745f5..4bb1e6b 100644 --- a/src/Data/Foreign/Generic.purs +++ b/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. diff --git a/src/Data/Foreign/Generic/Class.purs b/src/Data/Foreign/Generic/Class.purs index ce9de82..ae47634 100644 --- a/src/Data/Foreign/Generic/Class.purs +++ b/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,8 +122,8 @@ 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 @@ -131,66 +131,66 @@ instance genericEncodeArgsNoArguments :: GenericEncodeArgs NoArguments where 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 diff --git a/src/Data/Foreign/Generic/Types.purs b/src/Data/Foreign/Generic/Types.purs index f7255f8..45e799f 100644 --- a/src/Data/Foreign/Generic/Types.purs +++ b/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. diff --git a/test/Main.purs b/test/Main.purs index 5f64d44..e465c91 100644 --- a/test/Main.purs +++ b/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' }) + +