elm-bridge 0.8.4 → 0.8.5
raw patch · 4 files changed
+21/−24 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Elm.Derive: data () => Options
+ Elm.Derive: data Options
- Elm.Derive: data () => SumEncoding
+ Elm.Derive: data SumEncoding
Files
- elm-bridge.cabal +2/−2
- src/Elm/Json.hs +10/−13
- test/Elm/JsonSpec.hs +7/−7
- test/Elm/ModuleSpec.hs +2/−2
elm-bridge.cabal view
@@ -1,5 +1,5 @@ name: elm-bridge-version: 0.8.4+version: 0.8.5 synopsis: Derive Elm types and Json code from Haskell types, using aeson's options description: Building the bridge from Haskell to Elm and back. Define types once, and derive the aeson and elm functions at the same time, using any aeson@@ -13,7 +13,7 @@ category: Web, Compiler, Language build-type: Simple cabal-version: >=1.10-tested-with: GHC==9.0.1+tested-with: GHC==9.10.3 extra-source-files: README.md
src/Elm/Json.hs view
@@ -62,16 +62,13 @@ in "Json.Decode.map" ++ show tupleLen ++ " tuple" ++ show tupleLen ++ " " ++ unwords (zipWith (\i t' -> "(Json.Decode.index " ++ show (i :: Int) ++ " (" ++ jsonParserForType t' ++ "))") [0..] xs) -parseRecords :: Maybe ETypeName -> Bool -> [(String, EType)] -> [String]-parseRecords newtyped unwrap fields =+parseRecords :: String -> Bool -> [(String, EType)] -> [String]+parseRecords typename unwrap fields = case fields of [(_, ftype)] | unwrap -> [ succeed ++ " |> custom (" ++ jsonParserForType' (o ftype) ftype ++ ")" ] _ -> succeed : map mkField fields where- succeed = " Json.Decode.succeed (\\" ++ unwords (map ( ('p':) . fst ) fields) ++ " -> " ++ mkNewtype ("{" ++ intercalate ", " (map (\(fldName, _) -> fixReserved fldName ++ " = p" ++ fldName) fields) ++ "}") ++ ")"- mkNewtype x = case newtyped of- Nothing -> x- Just nm -> "(" ++ et_name nm ++ " " ++ x ++ ")"+ succeed = " Json.Decode.succeed " ++ typename o fldType = if isOption fldType then Root else Leaf@@ -97,10 +94,10 @@ , makeName name ++ " =" , " " ++ jsonParserForType ty ]- ETypeAlias (EAlias name fields _ newtyping unwrap) -> unlines+ ETypeAlias (EAlias name fields _ _ unwrap) -> unlines ( decoderType name : (makeName name ++ " =")- : parseRecords (if newtyping then Just name else Nothing) unwrap fields+ : parseRecords (et_name name) unwrap fields ) ETypeSum (ESum name opts (SumEncoding' encodingType) _ unarystring) -> decoderType name ++ "\n" ++@@ -131,15 +128,15 @@ | length opts > 1 -> "\n" ++ tab 8 (isObjectSetName ++ " = " ++ "Set.fromList [" ++ intercalate ", " objectSet ++ "]") where objectSet =- (map (show . _stcName) $ filter (isNamed . _stcFields) opts) +++ map (show . _stcName) (filter (isNamed . _stcFields) opts) ++ -- if field is empty, it do not have content, so add to objectSet.- (map (show . _stcName) $ filter (isEmpty . _stcFields) opts)+ map (show . _stcName) (filter (isEmpty . _stcFields) opts) _ -> "" dictEntry (STC cname oname args) = "(" ++ show oname ++ ", " ++ mkDecoder cname args ++ ")" mkDecoder cname (Named args) = lazy $ "Json.Decode.map " ++ cname ++ " ("- ++ unwords (parseRecords Nothing False args)+ ++ unwords (parseRecords (et_name name) False args) ++ ")" mkDecoder cname (Anonymous args) = lazy $ unwords ( decodeFunction@@ -300,7 +297,7 @@ ++ " : " ++ intercalate " -> "- ([unwords (et_name name : map tv_name (et_args name))] ++ ["String"])+ (unwords (et_name name : map tv_name (et_args name)) : ["String"]) makeName name newtyping = makeType name ++ "\n"@@ -342,7 +339,7 @@ decoderType name = funcname name ++ " : "- ++ intercalate " -> " (["String"] ++ [decoderTypeEnd 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)
test/Elm/JsonSpec.hs view
@@ -85,7 +85,7 @@ fooParse = unlines [ "jsonDecFoo : Json.Decode.Decoder ( Foo )" , "jsonDecFoo ="- , " Json.Decode.succeed (\\pname pblablub -> {name = pname, blablub = pblablub})"+ , " Json.Decode.succeed Foo" , " |> required \"name\" (Json.Decode.string)" , " |> required \"blablub\" (Json.Decode.int)" ]@@ -117,7 +117,7 @@ barParse = unlines [ "jsonDecBar : Json.Decode.Decoder a -> Json.Decode.Decoder ( Bar a )" , "jsonDecBar localDecoder_a ="- , " Json.Decode.succeed (\\pname pblablub ptuple plist -> {name = pname, blablub = pblablub, tuple = ptuple, list = plist})"+ , " Json.Decode.succeed Bar" , " |> required \"name\" (localDecoder_a)" , " |> required \"blablub\" (Json.Decode.int)" , " |> required \"tuple\" (Json.Decode.map2 tuple2 (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string)))"@@ -129,8 +129,8 @@ [ "jsonDecBaz : Json.Decode.Decoder a -> Json.Decode.Decoder ( Baz a )" , "jsonDecBaz localDecoder_a =" , " let jsonDecDictBaz = Dict.fromList"- , " [ (\"Baz1\", Json.Decode.lazy (\\_ -> Json.Decode.map Baz1 ( Json.Decode.succeed (\\pfoo pqux -> {foo = pfoo, qux = pqux}) |> required \"foo\" (Json.Decode.int) |> required \"qux\" (jsonDecMap (Json.Decode.int) (localDecoder_a)))))"- , " , (\"Baz2\", Json.Decode.lazy (\\_ -> Json.Decode.map Baz2 ( Json.Decode.succeed (\\pbar pstr -> {bar = pbar, str = pstr}) |> fnullable \"bar\" (Json.Decode.int) |> required \"str\" (Json.Decode.string))))"+ , " [ (\"Baz1\", Json.Decode.lazy (\\_ -> Json.Decode.map Baz1 ( Json.Decode.succeed Baz |> required \"foo\" (Json.Decode.int) |> required \"qux\" (jsonDecMap (Json.Decode.int) (localDecoder_a)))))"+ , " , (\"Baz2\", Json.Decode.lazy (\\_ -> Json.Decode.map Baz2 ( Json.Decode.succeed Baz |> fnullable \"bar\" (Json.Decode.int) |> required \"str\" (Json.Decode.string))))" , " , (\"Testing\", Json.Decode.lazy (\\_ -> Json.Decode.map Testing (jsonDecBaz (localDecoder_a))))" , " ]" , " in decodeSumObjectWithSingleField \"Baz\" jsonDecDictBaz"@@ -161,7 +161,7 @@ test1Parse = unlines [ "jsonDecTestComp : Json.Decode.Decoder a -> Json.Decode.Decoder ( TestComp a )" , "jsonDecTestComp localDecoder_a ="- , " Json.Decode.succeed (\\pt1 pt2 -> {t1 = pt1, t2 = pt2})"+ , " Json.Decode.succeed TestComp" , " |> required \"t1\" (jsonDecChange (Json.Decode.int))" , " |> required \"t2\" (jsonDecChange (localDecoder_a))" ]@@ -272,7 +272,7 @@ ntdParse = unlines [ "jsonDecNTD : Json.Decode.Decoder ( NTD )" , "jsonDecNTD ="- , " Json.Decode.succeed (\\pgetNtd -> (NTD {getNtd = pgetNtd}))"+ , " Json.Decode.succeed NTD" , " |> required \"getNtd\" (Json.Decode.int)" ] @@ -298,7 +298,7 @@ phantomDParse = unlines [ "jsonDecPhantomD : Json.Decode.Decoder a -> Json.Decode.Decoder ( PhantomD a )" , "jsonDecPhantomD localDecoder_a ="- , " Json.Decode.succeed (\\pgetPhantomD -> (PhantomD {getPhantomD = pgetPhantomD}))"+ , " Json.Decode.succeed PhantomD" , " |> required \"getPhantomD\" (Json.Decode.int)" ]
test/Elm/ModuleSpec.hs view
@@ -50,7 +50,7 @@ , "" , "jsonDecBar : Json.Decode.Decoder a -> Json.Decode.Decoder ( Bar a )" , "jsonDecBar localDecoder_a ="- , " Json.Decode.succeed (\\pname pblablub ptuple plist plist_map -> {name = pname, blablub = pblablub, tuple = ptuple, list = plist, list_map = plist_map})"+ , " Json.Decode.succeed Bar" , " |> required \"name\" (localDecoder_a)" , " |> required \"blablub\" (Json.Decode.int)" , " |> required \"tuple\" (Json.Decode.map2 tuple2 (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string)))"@@ -89,7 +89,7 @@ , "jsonDecQux localDecoder_a =" , " let jsonDecDictQux = Dict.fromList" , " [ (\"Qux1\", Json.Decode.lazy (\\_ -> Json.Decode.map2 Qux1 (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string))))"- , " , (\"Qux2\", Json.Decode.lazy (\\_ -> Json.Decode.map Qux2 ( Json.Decode.succeed (\\pa ptest -> {a = pa, test = ptest}) |> required \"a\" (Json.Decode.int) |> required \"test\" (localDecoder_a))))"+ , " , (\"Qux2\", Json.Decode.lazy (\\_ -> Json.Decode.map Qux2 ( Json.Decode.succeed Qux |> required \"a\" (Json.Decode.int) |> required \"test\" (localDecoder_a))))" , " ]" , " in decodeSumObjectWithSingleField \"Qux\" jsonDecDictQux" , ""