mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-09-11 14:05:55 +03:00
parent
5d298317ea
commit
887c2dd939
@ -197,4 +197,10 @@ deriveElmDef opts name =
|
||||
else deriveAlias True opts name [] conFields
|
||||
TySynD _ vars otherTy ->
|
||||
deriveSynonym opts name vars otherTy
|
||||
NewtypeD _ _ tyvars Nothing (NormalC _ [(Bang NoSourceUnpackedness NoSourceStrictness, otherTy)]) [] ->
|
||||
deriveSynonym opts name tyvars otherTy
|
||||
NewtypeD _ _ tyvars Nothing (RecC _ conFields@[(Name (OccName _) _, Bang NoSourceUnpackedness NoSourceStrictness, otherTy)]) [] ->
|
||||
if A.unwrapUnaryRecords opts
|
||||
then deriveSynonym opts name tyvars otherTy
|
||||
else deriveAlias True opts name tyvars conFields
|
||||
_ -> fail ("Oops, can only derive data and newtype, not this: " ++ show tyCon)
|
||||
|
@ -53,6 +53,11 @@ newtype NTB = NTB { getNtb :: Int }
|
||||
newtype NTC = NTC Int
|
||||
newtype NTD = NTD { getNtd :: Int }
|
||||
|
||||
newtype PhantomA a = PhantomA Int
|
||||
newtype PhantomB a = PhantomB { getPhantomB :: Int }
|
||||
newtype PhantomC a = PhantomC Int
|
||||
newtype PhantomD a = PhantomD { getPhantomD :: Int }
|
||||
|
||||
$(deriveElmDef (defaultOptionsDropLower 2) ''Foo)
|
||||
$(deriveElmDef (defaultOptionsDropLower 2) ''Bar)
|
||||
$(deriveElmDef (defaultOptionsDropLower 1) ''TestComp)
|
||||
@ -67,6 +72,10 @@ $(deriveElmDef defaultOptions ''NTA)
|
||||
$(deriveElmDef defaultOptions ''NTB)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''NTC)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''NTD)
|
||||
$(deriveElmDef defaultOptions ''PhantomA)
|
||||
$(deriveElmDef defaultOptions ''PhantomB)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''PhantomC)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''PhantomD)
|
||||
|
||||
fooSer :: String
|
||||
fooSer = "jsonEncFoo : Foo -> Value\njsonEncFoo val =\n Json.Encode.object\n [ (\"name\", Json.Encode.string val.name)\n , (\"blablub\", Json.Encode.int val.blablub)\n ]\n"
|
||||
@ -247,6 +256,32 @@ ntdParse = unlines
|
||||
, " Json.Decode.succeed (NTD {getNtd = pgetNtd})"
|
||||
]
|
||||
|
||||
phantomAParse :: String
|
||||
phantomAParse = unlines
|
||||
[ "jsonDecPhantomA : Json.Decode.Decoder a -> Json.Decode.Decoder ( PhantomA a )"
|
||||
, "jsonDecPhantomA localDecoder_a ="
|
||||
, " Json.Decode.int"
|
||||
]
|
||||
phantomBParse :: String
|
||||
phantomBParse = unlines
|
||||
[ "jsonDecPhantomB : Json.Decode.Decoder a -> Json.Decode.Decoder ( PhantomB a )"
|
||||
, "jsonDecPhantomB localDecoder_a ="
|
||||
, " Json.Decode.int"
|
||||
]
|
||||
phantomCParse :: String
|
||||
phantomCParse = unlines
|
||||
[ "jsonDecPhantomC : Json.Decode.Decoder a -> Json.Decode.Decoder ( PhantomC a )"
|
||||
, "jsonDecPhantomC localDecoder_a ="
|
||||
, " Json.Decode.int"
|
||||
]
|
||||
phantomDParse :: String
|
||||
phantomDParse = unlines
|
||||
[ "jsonDecPhantomD : Json.Decode.Decoder a -> Json.Decode.Decoder ( PhantomD a )"
|
||||
, "jsonDecPhantomD localDecoder_a ="
|
||||
, " (\"getPhantomD\" := Json.Decode.int) >>= \\pgetPhantomD ->"
|
||||
, " Json.Decode.succeed (PhantomD {getPhantomD = pgetPhantomD})"
|
||||
]
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "json serialisation" $
|
||||
@ -264,6 +299,10 @@ spec =
|
||||
rNTB = compileElmDef (Proxy :: Proxy NTB)
|
||||
rNTC = compileElmDef (Proxy :: Proxy NTC)
|
||||
rNTD = compileElmDef (Proxy :: Proxy NTD)
|
||||
rPhantomA = compileElmDef (Proxy :: Proxy (PhantomA a))
|
||||
rPhantomB = compileElmDef (Proxy :: Proxy (PhantomB a))
|
||||
rPhantomC = compileElmDef (Proxy :: Proxy (PhantomC a))
|
||||
rPhantomD = compileElmDef (Proxy :: Proxy (PhantomD a))
|
||||
it "should produce the correct ser code" $ do
|
||||
jsonSerForDef rFoo `shouldBe` fooSer
|
||||
jsonSerForDef rBar `shouldBe` barSer
|
||||
@ -292,3 +331,8 @@ spec =
|
||||
it "should produce the correct parse code for newtypes with unwrapUnaryRecords=False" $ do
|
||||
jsonParserForDef rNTC `shouldBe` ntcParse
|
||||
jsonParserForDef rNTD `shouldBe` ntdParse
|
||||
it "should produce the correct parse code for phantom newtypes" $ do
|
||||
jsonParserForDef rPhantomA `shouldBe` phantomAParse
|
||||
jsonParserForDef rPhantomB `shouldBe` phantomBParse
|
||||
jsonParserForDef rPhantomC `shouldBe` phantomCParse
|
||||
jsonParserForDef rPhantomD `shouldBe` phantomDParse
|
||||
|
@ -35,11 +35,20 @@ data Paa
|
||||
= PA1
|
||||
| PA2
|
||||
|
||||
newtype PhantomA a = PhantomA Int
|
||||
newtype PhantomB a = PhantomB { getPhantomB :: Int }
|
||||
newtype PhantomC a = PhantomC Int
|
||||
newtype PhantomD a = PhantomD { getPhantomD :: Int }
|
||||
|
||||
$(deriveElmDef (defaultOptionsDropLower 2) ''Foo)
|
||||
$(deriveElmDef (defaultOptionsDropLower 2) ''Bar)
|
||||
$(deriveElmDef defaultOptions ''SomeOpts)
|
||||
$(deriveElmDef defaultOptions ''Unit)
|
||||
$(deriveElmDef defaultOptions{allNullaryToStringTag = True, constructorTagModifier = drop 1} ''Paa)
|
||||
$(deriveElmDef defaultOptions ''PhantomA)
|
||||
$(deriveElmDef defaultOptions ''PhantomB)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''PhantomC)
|
||||
$(deriveElmDef defaultOptions { unwrapUnaryRecords = False } ''PhantomD)
|
||||
|
||||
fooCode :: String
|
||||
fooCode = "type alias Foo =\n { name: String\n , blablub: Int\n }\n"
|
||||
@ -60,6 +69,15 @@ paaCode = unlines
|
||||
, " | PA2 "
|
||||
]
|
||||
|
||||
phantomATy :: String
|
||||
phantomATy = "type alias PhantomA a = Int\n"
|
||||
phantomBTy :: String
|
||||
phantomBTy = "type alias PhantomB a = Int\n"
|
||||
phantomCTy :: String
|
||||
phantomCTy = "type alias PhantomC a = Int\n"
|
||||
phantomDTy :: String
|
||||
phantomDTy = "type PhantomD a = PhantomD\n { getPhantomD: Int\n }\n"
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "deriveElmRep" $
|
||||
@ -68,9 +86,17 @@ spec =
|
||||
rSomeOpts = compileElmDef (Proxy :: Proxy (SomeOpts a))
|
||||
rUnit = compileElmDef (Proxy :: Proxy Unit)
|
||||
rPaa = compileElmDef (Proxy :: Proxy Paa)
|
||||
rPhA = compileElmDef (Proxy :: Proxy (PhantomA a))
|
||||
rPhB = compileElmDef (Proxy :: Proxy (PhantomB a))
|
||||
rPhC = compileElmDef (Proxy :: Proxy (PhantomC a))
|
||||
rPhD = compileElmDef (Proxy :: Proxy (PhantomD a))
|
||||
it "should produce the correct code" $
|
||||
do renderElm rFoo `shouldBe` fooCode
|
||||
renderElm rBar `shouldBe` barCode
|
||||
renderElm rSomeOpts `shouldBe` someOptsCode
|
||||
renderElm rUnit `shouldBe` unitCode
|
||||
renderElm rPaa `shouldBe` paaCode
|
||||
renderElm rPhA `shouldBe` phantomATy
|
||||
renderElm rPhB `shouldBe` phantomBTy
|
||||
renderElm rPhC `shouldBe` phantomCTy
|
||||
renderElm rPhD `shouldBe` phantomDTy
|
||||
|
Loading…
Reference in New Issue
Block a user