diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# v0.4.0 +## New features + * Support for Elm 0.18 + * Dropped support for Elm 0.17 and Elm 0.16 + # v0.3.0 ## New features * Support for Elm 0.17 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,9 @@ Building the bridge from [Haskell](http://haskell.org) to [Elm](http://elm-lang.org) and back. Define types once, use on both sides and enjoy easy (de)serialisation. Cheers! -Note that the [bartavelle/json-helpers](http://package.elm-lang.org/packages/bartavelle/json-helpers/latest/) package, with version >= 1.1.0, is expected by the generated Elm modules. +This version of the package only supports Elm 0.18. Version 0.3.0.2 supports Elm 0.16 and Elm 0.17. + +Note that the [bartavelle/json-helpers](http://package.elm-lang.org/packages/bartavelle/json-helpers/latest/) package, with version >= 1.2.0, is expected by the generated Elm modules. ## Usage diff --git a/elm-bridge.cabal b/elm-bridge.cabal --- a/elm-bridge.cabal +++ b/elm-bridge.cabal @@ -1,8 +1,10 @@ name: elm-bridge -version: 0.3.0.2 +version: 0.4.0 synopsis: Derive Elm types from Haskell types description: Building the bridge from Haskell to Elm and back. Define types once, use on both sides and enjoy easy (de)serialisation. Cheers! + + This module only supports Elm 0.18. Version 0.3.* supports both Elm 0.16 and Elm 0.17. homepage: https://github.com/agrafix/elm-bridge license: BSD3 license-file: LICENSE diff --git a/src/Elm/Json.hs b/src/Elm/Json.hs --- a/src/Elm/Json.hs +++ b/src/Elm/Json.hs @@ -58,8 +58,8 @@ xs -> let tupleLen = length xs commas = replicate (tupleLen - 1) ',' - in "Json.Decode.tuple" ++ show tupleLen ++ " (" ++ commas ++ ") " - ++ unwords (map (\t' -> "(" ++ jsonParserForType t' ++ ")") xs) + in "Json.Decode.map" ++ show tupleLen ++ " (" ++ commas ++ ") " + ++ 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 = map (mkField doUnwrap) fields ++ [" Json.Decode.succeed " ++ mkNewtype ("{" ++ intercalate ", " (map (\(fldName, _) -> fixReserved fldName ++ " = p" ++ fldName) fields) ++ "}")] @@ -75,7 +75,7 @@ in " " ++ fldStart ++ "(" ++ (if u then "" else "\"" ++ fldName ++ "\" := ") ++ jsonParserForType' mh fldType ++ fldEnd - ++ ") `Json.Decode.andThen` \\p" ++ fldName ++ " ->" + ++ ") >>= \\p" ++ fldName ++ " ->" -- | Checks that all the arguments to the ESum are unary values allUnaries :: Bool -> [(String, Either [(String, EType)] [EType])] -> Maybe [String] @@ -116,8 +116,9 @@ dictName = "jsonDecDict" ++ typename isObjectSetName = "jsonDecObjectSet" ++ typename deriveUnaries strs = unlines - [ "decodeSumUnaries " ++ show typename ++ " " ++ dictName - , dictName ++ " = Dict.fromList [" ++ intercalate ", " (map (\s -> "(" ++ show s ++ ", " ++ cap s ++ ")") strs ) ++ "]" + [ "" + , " let " ++ dictName ++ " = Dict.fromList [" ++ intercalate ", " (map (\s -> "(" ++ show s ++ ", " ++ cap s ++ ")") strs ) ++ "]" + , " in decodeSumUnaries " ++ show typename ++ " " ++ dictName ] encodingDictionary [(oname, args)] = " " ++ mkDecoder oname args encodingDictionary os = tab 4 "let " ++ dictName ++ " = Dict.fromList\n" ++ tab 12 "[ " ++ intercalate ("\n" ++ replicate 12 ' ' ++ ", ") (map dictEntry os) ++ "\n" ++ tab 12 "]" @@ -132,12 +133,15 @@ ++ ")" mkDecoder oname (Right args) = unwords ( decodeFunction : cap oname - : map (\t' -> "(" ++ jsonParserForType t' ++ ")") args + : zipWith (\t' i -> "(" ++ jsonParserForIndexedType t' i ++ ")") args [0..] ) where decodeFunction = case length args of 0 -> "Json.Decode.succeed" 1 -> "Json.Decode.map" - n -> "Json.Decode.tuple" ++ show n + n -> "Json.Decode.map" ++ show n + jsonParserForIndexedType :: EType -> Int -> String + jsonParserForIndexedType t' i | length args <= 1 = jsonParserForType t' + | otherwise = "Json.Decode.index " ++ show i ++ " (" ++ jsonParserForType t' ++ ")" where funcname name = "jsonDec" ++ et_name name prependTypes str = map (\tv -> str ++ tv_name tv) . et_args diff --git a/src/Elm/Module.hs b/src/Elm/Module.hs --- a/src/Elm/Module.hs +++ b/src/Elm/Module.hs @@ -23,8 +23,7 @@ moduleHeader :: ElmVersion -> String -> String -moduleHeader Elm0p16 moduleName = "module " ++ moduleName ++ " where" -moduleHeader Elm0p17 moduleName = "module " ++ moduleName ++ " exposing(..)" +moduleHeader Elm0p18 moduleName = "module " ++ moduleName ++ " exposing(..)" -- | Creates an Elm module for the given version. This will use the default -- type conversion rules (to -- convert @Vector@ to @List@, @HashMap a b@ @@ -52,7 +51,7 @@ makeElmModule :: String -- ^ Module name -> [DefineElm] -- ^ List of definitions to be included in the module -> String -makeElmModule = makeElmModuleWithVersion Elm0p16 +makeElmModule = makeElmModuleWithVersion Elm0p18 -- | Generates the content of a module. You will be responsible for -- including the required Elm headers. This uses the default type diff --git a/src/Elm/Versions.hs b/src/Elm/Versions.hs --- a/src/Elm/Versions.hs +++ b/src/Elm/Versions.hs @@ -1,7 +1,8 @@ -{-| A type to represent versions of Elm for produced code to work against +{-| A type to represent versions of Elm for produced code to work against. + +This module ONLY supports Elm 0.18 -} module Elm.Versions where data ElmVersion - = Elm0p16 - | Elm0p17 + = Elm0p18 diff --git a/test/Elm/JsonSpec.hs b/test/Elm/JsonSpec.hs --- a/test/Elm/JsonSpec.hs +++ b/test/Elm/JsonSpec.hs @@ -62,8 +62,8 @@ fooParse = unlines [ "jsonDecFoo : Json.Decode.Decoder ( Foo )" , "jsonDecFoo =" - , " (\"name\" := Json.Decode.string) `Json.Decode.andThen` \\pname ->" - , " (\"blablub\" := Json.Decode.int) `Json.Decode.andThen` \\pblablub ->" + , " (\"name\" := Json.Decode.string) >>= \\pname ->" + , " (\"blablub\" := Json.Decode.int) >>= \\pblablub ->" , " Json.Decode.succeed {name = pname, blablub = pblablub}" ] @@ -94,10 +94,10 @@ barParse = unlines [ "jsonDecBar : Json.Decode.Decoder a -> Json.Decode.Decoder ( Bar a )" , "jsonDecBar localDecoder_a =" - , " (\"name\" := localDecoder_a) `Json.Decode.andThen` \\pname ->" - , " (\"blablub\" := Json.Decode.int) `Json.Decode.andThen` \\pblablub ->" - , " (\"tuple\" := Json.Decode.tuple2 (,) (Json.Decode.int) (Json.Decode.string)) `Json.Decode.andThen` \\ptuple ->" - , " (\"list\" := Json.Decode.list (Json.Decode.bool)) `Json.Decode.andThen` \\plist ->" + , " (\"name\" := localDecoder_a) >>= \\pname ->" + , " (\"blablub\" := Json.Decode.int) >>= \\pblablub ->" + , " (\"tuple\" := Json.Decode.map2 (,) (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string))) >>= \\ptuple ->" + , " (\"list\" := Json.Decode.list (Json.Decode.bool)) >>= \\plist ->" , " Json.Decode.succeed {name = pname, blablub = pblablub, tuple = ptuple, list = plist}" ] @@ -106,8 +106,8 @@ [ "jsonDecBaz : Json.Decode.Decoder a -> Json.Decode.Decoder ( Baz a )" , "jsonDecBaz localDecoder_a =" , " let jsonDecDictBaz = Dict.fromList" - , " [ (\"Baz1\", Json.Decode.map Baz1 ( (\"foo\" := Json.Decode.int) `Json.Decode.andThen` \\pfoo -> (\"qux\" := jsonDecMap (Json.Decode.int) (localDecoder_a)) `Json.Decode.andThen` \\pqux -> Json.Decode.succeed {foo = pfoo, qux = pqux}))" - , " , (\"Baz2\", Json.Decode.map Baz2 ( (Json.Decode.maybe (\"bar\" := Json.Decode.int)) `Json.Decode.andThen` \\pbar -> (\"str\" := Json.Decode.string) `Json.Decode.andThen` \\pstr -> Json.Decode.succeed {bar = pbar, str = pstr}))" + , " [ (\"Baz1\", Json.Decode.map Baz1 ( (\"foo\" := Json.Decode.int) >>= \\pfoo -> (\"qux\" := jsonDecMap (Json.Decode.int) (localDecoder_a)) >>= \\pqux -> Json.Decode.succeed {foo = pfoo, qux = pqux}))" + , " , (\"Baz2\", Json.Decode.map Baz2 ( (Json.Decode.maybe (\"bar\" := Json.Decode.int)) >>= \\pbar -> (\"str\" := Json.Decode.string) >>= \\pstr -> Json.Decode.succeed {bar = pbar, str = pstr}))" , " , (\"Testing\", Json.Decode.map Testing (jsonDecBaz (localDecoder_a)))" , " ]" , " in decodeSumObjectWithSingleField \"Baz\" jsonDecDictBaz" @@ -144,8 +144,8 @@ test1Parse = unlines [ "jsonDecTestComp : Json.Decode.Decoder a -> Json.Decode.Decoder ( TestComp a )" , "jsonDecTestComp localDecoder_a =" - , " (\"t1\" := jsonDecChange (Json.Decode.int)) `Json.Decode.andThen` \\pt1 ->" - , " (\"t2\" := jsonDecChange (localDecoder_a)) `Json.Decode.andThen` \\pt2 ->" + , " (\"t1\" := jsonDecChange (Json.Decode.int)) >>= \\pt1 ->" + , " (\"t2\" := jsonDecChange (localDecoder_a)) >>= \\pt2 ->" , " Json.Decode.succeed {t1 = pt1, t2 = pt2}" ] @@ -163,8 +163,9 @@ unaryBParse :: String unaryBParse = unlines [ "jsonDecUnaryB : Json.Decode.Decoder ( UnaryB )" - , "jsonDecUnaryB = decodeSumUnaries \"UnaryB\" jsonDecDictUnaryB" - , "jsonDecDictUnaryB = Dict.fromList [(\"UnaryB1\", UnaryB1), (\"UnaryB2\", UnaryB2)]" + , "jsonDecUnaryB = " + , " let jsonDecDictUnaryB = Dict.fromList [(\"UnaryB1\", UnaryB1), (\"UnaryB2\", UnaryB2)]" + , " in decodeSumUnaries \"UnaryB\" jsonDecDictUnaryB" ] unaryASer :: String diff --git a/test/Elm/ModuleSpec.hs b/test/Elm/ModuleSpec.hs --- a/test/Elm/ModuleSpec.hs +++ b/test/Elm/ModuleSpec.hs @@ -27,8 +27,7 @@ $(deriveElmDef (defaultOptionsDropLower 5) ''Qux) moduleHeader' :: ElmVersion -> String -> String -moduleHeader' Elm0p16 name = "module " ++ name ++ " where" -moduleHeader' Elm0p17 name = "module " ++ name ++ " exposing(..)" +moduleHeader' Elm0p18 name = "module " ++ name ++ " exposing(..)" moduleCode :: ElmVersion -> String moduleCode elmVersion = unlines @@ -53,11 +52,11 @@ , "" , "jsonDecBar : Json.Decode.Decoder a -> Json.Decode.Decoder ( Bar a )" , "jsonDecBar localDecoder_a =" - , " (\"name\" := localDecoder_a) `Json.Decode.andThen` \\pname ->" - , " (\"blablub\" := Json.Decode.int) `Json.Decode.andThen` \\pblablub ->" - , " (\"tuple\" := Json.Decode.tuple2 (,) (Json.Decode.int) (Json.Decode.string)) `Json.Decode.andThen` \\ptuple ->" - , " (\"list\" := Json.Decode.list (Json.Decode.bool)) `Json.Decode.andThen` \\plist ->" - , " (\"list_map\" := Json.Decode.list (Json.Decode.dict (Json.Decode.bool))) `Json.Decode.andThen` \\plist_map ->" + , " (\"name\" := localDecoder_a) >>= \\pname ->" + , " (\"blablub\" := Json.Decode.int) >>= \\pblablub ->" + , " (\"tuple\" := Json.Decode.map2 (,) (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string))) >>= \\ptuple ->" + , " (\"list\" := Json.Decode.list (Json.Decode.bool)) >>= \\plist ->" + , " (\"list_map\" := Json.Decode.list (Json.Decode.dict (Json.Decode.bool))) >>= \\plist_map ->" , " Json.Decode.succeed {name = pname, blablub = pblablub, tuple = ptuple, list = plist, list_map = plist_map}" , "" , "jsonEncBar : (a -> Value) -> Bar a -> Value" @@ -92,8 +91,8 @@ , "jsonDecQux : Json.Decode.Decoder a -> Json.Decode.Decoder ( Qux a )" , "jsonDecQux localDecoder_a =" , " let jsonDecDictQux = Dict.fromList" - , " [ (\"Qux1\", Json.Decode.tuple2 Qux1 (Json.Decode.int) (Json.Decode.string))" - , " , (\"Qux2\", Json.Decode.map Qux2 ( (\"a\" := Json.Decode.int) `Json.Decode.andThen` \\pa -> (\"test\" := localDecoder_a) `Json.Decode.andThen` \\ptest -> Json.Decode.succeed {a = pa, test = ptest}))" + , " [ (\"Qux1\", Json.Decode.map2 Qux1 (Json.Decode.index 0 (Json.Decode.int)) (Json.Decode.index 1 (Json.Decode.string)))" + , " , (\"Qux2\", Json.Decode.map Qux2 ( (\"a\" := Json.Decode.int) >>= \\pa -> (\"test\" := localDecoder_a) >>= \\ptest -> Json.Decode.succeed {a = pa, test = ptest}))" , " ]" , " in decodeSumObjectWithSingleField \"Qux\" jsonDecDictQux" , "" @@ -109,8 +108,7 @@ spec :: Spec spec = do makeElmModuleSpec - version0p16Spec - version0p17Spec + version0p18Spec makeElmModuleSpec :: Spec makeElmModuleSpec = @@ -118,23 +116,14 @@ it "should produce the correct code" $ do let modu = makeElmModule "Foo" [DefineElm (Proxy :: Proxy (Bar a))] let modu' = makeElmModule "Qux" [DefineElm (Proxy :: Proxy (Qux a))] - modu `shouldBe` (moduleCode Elm0p16) - modu' `shouldBe` (moduleCode' Elm0p16) - -version0p16Spec :: Spec -version0p16Spec = - describe "makeElmModuleWithVersion Elm0p16" $ - it "should produce the correct code" $ - do let modu = makeElmModuleWithVersion Elm0p16 "Foo" [DefineElm (Proxy :: Proxy (Bar a))] - let modu' = makeElmModuleWithVersion Elm0p16 "Qux" [DefineElm (Proxy :: Proxy (Qux a))] - modu `shouldBe` (moduleCode Elm0p16) - modu' `shouldBe` (moduleCode' Elm0p16) + modu `shouldBe` (moduleCode Elm0p18) + modu' `shouldBe` (moduleCode' Elm0p18) -version0p17Spec :: Spec -version0p17Spec = - describe "makeElmModuleWithVersion Elm0p17" $ +version0p18Spec :: Spec +version0p18Spec = + describe "makeElmModuleWithVersion Elm0p18" $ it "should produce the correct code" $ - do let modu = makeElmModuleWithVersion Elm0p17 "Foo" [DefineElm (Proxy :: Proxy (Bar a))] - let modu' = makeElmModuleWithVersion Elm0p17 "Qux" [DefineElm (Proxy :: Proxy (Qux a))] - modu `shouldBe` (moduleCode Elm0p17) - modu' `shouldBe` (moduleCode' Elm0p17) + do let modu = makeElmModuleWithVersion Elm0p18 "Foo" [DefineElm (Proxy :: Proxy (Bar a))] + let modu' = makeElmModuleWithVersion Elm0p18 "Qux" [DefineElm (Proxy :: Proxy (Qux a))] + modu `shouldBe` (moduleCode Elm0p18) + modu' `shouldBe` (moduleCode' Elm0p18) diff --git a/test/EndToEnd.hs b/test/EndToEnd.hs --- a/test/EndToEnd.hs +++ b/test/EndToEnd.hs @@ -119,36 +119,37 @@ elmModuleContent :: String elmModuleContent = unlines [ "-- This module requires the following packages:" - , "-- * deadfoxygrandpa/elm-test" + , "-- * elm-community/elm-test" , "-- * bartavelle/json-helpers" - , "module MyTests where" + , "module MyTests exposing (..)" , "" , "import Dict exposing (Dict)" , "import Set exposing (Set)" - , "import Json.Decode exposing ((:=), Value)" + , "import Json.Decode exposing (field, Value)" , "import Json.Encode" , "import Json.Helpers exposing (..)" - , "import ElmTest exposing (..)" - , "import Graphics.Element exposing (Element)" + , "import Test exposing (..)" + , "import Expect exposing (..)" + , "import Test.Runner.Html" , "import String" , "" - , "main : Element" - , "main = elementRunner <| suite \"Testing\" [ sumEncode, sumDecode, recordDecode, recordEncode, simpleEncode, simpleDecode ]" + , "main : Test.Runner.Html.TestProgram" + , "main = Test.Runner.Html.run <| concat [ sumEncode, sumDecode, recordDecode, recordEncode, simpleEncode, simpleDecode ]" , "" , "recordDecode : Test" - , "recordDecode = suite \"Record decoding checks\"" + , "recordDecode = describe \"Record decoding checks\"" , " [ recordDecode1" , " , recordDecode2" , " ]" , "" , "recordEncode : Test" - , "recordEncode = suite \"Record encoding checks\"" + , "recordEncode = describe \"Record encoding checks\"" , " [ recordEncode1" , " , recordEncode2" , " ]" , "" , "sumDecode : Test" - , "sumDecode = suite \"Sum decoding checks\"" + , "sumDecode = describe \"Sum decoding checks\"" , " [ sumDecode01" , " , sumDecode02" , " , sumDecode03" @@ -164,7 +165,7 @@ , " ]" , "" , "sumEncode : Test" - , "sumEncode = suite \"Sum encoding checks\"" + , "sumEncode = describe \"Sum encoding checks\"" , " [ sumEncode01" , " , sumEncode02" , " , sumEncode03" @@ -180,7 +181,7 @@ , " ]" , "" , "simpleDecode : Test" - , "simpleDecode = suite \"Simple records/types checks\"" + , "simpleDecode = describe \"Simple records/types checks\"" , " [ simpleDecode01" , " , simpleDecode02" , " , simpleDecode03" @@ -192,7 +193,7 @@ , " ]" , "" , "simpleEncode : Test" - , "simpleEncode = suite \"Simple records/types checks\"" + , "simpleEncode = describe \"Simple records/types checks\"" , " [ simpleEncode01" , " , simpleEncode02" , " , simpleEncode03" @@ -204,10 +205,10 @@ , " ]" , "" , "-- this is done to prevent artificial differences due to object ordering, this won't work with Maybe's though :(" - , "assertEqualHack : String -> String -> Assertion" - , "assertEqualHack a b =" + , "equalHack : String -> String -> Expectation" + , "equalHack a b =" , " let remix = Json.Decode.decodeString Json.Decode.value" - , " in assertEqual (remix a) (remix b)" + , " in equal (remix a) (remix b)" , "" , makeModuleContentWithAlterations (newtypeAliases ["Record1", "Record2", "SimpleRecord01", "SimpleRecord02", "SimpleRecord03", "SimpleRecord04"] . defaultAlterations) [ DefineElm (Proxy :: Proxy (Record1 a)) @@ -238,13 +239,13 @@ mkDecodeTest :: (Show a, ToJSON a) => String -> String -> String -> [a] -> String mkDecodeTest pred prefix num elems = unlines ( [ map toLower pred ++ "Decode" ++ num ++ " : Test" - , map toLower pred ++ "Decode" ++ num ++ " = suite \"" ++ pred ++ " decode " ++ num ++ "\"" + , map toLower pred ++ "Decode" ++ num ++ " = describe \"" ++ pred ++ " decode " ++ num ++ "\"" ] ++ map mktest (zip ([1..] :: [Int]) elems) ++ [" ]"] ) where - mktest (n,e) = pfix ++ "test \"" ++ show n ++ "\" (assertEqual (Ok (" ++ pretty ++ ")) (Json.Decode.decodeString (jsonDec" ++ pred ++ num ++ " (Json.Decode.list Json.Decode.int)) " ++ encoded ++ "))" + mktest (n,e) = pfix ++ "test \"" ++ show n ++ "\" (\\_ -> equal (Ok (" ++ pretty ++ ")) (Json.Decode.decodeString (jsonDec" ++ pred ++ num ++ " (Json.Decode.list Json.Decode.int)) " ++ encoded ++ "))" where pretty = T.unpack $ T.replace (T.pack (prefix ++ num)) T.empty $ T.pack $ show e encoded = show (encode e) @@ -259,13 +260,13 @@ mkEncodeTest :: (Show a, ToJSON a) => String -> String -> String -> [a] -> String mkEncodeTest pred prefix num elems = unlines ( [ map toLower pred ++ "Encode" ++ num ++ " : Test" - , map toLower pred ++ "Encode" ++ num ++ " = suite \"" ++ pred ++ " encode " ++ num ++ "\"" + , map toLower pred ++ "Encode" ++ num ++ " = describe \"" ++ pred ++ " encode " ++ num ++ "\"" ] ++ map mktest (zip ([1..] :: [Int]) elems) ++ [" ]"] ) where - mktest (n,e) = pfix ++ "test \"" ++ show n ++ "\" (assertEqualHack " ++ encoded ++ "(Json.Encode.encode 0 (jsonEnc" ++ pred ++ num ++ "(Json.Encode.list << List.map Json.Encode.int) (" ++ pretty ++ "))))" + mktest (n,e) = pfix ++ "test \"" ++ show n ++ "\" (\\_ -> equalHack " ++ encoded ++ "(Json.Encode.encode 0 (jsonEnc" ++ pred ++ num ++ "(Json.Encode.list << List.map Json.Encode.int) (" ++ pretty ++ "))))" where pretty = T.unpack $ T.replace (T.pack (prefix ++ num)) T.empty $ T.pack $ show e encoded = show (encode e)