smash-aeson 0.2.0.1 → 0.3.0
raw patch · 8 files changed
+329/−38 lines, 8 filesdep +QuickCheckdep +bytestringdep +smash-aesondep −unordered-containersdep ~aesondep ~basedep ~smashPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, bytestring, smash-aeson, tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: unordered-containers
Dependency ranges changed: aeson, base, smash
API changes (from Hackage documentation)
Files
- CHANGELOG.md +13/−0
- LICENSE +1/−1
- README.md +19/−1
- smash-aeson.cabal +29/−12
- src/Data/Can/Aeson.hs +44/−11
- src/Data/Smash/Aeson.hs +33/−8
- src/Data/Wedge/Aeson.hs +38/−5
- test/Main.hs +152/−0
CHANGELOG.md view
@@ -1,5 +1,18 @@ # Revision history for smash-aeson +## 0.3.0 -- 2026-10-26++* Start the `0.3` major release series and require `smash >=0.2.0 && <0.3`.+* Preserve the explicit ordinary and lifted JSON wire formats across `aeson` 2.0–2.3.++## 0.2.0.2 -- 2026-10-26++* Update dependency bounds and the supported GHC matrix to 9.6–9.14.+* Update copyrights through 2026.+* Support `aeson >=2.0 && <2.4` while retaining the explicit JSON wire formats.+* Decode two-field objects independently of key order.+* Add fixed wire-format fixtures, malformed-input tests, and ordinary/lifted instance properties.+ ## 0.2.0.1 -- 2022-04-03 * Update `base` bounds to allow GHC 9.2.x
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2020, Emily Pillmore+Copyright (c) 2020-2026, Emily Pillmore All rights reserved.
README.md view
@@ -1,5 +1,23 @@ # smash-aeson: Aeson support for the smash library -[](https://travis-ci.com/emilypi/smash)+[](https://github.com/emilypi/smash/actions/workflows/haskell-ci.yml) [](https://hackage.haskell.org/package/smash-aeson)++The instances use an explicit, stable object format across supported `aeson`+versions. Import the corresponding `Data.Can.Aeson`, `Data.Smash.Aeson`, or+`Data.Wedge.Aeson` module to bring the instances into scope.++| Value | JSON |+| --- | --- |+| `Non`, `Nada`, `Nowhere` | `{}` |+| `One a` | `{"One": a}` |+| `Eno b` | `{"Eno": b}` |+| `Two a b` | `{"One": a, "Eno": b}` |+| `Smash a b` | `{"SmashL": a, "SmashR": b}` |+| `Here a` | `{"Here": a}` |+| `There b` | `{"There": b}` |++Ordinary and lifted instances use the same representation. Object key order is+irrelevant when decoding. Unexpected or missing keys are rejected, and nullable+payloads retain their constructor keys even when their values are `null`.
smash-aeson.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: smash-aeson-version: 0.2.0.1+version: 0.3.0 synopsis: Aeson support for the smash library description: Aeson support for the `smash` library homepage: https://github.com/emilypi/smash@@ -9,19 +9,19 @@ license-file: LICENSE author: Emily Pillmore maintainer: emilypi@cohomolo.gy-copyright: (c) 2020-2022 Emily Pillmore <emilypi@cohomolo.gy>+copyright: (c) 2020-2026 Emily Pillmore <emilypi@cohomolo.gy> category: Data build-type: Simple-extra-source-files:+extra-doc-files: CHANGELOG.md README.md tested-with:- GHC ==8.6.5- || ==8.8.4- || ==8.10.7- || ==9.0.2- || ==9.2.2+ GHC ==9.6.7+ || ==9.8.4+ || ==9.10.3+ || ==9.12.4+ || ==9.14.1 library exposed-modules:@@ -30,11 +30,28 @@ Data.Wedge.Aeson build-depends:- aeson >=2.0 && <2.1- , base >=4.1 && <4.17- , smash >=0.1.3- , unordered-containers+ aeson >=2.0 && <2.4+ , base >=4.15 && <4.23+ , smash >=0.2.0 && <0.3 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall++test-suite smash-aeson-tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base >=4.15 && <4.23+ , smash-aeson+ , tasty >=1.4 && <1.6+ , tasty-hunit >=0.10 && <0.11+ , tasty-quickcheck >=0.10 && <0.12+ , QuickCheck >=2.14 && <2.17+ , smash >=0.2.0 && <0.3+ , aeson >=2.0 && <2.4+ , bytestring++ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
src/Data/Can/Aeson.hs view
@@ -3,7 +3,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Can.Aeson--- Copyright : (c) 2020-2022 Emily Pillmore+-- Copyright : (c) 2020-2026 Emily Pillmore -- License : BSD-3-Clause -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -12,16 +12,13 @@ -- -- This module contains the Aeson instances for the 'Can' datatype. ---module Data.Can.Aeson where+module Data.Can.Aeson () where import Data.Aeson import Data.Aeson.Encoding (emptyObject_, pair) import qualified Data.Aeson.KeyMap as KM import Data.Can (Can(..))-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup (Semigroup(..))-#endif instance (ToJSON a, ToJSON b) => ToJSON (Can a b) where@@ -36,52 +33,88 @@ toEncoding Non = emptyObject_ instance (FromJSON a, FromJSON b) => FromJSON (Can a b) where- parseJSON = withObject "Can a b" (go . KM.toList)+ parseJSON = withObject "Can a b" (go . KM.toAscList) where go [("One", a)] = One <$> parseJSON a go [("Eno", b)] = Eno <$> parseJSON b- go [("One", a), ("Eno", b)] = Two <$> parseJSON a <*> parseJSON b+ go [("Eno", b), ("One", a)] = Two <$> parseJSON a <*> parseJSON b go [] = pure Non go _ = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only" instance ToJSON2 Can where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON2 _ f _ _ _ _ (One a) = object [ "One" .= f a ]+ liftToJSON2 _ _ _ _ g _ (Eno b) = object [ "Eno" .= g b ]+ liftToJSON2 _ f _ _ g _ (Two a b) = object [ "One" .= f a, "Eno" .= g b ]+ liftToJSON2 _ _ _ _ _ _ Non = object []+#else liftToJSON2 f _ _ _ (One a) = object [ "One" .= f a ] liftToJSON2 _ _ g _ (Eno b) = object [ "Eno" .= g b ] liftToJSON2 f _ g _ (Two a b) = object [ "One" .= f a, "Eno" .= g b ] liftToJSON2 _ _ _ _ Non = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding2 _ f _ _ _ _ (One a) = pairs $ pair "One" (f a)+ liftToEncoding2 _ _ _ _ g _ (Eno b) = pairs $ pair "Eno" (g b)+ liftToEncoding2 _ f _ _ g _ (Two a b) = pairs $ pair "One" (f a) <> pair "Eno" (g b)+ liftToEncoding2 _ _ _ _ _ _ Non = emptyObject_+#else liftToEncoding2 f _ _ _ (One a) = pairs $ pair "One" (f a) liftToEncoding2 _ _ g _ (Eno b) = pairs $ pair "Eno" (g b) liftToEncoding2 f _ g _ (Two a b) = pairs $ pair "One" (f a) <> pair "Eno" (g b) liftToEncoding2 _ _ _ _ Non = emptyObject_+#endif instance ToJSON a => ToJSON1 (Can a) where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON _ _ _ (One a) = object [ "One" .= a ]+ liftToJSON _ g _ (Eno b) = object [ "Eno" .= g b ]+ liftToJSON _ g _ (Two a b) = object [ "One" .= a, "Eno" .= g b ]+ liftToJSON _ _ _ Non = object []+#else liftToJSON _ _ (One a) = object [ "One" .= a ] liftToJSON g _ (Eno b) = object [ "Eno" .= g b ] liftToJSON g _ (Two a b) = object [ "One" .= a, "Eno" .= g b ] liftToJSON _ _ Non = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding _ _ _ (One a) = pairs $ "One" .= a+ liftToEncoding _ g _ (Eno b) = pairs $ pair "Eno" (g b)+ liftToEncoding _ g _ (Two a b) = pairs $ "One" .= a <> pair "Eno" (g b)+ liftToEncoding _ _ _ Non = emptyObject_+#else liftToEncoding _ _ (One a) = pairs $ "One" .= a liftToEncoding g _ (Eno b) = pairs $ pair "Eno" (g b) liftToEncoding g _ (Two a b) = pairs $ "One" .= a <> pair "Eno" (g b) liftToEncoding _ _ Non = emptyObject_+#endif instance FromJSON2 Can where- liftParseJSON2 f _ g _ = withObject "Can a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON2 _ f _ _ g _ = withObject "Can a b" (go . KM.toAscList)+#else+ liftParseJSON2 f _ g _ = withObject "Can a b" (go . KM.toAscList)+#endif where go [] = pure Non go [("One", a)] = One <$> f a go [("Eno", b)] = Eno <$> g b- go [("One", a), ("Eno", b)] = Two <$> f a <*> g b+ go [("Eno", b), ("One", a)] = Two <$> f a <*> g b go _ = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only" instance FromJSON a => FromJSON1 (Can a) where- liftParseJSON f _ = withObject "Can a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON _ f _ = withObject "Can a b" (go . KM.toAscList)+#else+ liftParseJSON f _ = withObject "Can a b" (go . KM.toAscList)+#endif where go [] = pure Non go [("One", a)] = One <$> parseJSON a go [("Eno", b)] = Eno <$> f b- go [("One", a), ("Eno", b)] = Two <$> parseJSON a <*> f b+ go [("Eno", b), ("One", a)] = Two <$> parseJSON a <*> f b go _ = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only"
src/Data/Smash/Aeson.hs view
@@ -3,7 +3,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Smash.Aeson--- Copyright : (c) 2020-2022 Emily Pillmore+-- Copyright : (c) 2020-2026 Emily Pillmore -- License : BSD-3-Clause -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -13,15 +13,12 @@ -- This module contains the Aeson instances for the 'Smash' datatype. -- The 'Smash' instances, explicitly naming the tuple entries using `SmashL` and `SmashR` ---module Data.Smash.Aeson where+module Data.Smash.Aeson () where import Data.Aeson import Data.Aeson.Encoding (emptyObject_, pair) import qualified Data.Aeson.KeyMap as KM-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup (Semigroup(..))-#endif import Data.Smash (Smash(..)) @@ -33,7 +30,7 @@ toEncoding Nada = emptyObject_ instance (FromJSON a, FromJSON b) => FromJSON (Smash a b) where- parseJSON = withObject "Smash a b" (go . KM.toList)+ parseJSON = withObject "Smash a b" (go . KM.toAscList) where go [("SmashL", a), ("SmashR", b)] = Smash <$> parseJSON a <*> parseJSON b go [] = pure Nada@@ -41,29 +38,57 @@ instance ToJSON2 Smash where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON2 _ f _ _ g _ (Smash a b) = object [ "SmashL" .= f a, "SmashR" .= g b ]+ liftToJSON2 _ _ _ _ _ _ Nada = object []+#else liftToJSON2 f _ g _ (Smash a b) = object [ "SmashL" .= f a, "SmashR" .= g b ] liftToJSON2 _ _ _ _ Nada = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding2 _ f _ _ g _ (Smash a b) = pairs $ pair "SmashL" (f a) <> pair "SmashR" (g b)+ liftToEncoding2 _ _ _ _ _ _ Nada = emptyObject_+#else liftToEncoding2 f _ g _ (Smash a b) = pairs $ pair "SmashL" (f a) <> pair "SmashR" (g b) liftToEncoding2 _ _ _ _ Nada = emptyObject_+#endif instance ToJSON a => ToJSON1 (Smash a) where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON _ g _ (Smash a b) = object [ "SmashL" .= a, "SmashR" .= g b ]+ liftToJSON _ _ _ Nada = object []+#else liftToJSON g _ (Smash a b) = object [ "SmashL" .= a, "SmashR" .= g b ] liftToJSON _ _ Nada = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding _ g _ (Smash a b) = pairs $ "SmashL" .= a <> pair "SmashR" (g b)+ liftToEncoding _ _ _ Nada = emptyObject_+#else liftToEncoding g _ (Smash a b) = pairs $ "SmashL" .= a <> pair "SmashR" (g b) liftToEncoding _ _ Nada = emptyObject_+#endif instance FromJSON2 Smash where- liftParseJSON2 f _ g _ = withObject "Smash a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON2 _ f _ _ g _ = withObject "Smash a b" (go . KM.toAscList)+#else+ liftParseJSON2 f _ g _ = withObject "Smash a b" (go . KM.toAscList)+#endif where go [] = pure Nada go [("SmashL", a), ("SmashR", b)] = Smash <$> f a <*> g b go _ = fail "Expected either empty object, or a 'Smash' pair" instance FromJSON a => FromJSON1 (Smash a) where- liftParseJSON f _ = withObject "Smash a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON _ f _ = withObject "Smash a b" (go . KM.toAscList)+#else+ liftParseJSON f _ = withObject "Smash a b" (go . KM.toAscList)+#endif where go [] = pure Nada go [("SmashL", a), ("SmashR", b)] = Smash <$> parseJSON a <*> f b
src/Data/Wedge/Aeson.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Wedge.Aeson--- Copyright : (c) 2020-2022 Emily Pillmore+-- Copyright : (c) 2020-2026 Emily Pillmore -- License : BSD-3-Clause -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -11,7 +12,7 @@ -- -- This module contains the Aeson instances for the 'Wedge' datatype. ---module Data.Wedge.Aeson where+module Data.Wedge.Aeson () where import Data.Aeson@@ -30,7 +31,7 @@ toEncoding Nowhere = emptyObject_ instance (FromJSON a, FromJSON b) => FromJSON (Wedge a b) where- parseJSON = withObject "Wedge a b" (go . KM.toList)+ parseJSON = withObject "Wedge a b" (go . KM.toAscList) where go [("Here", a)] = Here <$> parseJSON a go [("There", b)] = There <$> parseJSON b@@ -39,26 +40,54 @@ instance ToJSON2 Wedge where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON2 _ f _ _ _ _ (Here a) = object [ "Here" .= f a ]+ liftToJSON2 _ _ _ _ g _ (There b) = object [ "There" .= g b ]+ liftToJSON2 _ _ _ _ _ _ Nowhere = object []+#else liftToJSON2 f _ _ _ (Here a) = object [ "Here" .= f a ] liftToJSON2 _ _ g _ (There b) = object [ "There" .= g b ] liftToJSON2 _ _ _ _ Nowhere = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding2 _ f _ _ _ _ (Here a) = pairs $ pair "Here" (f a)+ liftToEncoding2 _ _ _ _ g _ (There b) = pairs $ pair "There" (g b)+ liftToEncoding2 _ _ _ _ _ _ Nowhere = emptyObject_+#else liftToEncoding2 f _ _ _ (Here a) = pairs $ pair "Here" (f a) liftToEncoding2 _ _ g _ (There b) = pairs $ pair "There" (g b) liftToEncoding2 _ _ _ _ Nowhere = emptyObject_+#endif instance ToJSON a => ToJSON1 (Wedge a) where+#if MIN_VERSION_aeson(2,2,0)+ liftToJSON _ _ _ (Here a) = object [ "Here" .= a ]+ liftToJSON _ g _ (There b) = object [ "There" .= g b ]+ liftToJSON _ _ _ Nowhere = object []+#else liftToJSON _ _ (Here a) = object [ "Here" .= a ] liftToJSON g _ (There b) = object [ "There" .= g b ] liftToJSON _ _ Nowhere = object []+#endif +#if MIN_VERSION_aeson(2,2,0)+ liftToEncoding _ _ _ (Here a) = pairs $ "Here" .= a+ liftToEncoding _ g _ (There b) = pairs $ pair "There" (g b)+ liftToEncoding _ _ _ Nowhere = emptyObject_+#else liftToEncoding _ _ (Here a) = pairs $ "Here" .= a liftToEncoding g _ (There b) = pairs $ pair "There" (g b) liftToEncoding _ _ Nowhere = emptyObject_+#endif instance FromJSON2 Wedge where- liftParseJSON2 f _ g _ = withObject "Wedge a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON2 _ f _ _ g _ = withObject "Wedge a b" (go . KM.toAscList)+#else+ liftParseJSON2 f _ g _ = withObject "Wedge a b" (go . KM.toAscList)+#endif where go [] = pure Nowhere go [("Here", a)] = Here <$> f a@@ -66,7 +95,11 @@ go _ = fail "Expected either empty object, or one with 'Here' or 'There' keys only" instance FromJSON a => FromJSON1 (Wedge a) where- liftParseJSON f _ = withObject "Wedge a b" (go . KM.toList)+#if MIN_VERSION_aeson(2,2,0)+ liftParseJSON _ f _ = withObject "Wedge a b" (go . KM.toAscList)+#else+ liftParseJSON f _ = withObject "Wedge a b" (go . KM.toAscList)+#endif where go [] = pure Nowhere go [("Here", a)] = Here <$> parseJSON a
+ test/Main.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- Copyright (c) 2020-2026 Emily Pillmore+module Main (main) where++import Control.Monad (forM_)+import Data.Aeson+import Data.Aeson.Encoding (encodingToLazyByteString)+import Data.Aeson.Types (Parser, parseEither)+import Data.Bifunctor (Bifunctor, bimap)+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Can+import Data.Can.Aeson ()+import Data.Either (isLeft)+import Data.Smash+import Data.Smash.Aeson ()+import Data.Wedge+import Data.Wedge.Aeson ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++main :: IO ()+main = defaultMain $ testGroup "smash-aeson"+ [ wireTests "Can"+ [(Non, "{}"), (One 7, "{\"One\":7}"), (Eno 9, "{\"Eno\":9}"),+ (Two 7 9, "{\"One\":7,\"Eno\":9}")]+ (oneof [pure Non, One <$> arbitrary, Eno <$> arbitrary, Two <$> arbitrary <*> arbitrary])+ ["{\"Other\":1}", "{\"One\":1,\"Other\":2}", "{\"One\":1,\"Eno\":2,\"Other\":3}",+ "{\"One\":null}", "{\"Eno\":false}", "{\"tag\":\"Non\"}"]+ , wireTests "Smash"+ [(Nada, "{}"), (Smash 7 9, "{\"SmashL\":7,\"SmashR\":9}")]+ (oneof [pure Nada, Smash <$> arbitrary <*> arbitrary])+ ["{\"SmashL\":1}", "{\"SmashR\":2}", "{\"SmashL\":1,\"SmashR\":2,\"Other\":3}",+ "{\"SmashL\":null,\"SmashR\":2}", "{\"tag\":\"Nada\"}"]+ , wireTests "Wedge"+ [(Nowhere, "{}"), (Here 7, "{\"Here\":7}"), (There 9, "{\"There\":9}")]+ (oneof [pure Nowhere, Here <$> arbitrary, There <$> arbitrary])+ ["{\"Here\":1,\"There\":2}", "{\"Other\":1}", "{\"Here\":1,\"Other\":2}",+ "{\"Here\":null}", "{\"There\":false}", "{\"tag\":\"Nowhere\"}"]+ , testCase "Can accepts both object key orders" $ forM_+ ["{\"One\":7,\"Eno\":9}", "{\"Eno\":9,\"One\":7}"] $ \bytes ->+ checkParsers (Two 7 9 :: Can Int Int) bytes+ , testCase "Smash accepts both object key orders" $ forM_+ ["{\"SmashL\":7,\"SmashR\":9}", "{\"SmashR\":9,\"SmashL\":7}"] $ \bytes ->+ checkParsers (Smash 7 9 :: Smash Int Int) bytes+ , testCase "nullable payloads retain their constructor keys" $ do+ checkNullable (Two Nothing Nothing :: Can (Maybe Int) (Maybe Int)) "{\"One\":null,\"Eno\":null}"+ checkNullable (One Nothing :: Can (Maybe Int) (Maybe Int)) "{\"One\":null}"+ checkNullable (Eno Nothing :: Can (Maybe Int) (Maybe Int)) "{\"Eno\":null}"+ checkNullable (Smash Nothing Nothing :: Smash (Maybe Int) (Maybe Int)) "{\"SmashL\":null,\"SmashR\":null}"+ checkNullable (Here Nothing :: Wedge (Maybe Int) (Maybe Int)) "{\"Here\":null}"+ checkNullable (There Nothing :: Wedge (Maybe Int) (Maybe Int)) "{\"There\":null}"+ ]++wireTests+ :: forall f. (Eq (f Int Int), Show (f Int Int), ToJSON (f Int Int), FromJSON (f Int Int),+ ToJSON1 (f Int), FromJSON1 (f Int), ToJSON2 f, FromJSON2 f, Bifunctor f)+ => String -> [(f Int Int, BL.ByteString)] -> Gen (f Int Int) -> [BL.ByteString] -> TestTree+wireTests name vectors gen invalid = testGroup name+ [ testGroup "Legacy wire fixtures"+ [ testCase (show x) $ do+ encode x @?= bytes+ toJSON x @?= fixtureValue bytes+ toJSON1 x @?= fixtureValue bytes+ toJSON2 x @?= fixtureValue bytes+ encodingToLazyByteString (toEncoding1 x) @?= bytes+ encodingToLazyByteString (toEncoding2 x) @?= bytes+ checkParsers x bytes+ | (x, bytes) <- vectors+ ]+ , testGroup "Reject malformed representations"+ [ testCase (BL.unpack bytes) $ do+ assertBool "ordinary parser accepted invalid input" (isLeft (eitherDecode bytes :: Either String (f Int Int)))+ assertBool "unary parser accepted invalid input" (isLeft (parseEither parseJSON1 (fixtureValue bytes) :: Either String (f Int Int)))+ assertBool "binary parser accepted invalid input" (isLeft (parseEither parseJSON2 (fixtureValue bytes) :: Either String (f Int Int)))+ | bytes <- ["null", "[]", "7", "true", "\"Non\""] ++ invalid+ ]+ , testProperty "ordinary and lifted roundtrips" $ forAll gen $ \x -> conjoin+ [ eitherDecode (encode x) === Right x+ , parseEither parseJSON1 (toJSON1 x) === Right x+ , parseEither parseJSON2 (toJSON2 x) === Right x+ , eitherDecode (encodingToLazyByteString (toEncoding1 x)) === Right x+ , eitherDecode (encodingToLazyByteString (toEncoding2 x)) === Right x+ ]+ , testProperty "lifted callbacks preserve keys and transform payloads" $ forAll gen $ \x -> conjoin+ [ customJSON1 x === toJSON (fmapRight x)+ , customJSON2 x === toJSON (bimap (+10) (*3) x)+ , fixtureValue (encodingToLazyByteString (customEncoding1 x)) === customJSON1 x+ , fixtureValue (encodingToLazyByteString (customEncoding2 x)) === customJSON2 x+ , parseEither customParse1 (customJSON1 x) === Right x+ , parseEither customParse2 (customJSON2 x) === Right x+ ]+ ]+ where+ fmapRight = bimap id (*3)++fixtureValue :: BL.ByteString -> Value+fixtureValue bytes = either error id (eitherDecode bytes)++checkParsers+ :: (Eq (f Int Int), Show (f Int Int), FromJSON (f Int Int), FromJSON1 (f Int), FromJSON2 f)+ => f Int Int -> BL.ByteString -> Assertion+checkParsers x bytes = do+ eitherDecode bytes @?= Right x+ parseEither parseJSON1 (fixtureValue bytes) @?= Right x+ parseEither parseJSON2 (fixtureValue bytes) @?= Right x++checkNullable+ :: (Eq (f (Maybe Int) (Maybe Int)), Show (f (Maybe Int) (Maybe Int)),+ ToJSON (f (Maybe Int) (Maybe Int)), FromJSON (f (Maybe Int) (Maybe Int)),+ ToJSON1 (f (Maybe Int)), FromJSON1 (f (Maybe Int)), ToJSON2 f, FromJSON2 f)+ => f (Maybe Int) (Maybe Int) -> BL.ByteString -> Assertion+checkNullable x bytes = do+ encode x @?= bytes+ toJSON1 x @?= fixtureValue bytes+ toJSON2 x @?= fixtureValue bytes+ encodingToLazyByteString (toEncoding1 x) @?= bytes+ encodingToLazyByteString (toEncoding2 x) @?= bytes+ eitherDecode bytes @?= Right x+ parseEither parseJSON1 (fixtureValue bytes) @?= Right x+ parseEither parseJSON2 (fixtureValue bytes) @?= Right x++-- Aeson 2.2 added omission arguments. Explicit constructor fields must still+-- be emitted and required even when callbacks would allow their omission.+#if MIN_VERSION_aeson(2,2,0)+#define OMIT (const True)+#define MISSING (Just 42)+#else+#define OMIT+#define MISSING+#endif++customJSON1 :: ToJSON1 f => f Int -> Value+customJSON1 = liftToJSON OMIT (toJSON . (*3)) toJSON++customJSON2 :: ToJSON2 f => f Int Int -> Value+customJSON2 = liftToJSON2 OMIT (toJSON . (+10)) toJSON OMIT (toJSON . (*3)) toJSON++customEncoding1 :: ToJSON1 f => f Int -> Encoding+customEncoding1 = liftToEncoding OMIT (toEncoding . (*3)) toEncoding++customEncoding2 :: ToJSON2 f => f Int Int -> Encoding+customEncoding2 = liftToEncoding2 OMIT (toEncoding . (+10)) toEncoding OMIT (toEncoding . (*3)) toEncoding++customParse1 :: FromJSON1 f => Value -> Parser (f Int)+customParse1 = liftParseJSON MISSING (fmap (`div` 3) . parseJSON) parseJSON++customParse2 :: FromJSON2 f => Value -> Parser (f Int Int)+customParse2 = liftParseJSON2 MISSING (fmap (subtract 10) . parseJSON) parseJSON MISSING (fmap (`div` 3) . parseJSON) parseJSON