mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-08-17 18:00:39 +03:00
Merge pull request #56 from ncaq/fix-nest-tuple
fixed: avoid error when nested tuple
This commit is contained in:
commit
3221dd18a9
@ -166,10 +166,10 @@ jsonParserForDef etd =
|
||||
The 'omitNothingFields' option is currently not implemented!
|
||||
-}
|
||||
jsonSerForType :: EType -> String
|
||||
jsonSerForType = jsonSerForType' False
|
||||
jsonSerForType = jsonSerForType' False [1..]
|
||||
|
||||
jsonSerForType' :: Bool -> EType -> String
|
||||
jsonSerForType' omitnull ty =
|
||||
jsonSerForType' :: Bool -> [Int] -> EType -> String
|
||||
jsonSerForType' omitnull ns ty =
|
||||
case ty of
|
||||
ETyVar (ETVar v) -> "localEncoder_" ++ v
|
||||
ETyCon (ETCon "Int") -> "Json.Encode.int"
|
||||
@ -177,28 +177,29 @@ jsonSerForType' omitnull ty =
|
||||
ETyCon (ETCon "String") -> "Json.Encode.string"
|
||||
ETyCon (ETCon "Bool") -> "Json.Encode.bool"
|
||||
ETyCon (ETCon c) -> "jsonEnc" ++ c
|
||||
ETyApp (ETyCon (ETCon "List")) t' -> "(Json.Encode.list " ++ jsonSerForType t' ++ ")"
|
||||
ETyApp (ETyCon (ETCon "List")) t' -> "(Json.Encode.list " ++ jsonSerForType' omitnull ns t' ++ ")"
|
||||
ETyApp (ETyCon (ETCon "Maybe")) t' -> if omitnull
|
||||
then jsonSerForType t'
|
||||
else "(maybeEncode (" ++ jsonSerForType t' ++ "))"
|
||||
ETyApp (ETyCon (ETCon "Set")) t' -> "(encodeSet " ++ jsonSerForType t' ++ ")"
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Dict")) (ETyCon (ETCon "String"))) value -> "(Json.Encode.dict identity (" ++ jsonSerForType value ++ "))"
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Dict")) key) value -> "(encodeMap (" ++ jsonSerForType key ++ ") (" ++ jsonSerForType value ++ "))"
|
||||
then jsonSerForType' omitnull ns t'
|
||||
else "(maybeEncode (" ++ jsonSerForType' omitnull ns t' ++ "))"
|
||||
ETyApp (ETyCon (ETCon "Set")) t' -> "(encodeSet " ++ jsonSerForType' omitnull ns t' ++ ")"
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Dict")) (ETyCon (ETCon "String"))) value -> "(Json.Encode.dict identity (" ++ jsonSerForType' omitnull ns value ++ "))"
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Dict")) key) value -> "(encodeMap (" ++ jsonSerForType' omitnull ns key ++ ") (" ++ jsonSerForType' omitnull ns value ++ "))"
|
||||
_ ->
|
||||
case unpackTupleType ty of
|
||||
[] -> error $ "This should never happen. Failed to unpackTupleType: " ++ show ty
|
||||
[x] ->
|
||||
case unpackToplevelConstr x of
|
||||
(y : ys) ->
|
||||
"(" ++ jsonSerForType y ++ " "
|
||||
++ unwords (map (\t' -> "(" ++ jsonSerForType t' ++ ")") ys)
|
||||
"(" ++ jsonSerForType' omitnull ns y ++ " "
|
||||
++ unwords (map (\t' -> "(" ++ jsonSerForType' omitnull ns t' ++ ")") ys)
|
||||
++ ")"
|
||||
_ -> error $ "Do suitable json serialiser found for " ++ show ty
|
||||
xs ->
|
||||
let tupleArgsV = zip xs ([1..] :: [Int])
|
||||
let (ns', rest) = splitAt (length xs) ns
|
||||
tupleArgsV = zip xs ns'
|
||||
tupleArgs =
|
||||
intercalate "," $ map (\(_, v) -> "t" ++ show v) tupleArgsV
|
||||
in "(\\(" ++ tupleArgs ++ ") -> Json.Encode.list identity [" ++ intercalate "," (map (\(t', idx) -> "(" ++ jsonSerForType t' ++ ") t" ++ show idx) tupleArgsV) ++ "])"
|
||||
in "(\\(" ++ tupleArgs ++ ") -> Json.Encode.list identity [" ++ intercalate "," (map (\(t', idx) -> "(" ++ jsonSerForType' omitnull rest t' ++ ") t" ++ show idx) tupleArgsV) ++ "])"
|
||||
|
||||
|
||||
-- | Compile a JSON serializer for an Elm type definition
|
||||
|
@ -20,7 +20,7 @@ instance ElmRenderable EType where
|
||||
renderElm ty =
|
||||
case unpackTupleType ty of
|
||||
[t] -> renderSingleTy t
|
||||
xs -> "(" ++ intercalate ", " (map renderSingleTy xs) ++ ")"
|
||||
xs -> "(" ++ intercalate ", " (map renderElm xs) ++ ")"
|
||||
where
|
||||
renderApp (ETyApp l r) = renderApp l ++ " " ++ renderElm r
|
||||
renderApp x = renderElm x
|
||||
|
@ -19,6 +19,7 @@ import Test.QuickCheck.Gen (Gen, oneof, sample')
|
||||
|
||||
data Record1 a = Record1 { _r1foo :: Int, _r1bar :: Maybe Int, _r1baz :: a, _r1qux :: Maybe a, _r1jmap :: M.Map String Int } deriving Show
|
||||
data Record2 a = Record2 { _r2foo :: Int, _r2bar :: Maybe Int, _r2baz :: a, _r2qux :: Maybe a } deriving Show
|
||||
data RecordNestTuple a = RecordNestTuple (a, (a, a)) deriving Show
|
||||
|
||||
data Sum01 a = Sum01A a | Sum01B (Maybe a) | Sum01C a a | Sum01D { _s01foo :: a } | Sum01E { _s01bar :: Int, _s01baz :: Int } deriving Show
|
||||
data Sum02 a = Sum02A a | Sum02B (Maybe a) | Sum02C a a | Sum02D { _s02foo :: a } | Sum02E { _s02bar :: Int, _s02baz :: Int } deriving Show
|
||||
@ -156,6 +157,7 @@ mkSimpleEncodeTest = mkEncodeTest "Simple" "_s"
|
||||
|
||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 3, omitNothingFields = False } ''Record1)
|
||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 3, omitNothingFields = True } ''Record2)
|
||||
$(deriveBoth defaultOptions ''RecordNestTuple)
|
||||
|
||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 4, omitNothingFields = False, allNullaryToStringTag = False, sumEncoding = TaggedObject "tag" "content" } ''Sum01)
|
||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 4, omitNothingFields = True , allNullaryToStringTag = False, sumEncoding = TaggedObject "tag" "content" } ''Sum02)
|
||||
@ -206,6 +208,8 @@ arb c1 c2 c3 c4 c5 = oneof
|
||||
, c5 <$> arbitrary <*> arbitrary
|
||||
]
|
||||
|
||||
instance Arbitrary a => Arbitrary (RecordNestTuple a) where
|
||||
arbitrary = (\x y z -> RecordNestTuple (x, (y, z))) <$> arbitrary <*> arbitrary <*> arbitrary
|
||||
instance Arbitrary a => Arbitrary (Sum01 a) where arbitrary = arb Sum01A Sum01B Sum01C Sum01D Sum01E
|
||||
instance Arbitrary a => Arbitrary (Sum02 a) where arbitrary = arb Sum02A Sum02B Sum02C Sum02D Sum02E
|
||||
instance Arbitrary a => Arbitrary (Sum03 a) where arbitrary = arb Sum03A Sum03B Sum03C Sum03D Sum03E
|
||||
@ -276,12 +280,14 @@ elmModuleContent = unlines
|
||||
, "recordDecode = describe \"Record decoding checks\""
|
||||
, " [ recordDecode1"
|
||||
, " , recordDecode2"
|
||||
, " , recordDecodeNestTuple"
|
||||
, " ]"
|
||||
, ""
|
||||
, "recordEncode : Test"
|
||||
, "recordEncode = describe \"Record encoding checks\""
|
||||
, " [ recordEncode1"
|
||||
, " , recordEncode2"
|
||||
, " , recordEncodeNestTuple"
|
||||
, " ]"
|
||||
, ""
|
||||
, "sumDecode : Test"
|
||||
@ -354,6 +360,7 @@ elmModuleContent = unlines
|
||||
, makeModuleContentWithAlterations (newtypeAliases ["Record1", "Record2", "SimpleRecord01", "SimpleRecord02", "SimpleRecord03", "SimpleRecord04"] . defaultAlterations)
|
||||
[ DefineElm (Proxy :: Proxy (Record1 a))
|
||||
, DefineElm (Proxy :: Proxy (Record2 a))
|
||||
, DefineElm (Proxy :: Proxy (RecordNestTuple a))
|
||||
, DefineElm (Proxy :: Proxy (Sum01 a))
|
||||
, DefineElm (Proxy :: Proxy (Sum02 a))
|
||||
, DefineElm (Proxy :: Proxy (Sum03 a))
|
||||
@ -400,6 +407,7 @@ main = do
|
||||
ss12 <- sample' arbitrary :: IO [Sum12 [Int]]
|
||||
re01 <- sample' arbitrary :: IO [Record1 [Int]]
|
||||
re02 <- sample' arbitrary :: IO [Record2 [Int]]
|
||||
rent <- sample' arbitrary :: IO [RecordNestTuple [Int]]
|
||||
sp01 <- sample' arbitrary :: IO [Simple01 [Int]]
|
||||
sp02 <- sample' arbitrary :: IO [Simple02 [Int]]
|
||||
sp03 <- sample' arbitrary :: IO [Simple03 [Int]]
|
||||
@ -447,6 +455,8 @@ main = do
|
||||
, mkRecordDecodeTest "2" re02
|
||||
, mkRecordEncodeTest "1" re01
|
||||
, mkRecordEncodeTest "2" re02
|
||||
, mkRecordDecodeTest "NestTuple" rent
|
||||
, mkRecordEncodeTest "NestTuple" rent
|
||||
, mkSimpleEncodeTest "01" sp01
|
||||
, mkSimpleEncodeTest "02" sp02
|
||||
, mkSimpleEncodeTest "03" sp03
|
||||
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user