mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-10-26 22:43:03 +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!
|
The 'omitNothingFields' option is currently not implemented!
|
||||||
-}
|
-}
|
||||||
jsonSerForType :: EType -> String
|
jsonSerForType :: EType -> String
|
||||||
jsonSerForType = jsonSerForType' False
|
jsonSerForType = jsonSerForType' False [1..]
|
||||||
|
|
||||||
jsonSerForType' :: Bool -> EType -> String
|
jsonSerForType' :: Bool -> [Int] -> EType -> String
|
||||||
jsonSerForType' omitnull ty =
|
jsonSerForType' omitnull ns ty =
|
||||||
case ty of
|
case ty of
|
||||||
ETyVar (ETVar v) -> "localEncoder_" ++ v
|
ETyVar (ETVar v) -> "localEncoder_" ++ v
|
||||||
ETyCon (ETCon "Int") -> "Json.Encode.int"
|
ETyCon (ETCon "Int") -> "Json.Encode.int"
|
||||||
@ -177,28 +177,29 @@ jsonSerForType' omitnull ty =
|
|||||||
ETyCon (ETCon "String") -> "Json.Encode.string"
|
ETyCon (ETCon "String") -> "Json.Encode.string"
|
||||||
ETyCon (ETCon "Bool") -> "Json.Encode.bool"
|
ETyCon (ETCon "Bool") -> "Json.Encode.bool"
|
||||||
ETyCon (ETCon c) -> "jsonEnc" ++ c
|
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
|
ETyApp (ETyCon (ETCon "Maybe")) t' -> if omitnull
|
||||||
then jsonSerForType t'
|
then jsonSerForType' omitnull ns t'
|
||||||
else "(maybeEncode (" ++ jsonSerForType t' ++ "))"
|
else "(maybeEncode (" ++ jsonSerForType' omitnull ns t' ++ "))"
|
||||||
ETyApp (ETyCon (ETCon "Set")) t' -> "(encodeSet " ++ jsonSerForType 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 value ++ "))"
|
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 key ++ ") (" ++ jsonSerForType value ++ "))"
|
ETyApp (ETyApp (ETyCon (ETCon "Dict")) key) value -> "(encodeMap (" ++ jsonSerForType' omitnull ns key ++ ") (" ++ jsonSerForType' omitnull ns value ++ "))"
|
||||||
_ ->
|
_ ->
|
||||||
case unpackTupleType ty of
|
case unpackTupleType ty of
|
||||||
[] -> error $ "This should never happen. Failed to unpackTupleType: " ++ show ty
|
[] -> error $ "This should never happen. Failed to unpackTupleType: " ++ show ty
|
||||||
[x] ->
|
[x] ->
|
||||||
case unpackToplevelConstr x of
|
case unpackToplevelConstr x of
|
||||||
(y : ys) ->
|
(y : ys) ->
|
||||||
"(" ++ jsonSerForType y ++ " "
|
"(" ++ jsonSerForType' omitnull ns y ++ " "
|
||||||
++ unwords (map (\t' -> "(" ++ jsonSerForType t' ++ ")") ys)
|
++ unwords (map (\t' -> "(" ++ jsonSerForType' omitnull ns t' ++ ")") ys)
|
||||||
++ ")"
|
++ ")"
|
||||||
_ -> error $ "Do suitable json serialiser found for " ++ show ty
|
_ -> error $ "Do suitable json serialiser found for " ++ show ty
|
||||||
xs ->
|
xs ->
|
||||||
let tupleArgsV = zip xs ([1..] :: [Int])
|
let (ns', rest) = splitAt (length xs) ns
|
||||||
|
tupleArgsV = zip xs ns'
|
||||||
tupleArgs =
|
tupleArgs =
|
||||||
intercalate "," $ map (\(_, v) -> "t" ++ show v) tupleArgsV
|
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
|
-- | Compile a JSON serializer for an Elm type definition
|
||||||
|
@ -20,7 +20,7 @@ instance ElmRenderable EType where
|
|||||||
renderElm ty =
|
renderElm ty =
|
||||||
case unpackTupleType ty of
|
case unpackTupleType ty of
|
||||||
[t] -> renderSingleTy t
|
[t] -> renderSingleTy t
|
||||||
xs -> "(" ++ intercalate ", " (map renderSingleTy xs) ++ ")"
|
xs -> "(" ++ intercalate ", " (map renderElm xs) ++ ")"
|
||||||
where
|
where
|
||||||
renderApp (ETyApp l r) = renderApp l ++ " " ++ renderElm r
|
renderApp (ETyApp l r) = renderApp l ++ " " ++ renderElm r
|
||||||
renderApp x = renderElm x
|
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 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 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 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
|
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 = False } ''Record1)
|
||||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 3, omitNothingFields = True } ''Record2)
|
$(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 = False, allNullaryToStringTag = False, sumEncoding = TaggedObject "tag" "content" } ''Sum01)
|
||||||
$(deriveBoth defaultOptions{ fieldLabelModifier = drop 4, omitNothingFields = True , allNullaryToStringTag = False, sumEncoding = TaggedObject "tag" "content" } ''Sum02)
|
$(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
|
, 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 (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 (Sum02 a) where arbitrary = arb Sum02A Sum02B Sum02C Sum02D Sum02E
|
||||||
instance Arbitrary a => Arbitrary (Sum03 a) where arbitrary = arb Sum03A Sum03B Sum03C Sum03D Sum03E
|
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\""
|
, "recordDecode = describe \"Record decoding checks\""
|
||||||
, " [ recordDecode1"
|
, " [ recordDecode1"
|
||||||
, " , recordDecode2"
|
, " , recordDecode2"
|
||||||
|
, " , recordDecodeNestTuple"
|
||||||
, " ]"
|
, " ]"
|
||||||
, ""
|
, ""
|
||||||
, "recordEncode : Test"
|
, "recordEncode : Test"
|
||||||
, "recordEncode = describe \"Record encoding checks\""
|
, "recordEncode = describe \"Record encoding checks\""
|
||||||
, " [ recordEncode1"
|
, " [ recordEncode1"
|
||||||
, " , recordEncode2"
|
, " , recordEncode2"
|
||||||
|
, " , recordEncodeNestTuple"
|
||||||
, " ]"
|
, " ]"
|
||||||
, ""
|
, ""
|
||||||
, "sumDecode : Test"
|
, "sumDecode : Test"
|
||||||
@ -354,6 +360,7 @@ elmModuleContent = unlines
|
|||||||
, makeModuleContentWithAlterations (newtypeAliases ["Record1", "Record2", "SimpleRecord01", "SimpleRecord02", "SimpleRecord03", "SimpleRecord04"] . defaultAlterations)
|
, makeModuleContentWithAlterations (newtypeAliases ["Record1", "Record2", "SimpleRecord01", "SimpleRecord02", "SimpleRecord03", "SimpleRecord04"] . defaultAlterations)
|
||||||
[ DefineElm (Proxy :: Proxy (Record1 a))
|
[ DefineElm (Proxy :: Proxy (Record1 a))
|
||||||
, DefineElm (Proxy :: Proxy (Record2 a))
|
, DefineElm (Proxy :: Proxy (Record2 a))
|
||||||
|
, DefineElm (Proxy :: Proxy (RecordNestTuple a))
|
||||||
, DefineElm (Proxy :: Proxy (Sum01 a))
|
, DefineElm (Proxy :: Proxy (Sum01 a))
|
||||||
, DefineElm (Proxy :: Proxy (Sum02 a))
|
, DefineElm (Proxy :: Proxy (Sum02 a))
|
||||||
, DefineElm (Proxy :: Proxy (Sum03 a))
|
, DefineElm (Proxy :: Proxy (Sum03 a))
|
||||||
@ -400,6 +407,7 @@ main = do
|
|||||||
ss12 <- sample' arbitrary :: IO [Sum12 [Int]]
|
ss12 <- sample' arbitrary :: IO [Sum12 [Int]]
|
||||||
re01 <- sample' arbitrary :: IO [Record1 [Int]]
|
re01 <- sample' arbitrary :: IO [Record1 [Int]]
|
||||||
re02 <- sample' arbitrary :: IO [Record2 [Int]]
|
re02 <- sample' arbitrary :: IO [Record2 [Int]]
|
||||||
|
rent <- sample' arbitrary :: IO [RecordNestTuple [Int]]
|
||||||
sp01 <- sample' arbitrary :: IO [Simple01 [Int]]
|
sp01 <- sample' arbitrary :: IO [Simple01 [Int]]
|
||||||
sp02 <- sample' arbitrary :: IO [Simple02 [Int]]
|
sp02 <- sample' arbitrary :: IO [Simple02 [Int]]
|
||||||
sp03 <- sample' arbitrary :: IO [Simple03 [Int]]
|
sp03 <- sample' arbitrary :: IO [Simple03 [Int]]
|
||||||
@ -447,6 +455,8 @@ main = do
|
|||||||
, mkRecordDecodeTest "2" re02
|
, mkRecordDecodeTest "2" re02
|
||||||
, mkRecordEncodeTest "1" re01
|
, mkRecordEncodeTest "1" re01
|
||||||
, mkRecordEncodeTest "2" re02
|
, mkRecordEncodeTest "2" re02
|
||||||
|
, mkRecordDecodeTest "NestTuple" rent
|
||||||
|
, mkRecordEncodeTest "NestTuple" rent
|
||||||
, mkSimpleEncodeTest "01" sp01
|
, mkSimpleEncodeTest "01" sp01
|
||||||
, mkSimpleEncodeTest "02" sp02
|
, mkSimpleEncodeTest "02" sp02
|
||||||
, mkSimpleEncodeTest "03" sp03
|
, mkSimpleEncodeTest "03" sp03
|
||||||
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user