diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# v0.4.2 + +Drop support for `aeson < 1.` +Add support for `aeson == 1.2.*` + # v0.4.1 ## Bugfixes diff --git a/elm-bridge.cabal b/elm-bridge.cabal --- a/elm-bridge.cabal +++ b/elm-bridge.cabal @@ -1,5 +1,5 @@ name: elm-bridge -version: 0.4.1 +version: 0.4.2 synopsis: Derive Elm types and Json code 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! @@ -14,6 +14,7 @@ category: Web, Compiler, Language build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3 extra-source-files: README.md @@ -34,7 +35,7 @@ other-modules: Elm.Utils build-depends: base >= 4.7 && < 5, template-haskell, - aeson >= 0.9 + aeson >= 1 default-language: Haskell2010 test-suite end-to-end-tests @@ -61,6 +62,7 @@ build-depends: base, hspec >= 2.0, + hspec-discover, elm-bridge, aeson, containers diff --git a/src/Elm/Derive.hs b/src/Elm/Derive.hs --- a/src/Elm/Derive.hs +++ b/src/Elm/Derive.hs @@ -40,22 +40,18 @@ -- | Note that This default set of options is distinct from that in -- the @aeson@ package. defaultOptions :: A.Options -defaultOptions = A.Options { A.sumEncoding = A.ObjectWithSingleField - , A.fieldLabelModifier = id - , A.constructorTagModifier = id - , A.allNullaryToStringTag = True - , A.omitNothingFields = False -#if MIN_VERSION_aeson(0,10,0) - , A.unwrapUnaryRecords = False -#endif - } +defaultOptions + = A.defaultOptions + { A.sumEncoding = A.ObjectWithSingleField + , A.fieldLabelModifier = id + , A.constructorTagModifier = id + , A.allNullaryToStringTag = True + , A.omitNothingFields = False + , A.unwrapUnaryRecords = False + } unwrapUnaryRecords :: A.Options -> Bool -#if MIN_VERSION_aeson(0,10,0) unwrapUnaryRecords opts = A.unwrapUnaryRecords opts -#else -unwrapUnaryRecords _ = False -#endif {-| This generates a default set of options. The parameter represents the number of characters that must be dropped from the Haskell field names. @@ -96,6 +92,7 @@ TwoElemArray -> [|SumEncoding' TwoElemArray|] ObjectWithSingleField -> [|SumEncoding' ObjectWithSingleField|] TaggedObject tn cn -> [|SumEncoding' (TaggedObject tn cn)|] + UntaggedValue -> [|SumEncoding' UntaggedValue|] runDerive :: Name -> [TyVarBndr] -> (Q Exp -> Q Exp) -> Q [Dec] runDerive name vars mkBody = diff --git a/src/Elm/Json.hs b/src/Elm/Json.hs --- a/src/Elm/Json.hs +++ b/src/Elm/Json.hs @@ -108,11 +108,12 @@ where tab n s = replicate n ' ' ++ s typename = et_name name - declLine [o] = "" - declLine os = " in " ++ case encodingType of + declLine [_] = "" + declLine _ = " in " ++ case encodingType of ObjectWithSingleField -> unwords [ "decodeSumObjectWithSingleField ", show typename, dictName] TwoElemArray -> unwords [ "decodeSumTwoElemArray ", show typename, dictName ] TaggedObject tg el -> unwords [ "decodeSumTaggedObject", show typename, show tg, show el, dictName, isObjectSetName ] + UntaggedValue -> "Json.Decode.oneOf (Dict.values " ++ dictName ++ ")" dictName = "jsonDecDict" ++ typename isObjectSetName = "jsonDecObjectSet" ++ typename deriveUnaries strs = unlines @@ -126,12 +127,13 @@ TaggedObject _ _ -> "\n" ++ tab 8 (isObjectSetName ++ " = " ++ "Set.fromList [" ++ intercalate ", " (map (show . fst) $ filter (isLeft . snd) opts) ++ "]") _ -> "" dictEntry (oname, args) = "(" ++ show oname ++ ", " ++ mkDecoder oname args ++ ")" - mkDecoder oname (Left args) = "Json.Decode.map " + mkDecoder oname (Left args) = lazy $ "Json.Decode.map " ++ cap oname ++ " (" ++ unwords (parseRecords Nothing False args) ++ ")" - mkDecoder oname (Right args) = unwords ( decodeFunction + + mkDecoder oname (Right args) = lazy $ unwords ( decodeFunction : cap oname : zipWith (\t' i -> "(" ++ jsonParserForIndexedType t' i ++ ")") args [0..] ) @@ -148,6 +150,7 @@ decoderType name = funcname name ++ " : " ++ intercalate " -> " (prependTypes "Json.Decode.Decoder " name ++ [decoderTypeEnd name]) decoderTypeEnd name = unwords ("Json.Decode.Decoder" : "(" : et_name name : map tv_name (et_args name) ++ [")"]) makeName name = unwords (funcname name : prependTypes "localDecoder_" name) + lazy decoder = "Json.Decode.lazy (\\_ -> " ++ decoder ++ ")" {-| Compile a JSON serializer for an Elm type. @@ -210,9 +213,10 @@ ObjectWithSingleField -> "encodeSumObjectWithSingleField" TwoElemArray -> "encodeSumTwoElementArray" TaggedObject k c -> unwords ["encodeSumTaggedObject", show k, show c] + UntaggedValue -> "encodeSumUntagged" defaultEncoding [(oname, Right args)] = unlines $ [ makeType name - , fname name ++ " " + , fname name ++ " " ++ unwords (map (\tv -> "localEncoder_" ++ tv_name tv) $ et_args name) ++ "(" ++ cap oname ++ " " ++ argList args ++ ") =" , " " ++ mkEncodeList args diff --git a/src/Elm/TyRep.hs b/src/Elm/TyRep.hs --- a/src/Elm/TyRep.hs +++ b/src/Elm/TyRep.hs @@ -113,24 +113,29 @@ TaggedObject n f -> "TaggedObject " ++ show n ++ " " ++ show f ObjectWithSingleField -> "ObjectWithSingleField" TwoElemArray -> "TwoElemArray" + UntaggedValue -> "UntaggedValue" instance Eq SumEncoding' where SumEncoding' a == SumEncoding' b = case (a,b) of (TaggedObject a1 b1, TaggedObject a2 b2) -> a1 == a2 && b1 == b2 (ObjectWithSingleField, ObjectWithSingleField) -> True (TwoElemArray, TwoElemArray) -> True + (UntaggedValue, UntaggedValue) -> True _ -> False instance Ord SumEncoding' where compare (SumEncoding' a) (SumEncoding' b) = case (a,b) of (TaggedObject a1 b1, TaggedObject a2 b2) -> compare a1 a2 <> compare b1 b2 + (ObjectWithSingleField, ObjectWithSingleField) -> EQ + (TwoElemArray, TwoElemArray) -> EQ + (UntaggedValue, UntaggedValue) -> EQ (TaggedObject _ _, _) -> LT (_, TaggedObject _ _) -> GT - (ObjectWithSingleField, ObjectWithSingleField) -> EQ (ObjectWithSingleField, _) -> LT (_, ObjectWithSingleField) -> GT - (TwoElemArray, TwoElemArray) -> EQ + (UntaggedValue, _) -> LT + (_, UntaggedValue) -> GT defSumEncoding :: SumEncoding' defSumEncoding = SumEncoding' ObjectWithSingleField diff --git a/test/Elm/JsonSpec.hs b/test/Elm/JsonSpec.hs --- a/test/Elm/JsonSpec.hs +++ b/test/Elm/JsonSpec.hs @@ -106,9 +106,9 @@ [ "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) >>= \\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)))" + , " [ (\"Baz1\", Json.Decode.lazy (\\_ -> 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.lazy (\\_ -> 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.lazy (\\_ -> Json.Decode.map Testing (jsonDecBaz (localDecoder_a))))" , " ]" , " in decodeSumObjectWithSingleField \"Baz\" jsonDecDictBaz" ] @@ -124,8 +124,8 @@ [ "jsonDecSomeOpts : Json.Decode.Decoder a -> Json.Decode.Decoder ( SomeOpts a )" , "jsonDecSomeOpts localDecoder_a =" , " let jsonDecDictSomeOpts = Dict.fromList" - , " [ (\"Okay\", Json.Decode.map Okay (Json.Decode.int))" - , " , (\"NotOkay\", Json.Decode.map NotOkay (localDecoder_a))" + , " [ (\"Okay\", Json.Decode.lazy (\\_ -> Json.Decode.map Okay (Json.Decode.int)))" + , " , (\"NotOkay\", Json.Decode.lazy (\\_ -> Json.Decode.map NotOkay (localDecoder_a)))" , " ]" , " in decodeSumObjectWithSingleField \"SomeOpts\" jsonDecDictSomeOpts" ] @@ -154,8 +154,8 @@ [ "jsonDecUnaryA : Json.Decode.Decoder ( UnaryA )" , "jsonDecUnaryA =" , " let jsonDecDictUnaryA = Dict.fromList" - , " [ (\"UnaryA1\", Json.Decode.succeed UnaryA1)" - , " , (\"UnaryA2\", Json.Decode.succeed UnaryA2)" + , " [ (\"UnaryA1\", Json.Decode.lazy (\\_ -> Json.Decode.succeed UnaryA1))" + , " , (\"UnaryA2\", Json.Decode.lazy (\\_ -> Json.Decode.succeed UnaryA2))" , " ]" , " in decodeSumObjectWithSingleField \"UnaryA\" jsonDecDictUnaryA" ] diff --git a/test/Elm/ModuleSpec.hs b/test/Elm/ModuleSpec.hs --- a/test/Elm/ModuleSpec.hs +++ b/test/Elm/ModuleSpec.hs @@ -89,8 +89,8 @@ , "jsonDecQux : Json.Decode.Decoder a -> Json.Decode.Decoder ( Qux a )" , "jsonDecQux localDecoder_a =" , " let jsonDecDictQux = Dict.fromList" - , " [ (\"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}))" + , " [ (\"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 ( (\"a\" := Json.Decode.int) >>= \\pa -> (\"test\" := localDecoder_a) >>= \\ptest -> Json.Decode.succeed {a = pa, test = ptest})))" , " ]" , " in decodeSumObjectWithSingleField \"Qux\" jsonDecDictQux" , "" diff --git a/test/EndToEnd.hs b/test/EndToEnd.hs --- a/test/EndToEnd.hs +++ b/test/EndToEnd.hs @@ -40,6 +40,9 @@ data SimpleRecord03 a = SimpleRecord03 { _s03qux :: a } deriving Show data SimpleRecord04 a = SimpleRecord04 { _s04qux :: a } deriving Show +data SumUntagged a = SMInt Int | SMList a + deriving Show + $(deriveBoth defaultOptions{ fieldLabelModifier = drop 3, omitNothingFields = False } ''Record1) $(deriveBoth defaultOptions{ fieldLabelModifier = drop 3, omitNothingFields = True } ''Record2) @@ -58,7 +61,6 @@ $(deriveBoth defaultOptions{ fieldLabelModifier = drop 4, omitNothingFields = False, allNullaryToStringTag = True , sumEncoding = TwoElemArray } ''Sum11) $(deriveBoth defaultOptions{ fieldLabelModifier = drop 4, omitNothingFields = True , allNullaryToStringTag = True , sumEncoding = TwoElemArray } ''Sum12) -#if MIN_VERSION_aeson(0,10,0) $(deriveBoth defaultOptions{ allNullaryToStringTag = False, unwrapUnaryRecords = False } ''Simple01) $(deriveBoth defaultOptions{ allNullaryToStringTag = False, unwrapUnaryRecords = True } ''Simple02) $(deriveBoth defaultOptions{ allNullaryToStringTag = True, unwrapUnaryRecords = False } ''Simple03) @@ -68,17 +70,8 @@ $(deriveBoth defaultOptions{ allNullaryToStringTag = False, unwrapUnaryRecords = True , fieldLabelModifier = drop 4 } ''SimpleRecord02) $(deriveBoth defaultOptions{ allNullaryToStringTag = True , unwrapUnaryRecords = False, fieldLabelModifier = drop 4 } ''SimpleRecord03) $(deriveBoth defaultOptions{ allNullaryToStringTag = True , unwrapUnaryRecords = True , fieldLabelModifier = drop 4 } ''SimpleRecord04) -#else -$(deriveBoth defaultOptions{ allNullaryToStringTag = False } ''Simple01) -$(deriveBoth defaultOptions{ allNullaryToStringTag = False } ''Simple02) -$(deriveBoth defaultOptions{ allNullaryToStringTag = True } ''Simple03) -$(deriveBoth defaultOptions{ allNullaryToStringTag = True } ''Simple04) -$(deriveBoth defaultOptions{ allNullaryToStringTag = False, fieldLabelModifier = drop 4 } ''SimpleRecord01) -$(deriveBoth defaultOptions{ allNullaryToStringTag = False, fieldLabelModifier = drop 4 } ''SimpleRecord02) -$(deriveBoth defaultOptions{ allNullaryToStringTag = True , fieldLabelModifier = drop 4 } ''SimpleRecord03) -$(deriveBoth defaultOptions{ allNullaryToStringTag = True , fieldLabelModifier = drop 4 } ''SimpleRecord04) -#endif +$(deriveBoth defaultOptions{ sumEncoding = UntaggedValue } ''SumUntagged) instance Arbitrary a => Arbitrary (Record1 a) where arbitrary = Record1 <$> arbitrary <*> fmap Just arbitrary <*> arbitrary <*> fmap Just arbitrary @@ -116,6 +109,8 @@ instance Arbitrary a => Arbitrary (SimpleRecord03 a) where arbitrary = SimpleRecord03 <$> arbitrary instance Arbitrary a => Arbitrary (SimpleRecord04 a) where arbitrary = SimpleRecord04 <$> arbitrary +instance Arbitrary a => Arbitrary (SumUntagged a) where arbitrary = oneof [ SMInt <$> arbitrary, SMList <$> arbitrary ] + elmModuleContent :: String elmModuleContent = unlines [ "-- This module requires the following packages:" @@ -130,12 +125,8 @@ , "import Json.Helpers exposing (..)" , "import Test exposing (..)" , "import Expect exposing (..)" - , "import Test.Runner.Html" , "import String" , "" - , "main : Test.Runner.Html.TestProgram" - , "main = Test.Runner.Html.run <| concat [ sumEncode, sumDecode, recordDecode, recordEncode, simpleEncode, simpleDecode ]" - , "" , "recordDecode : Test" , "recordDecode = describe \"Record decoding checks\"" , " [ recordDecode1" @@ -162,6 +153,7 @@ , " , sumDecode10" , " , sumDecode11" , " , sumDecode12" + , " , sumDecodeUntagged" , " ]" , "" , "sumEncode : Test" @@ -178,6 +170,7 @@ , " , sumEncode10" , " , sumEncode11" , " , sumEncode12" + , " , sumEncodeUntagged" , " ]" , "" , "simpleDecode : Test" @@ -233,6 +226,7 @@ , DefineElm (Proxy :: Proxy (SimpleRecord02 a)) , DefineElm (Proxy :: Proxy (SimpleRecord03 a)) , DefineElm (Proxy :: Proxy (SimpleRecord04 a)) + , DefineElm (Proxy :: Proxy (SumUntagged a)) ] ] @@ -314,6 +308,7 @@ sr02 <- sample' arbitrary :: IO [SimpleRecord02 [Int]] sr03 <- sample' arbitrary :: IO [SimpleRecord03 [Int]] sr04 <- sample' arbitrary :: IO [SimpleRecord04 [Int]] + sm <- sample' arbitrary :: IO [SumUntagged [Int]] args <- getArgs case args of [] -> return () @@ -363,5 +358,7 @@ , mkSimpleRecordDecodeTest "02" sr02 , mkSimpleRecordDecodeTest "03" sr03 , mkSimpleRecordDecodeTest "04" sr04 + , mkSumEncodeTest "Untagged" sm + , mkSumDecodeTest "Untagged" sm ]