mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-09-11 14:05:55 +03:00
Merge pull request #47 from k-bx/master
Add functions to generate ADT String parsers/renderers
This commit is contained in:
commit
0856922e8c
@ -70,6 +70,8 @@ jsonEncFoo val =
|
||||
]
|
||||
```
|
||||
|
||||
Also, there are functions `Elm.Json.stringSerForSimpleAdt` and `Elm.Json.stringParserForSimpleAdt` to generate functions for your non-JSON ADT types.
|
||||
|
||||
For more usage examples check the tests or the examples dir.
|
||||
|
||||
## Install
|
||||
|
@ -11,6 +11,8 @@ module Elm.Json
|
||||
, jsonSerForDef
|
||||
, jsonParserForType
|
||||
, jsonSerForType
|
||||
, stringSerForSimpleAdt
|
||||
, stringParserForSimpleAdt
|
||||
)
|
||||
where
|
||||
|
||||
@ -253,3 +255,87 @@ jsonSerForDef etd =
|
||||
++ if newtyping
|
||||
then " (" ++ et_name name ++ " val)"
|
||||
else " val"
|
||||
|
||||
-- | Serialize a type like 'type Color = Red | Green | Blue' in a function like
|
||||
--
|
||||
-- > stringEncColor : Color -> String
|
||||
-- > stringEncColor x =
|
||||
-- > case x of
|
||||
-- > Red -> "red"
|
||||
-- > ...
|
||||
--
|
||||
-- This is mainly useful for types which are used as part of query parameters and url captures.
|
||||
stringSerForSimpleAdt :: ETypeDef -> String
|
||||
stringSerForSimpleAdt etd =
|
||||
case etd of
|
||||
ETypeSum (ESum name opts (SumEncoding' _se) _ _unarystring) ->
|
||||
defaultEncoding opts
|
||||
where
|
||||
defaultEncoding os =
|
||||
unlines
|
||||
((makeName name False ++ " =") : " case val of" : map mkcase os)
|
||||
mkcase :: SumTypeConstructor -> String
|
||||
mkcase (STC cname oname (Anonymous args)) =
|
||||
replicate 8 ' '
|
||||
++ cap cname
|
||||
++ " "
|
||||
++ argList args
|
||||
++ " -> "
|
||||
++ show oname
|
||||
mkcase _ =
|
||||
error "stringSerForSimpleAdt.mkcase: Expecting an Anonymous case"
|
||||
argList a = unwords $ map (\i -> "v" ++ show i) [1 .. length a]
|
||||
_ -> error "stringSerForSimpleAdt only works with ETypeSum"
|
||||
where
|
||||
fname name = "stringEnc" ++ et_name name
|
||||
makeType name =
|
||||
fname name
|
||||
++ " : "
|
||||
++ intercalate
|
||||
" -> "
|
||||
([unwords (et_name name : map tv_name (et_args name))] ++ ["String"])
|
||||
makeName name newtyping =
|
||||
makeType name
|
||||
++ "\n"
|
||||
++ fname name
|
||||
++ " "
|
||||
++ unwords (map (\tv -> "localEncoder_" ++ tv_name tv) $ et_args name)
|
||||
++ if newtyping
|
||||
then " (" ++ et_name name ++ " val)"
|
||||
else " val"
|
||||
|
||||
-- | Parse a String into a maybe-value for simple ADT types. See 'stringSerForSimpleAdt' for motivation
|
||||
stringParserForSimpleAdt :: ETypeDef -> String
|
||||
stringParserForSimpleAdt etd =
|
||||
case etd of
|
||||
ETypeSum (ESum name opts (SumEncoding' _encodingType) _ _unarystring) ->
|
||||
decoderType name
|
||||
++ "\n"
|
||||
++ makeName name
|
||||
++ " s =\n"
|
||||
++ encodingDictionary opts
|
||||
++ "\n"
|
||||
where
|
||||
tab n s = replicate n ' ' ++ s
|
||||
encodingDictionary [STC cname _ args] =
|
||||
" " ++ mkDecoder cname args
|
||||
encodingDictionary os =
|
||||
" case s of\n"
|
||||
++ tab 8 ""
|
||||
++ intercalate ("\n" ++ replicate 8 ' ') (map dictEntry os)
|
||||
++ "\n"
|
||||
++ tab 8 "_ -> Nothing"
|
||||
dictEntry (STC cname oname _args) =
|
||||
show oname ++ " -> Just " ++ cname
|
||||
mkDecoder _cname _ = error "impossible!"
|
||||
_ -> error "impossible"
|
||||
where
|
||||
funcname name = "stringDec" ++ et_name name
|
||||
prependTypes str = map (\tv -> str ++ tv_name tv) . et_args
|
||||
decoderType name =
|
||||
funcname name
|
||||
++ " : "
|
||||
++ intercalate " -> " (["String"] ++ [decoderTypeEnd name])
|
||||
decoderTypeEnd name =
|
||||
unwords ("Maybe" : et_name name : map tv_name (et_args name))
|
||||
makeName name = unwords (funcname name : prependTypes "localDecoder_" name)
|
||||
|
@ -177,6 +177,16 @@ unaryAParse = unlines
|
||||
, " in decodeSumObjectWithSingleField \"UnaryA\" jsonDecDictUnaryA"
|
||||
]
|
||||
|
||||
unaryAStringParser :: String
|
||||
unaryAStringParser = unlines
|
||||
[ "stringDecUnaryA : String -> Maybe UnaryA"
|
||||
, "stringDecUnaryA s ="
|
||||
, " case s of"
|
||||
, " \"UnaryA1\" -> Just UnaryA1"
|
||||
, " \"UnaryA2\" -> Just UnaryA2"
|
||||
, " _ -> Nothing"
|
||||
]
|
||||
|
||||
unaryBParse :: String
|
||||
unaryBParse = unlines
|
||||
[ "jsonDecUnaryB : Json.Decode.Decoder ( UnaryB )"
|
||||
@ -195,6 +205,15 @@ unaryASer = unlines
|
||||
, " in encodeSumObjectWithSingleField keyval val"
|
||||
]
|
||||
|
||||
unaryAStringSer :: String
|
||||
unaryAStringSer = unlines
|
||||
[ "stringEncUnaryA : UnaryA -> String"
|
||||
, "stringEncUnaryA val ="
|
||||
, " case val of"
|
||||
, " UnaryA1 -> \"UnaryA1\""
|
||||
, " UnaryA2 -> \"UnaryA2\""
|
||||
]
|
||||
|
||||
unaryBSer :: String
|
||||
unaryBSer = unlines
|
||||
[ "jsonEncUnaryB : UnaryB -> Value"
|
||||
@ -312,6 +331,10 @@ spec =
|
||||
it "should produce the correct ser code for unary unions" $ do
|
||||
jsonSerForDef rUnaryA `shouldBe` unaryASer
|
||||
jsonSerForDef rUnaryB `shouldBe` unaryBSer
|
||||
it "should produce the correct stringSerForSimpleAdt code" $ do
|
||||
stringSerForSimpleAdt rUnaryA `shouldBe` unaryAStringSer
|
||||
it "should produce the correct stringParserForDef code" $ do
|
||||
stringParserForSimpleAdt rUnaryA `shouldBe` unaryAStringParser
|
||||
it "should produce the correct parse code for aliases" $ do
|
||||
jsonParserForDef rFoo `shouldBe` fooParse
|
||||
jsonParserForDef rBar `shouldBe` barParse
|
||||
|
Loading…
Reference in New Issue
Block a user