safe-json 1.1.1.1 → 1.1.2.0

raw patch · 9 files changed

+264/−84 lines, 9 filesdep ~aesondep ~hashabledep ~safe-jsonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, hashable, safe-json

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• safe-json.cabal +13/−10
• src/Data/SafeJSON/Internal.hs +114/−51
• test/Consistency/Primitives.hs +14/−0
• test/Instances.hs +16/−0
• test/MigrationTests.hs +8/−2
• test/PrimitiveTests.hs +50/−6
• test/Version.hs +27/−14
• test/json/primitives.json +15/−1

@@ -1,5 +1,12 @@ # Changelog for safe-json +## 1.1.2.0++* Aeson <= 2.0.2.0 compatibility (https://cs-syd.eu/posts/2021-09-11-json-vulnerability)+    * Fix internal code to work with new `Key` and `KeyMap` from `aeson-2.0.0.0` [#28] Thanks to @dysinger+    * Added `SafeJSON` instances for `Key` and `KeyMap` [#29]+    * Added `SafeJSON` instances for `Compose`, `Product` and `Sum` [#29]+ ## 1.1.1.1  * loosened dependecy restriction on `tasty`

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: b7372a5a81832b55c168d9e63f92b1a4899ff44b801f2be33d799d7ca2902655+-- hash: 8355ba082d5b33671f6951544a67e1c0874971b8a3b339abe51a00d2d381641f  name:           safe-json-version:        1.1.1.1+version:        1.1.2.0 synopsis:       Automatic JSON format versioning description:    This library aims to make the updating of JSON formats or contents, while keeping backward compatibility, as painless as possible. The way this is achieved is through versioning and defined migration functions to migrate older (or newer) versions to the one used.                 .@@ -28,7 +28,8 @@ copyright:      2019 Felix Paulusma license:        MIT license-file:   LICENSE-tested-with:    GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4, GHC == 8.6.5, GHC == 8.8.4+tested-with:+    GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1 build-type:     Simple extra-source-files:     README@@ -60,9 +61,10 @@       Paths_safe_json   hs-source-dirs:       src-  default-extensions: OverloadedStrings+  default-extensions:+      OverloadedStrings   build-depends:-      aeson >=1.4.1 && <1.6+      aeson >=1.4.1 && <2.1     , base >=4.9 && <5     , bytestring >=0.10.8.1 && <0.11     , containers >=0.5.7.1 && <0.7@@ -96,18 +98,19 @@       Paths_safe_json   hs-source-dirs:       test-  default-extensions: OverloadedStrings+  default-extensions:+      OverloadedStrings   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      aeson >=1.4.1 && <1.6+      aeson >=1.4.1 && <2.1     , base >=4.9 && <5     , bytestring >=0.10.8.1 && <0.11     , containers >=0.5.7.1 && <0.7     , dlist >=0.8.0.3 && <2-    , generic-arbitrary >=0.1.0 && <0.2+    , generic-arbitrary >=0.1.0 && <0.3     , hashable >=1.2.6.1 && <1.4     , quickcheck-instances >=0.3.16 && <0.4-    , safe-json >=1.0 && <1.2+    , safe-json     , scientific >=0.3.5.2 && <0.4     , tasty     , tasty-hunit

@@ -32,27 +32,30 @@ module Data.SafeJSON.Internal where  +#if MIN_VERSION_base(4,13,0)+import Control.Applicative (Const(..), (<|>))+#else import Control.Applicative (Applicative(..), Const(..), (<|>))-import Control.Monad (when) import Control.Monad.Fail (MonadFail)+#endif+import Control.Monad (when) import Data.Aeson import Data.Aeson.Types (Parser, explicitParseField, explicitParseFieldMaybe, explicitParseFieldMaybe') import Data.DList as DList (DList, fromList) import Data.Fixed (Fixed, HasResolution) import Data.Functor.Identity (Identity(..))-import Data.Functor.Compose (Compose) -- FIXME: add SafeJSON Instances-import Data.Functor.Product (Product) -- FIXME: add SafeJSON Instances-import Data.Functor.Sum (Sum(..))     -- FIXME: add SafeJSON Instances+import Data.Functor.Compose (Compose (..))+import Data.Functor.Product (Product (..))+import Data.Functor.Sum (Sum(..)) import Data.Hashable (Hashable)-import Data.HashMap.Strict as HM (insert, size)-import qualified Data.HashMap.Strict as HM (HashMap, delete, fromList, lookup, toList)+import Data.HashMap.Strict (HashMap) import qualified Data.HashSet as HS (HashSet, fromList, toList) import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap as IM (IntMap, fromList) import Data.IntSet (IntSet) import qualified Data.List as List (intercalate, lookup) import Data.List.NonEmpty (NonEmpty(..))-import Data.Map (Map)+import Data.Map as M (Map, singleton) import Data.Maybe (fromMaybe, isJust, isNothing) #if MIN_VERSION_base(4,11,0) import Data.Monoid (Dual(..))@@ -90,6 +93,12 @@ import Numeric.Natural (Natural) import Test.Tasty.QuickCheck (Arbitrary(..), shrinkIntegral) +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K (Key)+import qualified Data.Aeson.KeyMap as Map (KeyMap, delete, fromMap, insert, lookup, size, toList)+#else+import qualified Data.HashMap.Strict as Map (delete, insert, lookup, size, toList)+#endif  -- | A type that can be converted from and to JSON with versioning baked --   in, using 'Migrate' to automate migration between versions, reducing@@ -244,8 +253,8 @@       Object o ->           let vField = maybe versionField                              (const dataVersionField)-                             $ dataVersionField `HM.lookup` o-          in Object $ HM.insert vField (toJSON i) o+                             $ dataVersionField `Map.lookup` o+          in Object $ Map.insert vField (toJSON i) o       other -> object           [ dataVersionField .= i           , dataField .= other@@ -304,9 +313,9 @@     other -> other         -- Recursively find all version tags and remove them.   where go o = maybe regular removeVersion $ do-                  _ <- dataVersionField `HM.lookup` o-                  dataField `HM.lookup` o-          where regular = Object $ removeVersion <$> HM.delete versionField o+                  _ <- dataVersionField `Map.lookup` o+                  dataField `Map.lookup` o+          where regular = Object $ removeVersion <$> Map.delete versionField o  instance Show (Version a) where   show (Version mi) = "Version " ++ showV mi@@ -379,13 +388,13 @@ -- low probability of showing up naturally in JSON objects one -- would normally find or construct. -versionField :: Text+#if MIN_VERSION_aeson(2,0,0)+versionField, dataVersionField, dataField :: Key+#else+versionField, dataVersionField, dataField :: Text+#endif versionField = "!v"--dataVersionField :: Text dataVersionField = "~v"--dataField :: Text dataField = "~d"  -- | Use this exactly how you would use 'toJSON' from "Data.Aeson".@@ -486,7 +495,7 @@          firstTry o = do             v <- o .: versionField-            let versionLessObj = HM.delete versionField o+            let versionLessObj = Map.delete versionField o             return (Object versionLessObj, Version $ Just v)         secondTry o = do             v  <- o .: dataVersionField@@ -494,7 +503,7 @@             -- This is an extra counter measure against false parsing.             -- The simple data object should contain exactly the             -- (~v) and (~d) fields-            when (HM.size o /= 2) $ fail $ "malformed simple data (" ++ show (Version $ Just v) ++ ")"+            when (Map.size o /= 2) $ fail $ "malformed simple data (" ++ show (Version $ Just v) ++ ")"             return (bd, Version $ Just v)  -- This takes the version number found (or Nothing) and tries find the type in@@ -767,21 +776,33 @@ -- to parse the value in the given field. -- -- @since 1.0.0+#if MIN_VERSION_aeson(2,0,0)+(.:$) :: SafeJSON a => Object -> Key -> Parser a+#else (.:$) :: SafeJSON a => Object -> Text -> Parser a+#endif (.:$) = explicitParseField safeFromJSON  -- | Similar to 'Data.Aeson..:?', but uses `safeFromJSON` instead of parseJSON -- to maybe parse the value in the given field. -- -- @since 1.0.0+#if MIN_VERSION_aeson(2,0,0)+(.:$?) :: SafeJSON a => Object -> Key -> Parser (Maybe a)+#else (.:$?) :: SafeJSON a => Object -> Text -> Parser (Maybe a)+#endif (.:$?) = explicitParseFieldMaybe safeFromJSON  -- | Similar to 'Data.Aeson..:!', but uses `safeFromJSON` instead of parseJSON -- to maybe parse the value in the given field. -- -- @since 1.0.0+#if MIN_VERSION_aeson(2,0,0)+(.:$!) :: SafeJSON a => Object -> Key -> Parser (Maybe a)+#else (.:$!) :: SafeJSON a => Object -> Text -> Parser (Maybe a)+#endif (.:$!) = explicitParseFieldMaybe' safeFromJSON  @@ -794,7 +815,11 @@ -- to convert the value in that key-value pair. -- -- @since 1.0.0+#if MIN_VERSION_aeson(2,0,0)+(.=$) :: (SafeJSON a, KeyValue kv) => Key -> a -> kv+#else (.=$) :: (SafeJSON a, KeyValue kv) => Text -> a -> kv+#endif name .=$ val = name .= safeToJSON val  @@ -826,6 +851,9 @@ BASIC_NULLARY(Word64) BASIC_NULLARY(T.Text) BASIC_NULLARY(LT.Text)+#if MIN_VERSION_aeson(2,0,0)+BASIC_NULLARY(K.Key)+#endif BASIC_NULLARY(DV.Version) BASIC_NULLARY(Scientific) BASIC_NULLARY(IntSet)@@ -836,7 +864,7 @@   typeName = typeName1   version = noVersion -instance (HasResolution a) => SafeJSON (Fixed a) where+instance HasResolution a => SafeJSON (Fixed a) where   typeName = typeName1   version = noVersion @@ -874,9 +902,8 @@   version = noVersion  instance SafeJSON a => SafeJSON (Maybe a) where-  -- This follows the same 'Null' logic as the aeson library-  safeFrom Null = contain $ pure (Nothing :: Maybe a)-  safeFrom val = contain $ Just <$> safeFromJSON val+  safeFrom val = contain $+      parseJSON val >>= traverse safeFromJSON   -- Nothing means do whatever Aeson thinks Nothing should be   safeTo Nothing = contain $ toJSON (Nothing :: Maybe Value)   -- If there's something, keep it safe@@ -949,9 +976,8 @@ --   a list of that type where each element has been migrated as --   appropriate. instance  {-# OVERLAPPABLE #-} SafeJSON a => SafeJSON [a] where-  safeFrom val = contain $ do-      vs <- parseJSON val-      mapM safeFromJSON vs+  safeFrom val = contain $+      parseJSON val >>= traverse safeFromJSON   safeTo as = contain . toJSON $ safeToJSON <$> as   typeName = typeName1   version = noVersion@@ -959,7 +985,7 @@ #define BASIC_UNARY_FUNCTOR(T)                      \ instance SafeJSON a => SafeJSON (T a) where {       \   safeFrom val = contain $                          \-      parseJSON val >>= mapM safeFromJSON;          \+      parseJSON val >>= traverse safeFromJSON;      \   safeTo as = contain . toJSON $ safeToJSON <$> as; \   typeName = typeName1;                             \   version = noVersion }@@ -968,60 +994,68 @@ BASIC_UNARY_FUNCTOR(Seq) BASIC_UNARY_FUNCTOR(Tree) -instance (SafeJSON a) => SafeJSON (IntMap a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      IM.fromList <$> mapM safeFromJSON vs+instance SafeJSON a => SafeJSON (IntMap a) where+  safeFrom val = contain $+      IM.fromList <$> safeFromJSON val   safeTo as = contain . toJSON $ safeToJSON <$> as   typeName = typeName1   version = noVersion  instance (SafeJSON a) => SafeJSON (DList a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      DList.fromList <$> mapM safeFromJSON vs+  safeFrom val = contain $+      DList.fromList <$> safeFromJSON val   safeTo as = contain . toJSON $ safeToJSON <$> as   typeName = typeName1   version = noVersion  instance (SafeJSON a, Ord a) => SafeJSON (S.Set a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      S.fromList <$> safeFromJSON vs+  safeFrom val = contain $+      S.fromList <$> safeFromJSON val   safeTo as = contain . toJSON $ safeToJSON <$> S.toList as   typeName = typeName1   version = noVersion  instance (Ord k, FromJSONKey k, ToJSONKey k, SafeJSON a) => SafeJSON (Map k a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      mapM safeFromJSON vs+  safeFrom val = contain $+      parseJSON val >>= traverse safeFromJSON   safeTo as = contain . toJSON $ safeToJSON <$> as   typeName = typeName2   version = noVersion  instance (SafeJSON a, Eq a, Hashable a) => SafeJSON (HS.HashSet a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      HS.fromList <$> safeFromJSON vs+  safeFrom val = contain $+      HS.fromList <$> safeFromJSON val   safeTo as = contain . toJSON $ safeToJSON <$> HS.toList as   typeName = typeName1   version = noVersion -instance (Hashable a, FromJSONKey a, ToJSONKey a, Eq a, SafeJSON b) => SafeJSON (HM.HashMap a b) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      fmap HM.fromList . mapM (mapM safeFromJSON) $ HM.toList vs+instance (Hashable a, FromJSONKey a, ToJSONKey a, Eq a, SafeJSON b) => SafeJSON (HashMap a b) where+  safeFrom val = contain $+      parseJSON val >>= traverse safeFromJSON   safeTo as = contain . toJSON $ safeToJSON <$> as   typeName = typeName2   version = noVersion +#if MIN_VERSION_aeson(2,0,0)+-- | @since 1.1.2.0+instance SafeJSON a => SafeJSON (Map.KeyMap a) where+  safeFrom val = contain $+#if !MIN_VERSION_aeson(2,0,1)+      fmap Map.fromMap $+#endif+          parseJSON val >>=+              traverse safeFromJSON+  safeTo as = contain . toJSON $ safeToJSON <$> as+  typeName = typeName1+  version = noVersion+#endif+ instance (SafeJSON a, SafeJSON b) => SafeJSON (a, b) where   safeFrom x = contain $ do       (a',b') <- parseJSON x       a <- safeFromJSON a'       b <- safeFromJSON b'-      return (a,b)+      pure (a,b)   safeTo (a,b) = contain $ toJSON (safeToJSON a, safeToJSON b)   typeName = typeName2   version = noVersion@@ -1032,7 +1066,7 @@       a <- safeFromJSON a'       b <- safeFromJSON b'       c <- safeFromJSON c'-      return (a,b,c)+      pure (a,b,c)   safeTo (a,b,c) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c)   typeName = typeName3   version = noVersion@@ -1044,7 +1078,7 @@       b <- safeFromJSON b'       c <- safeFromJSON c'       d <- safeFromJSON d'-      return (a,b,c,d)+      pure (a,b,c,d)   safeTo (a,b,c,d) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c, safeToJSON d)   typeName = typeName4   version = noVersion@@ -1057,7 +1091,36 @@       c <- safeFromJSON c'       d <- safeFromJSON d'       e <- safeFromJSON e'-      return (a,b,c,d,e)+      pure (a,b,c,d,e)   safeTo (a,b,c,d,e) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c, safeToJSON d, safeToJSON e)   typeName = typeName5   version = noVersion++-- | @since 1.1.2.0+instance SafeJSON (f (g a)) => SafeJSON (Compose f g a) where+    safeFrom val = contain $ Compose <$> safeFromJSON val+    safeTo (Compose val) = contain $ safeToJSON val+    typeName _ = "Compose"+    version = noVersion++-- | @since 1.1.2.0+instance (SafeJSON (f a), SafeJSON (g a)) => SafeJSON (Sum f g a) where+    safeFrom = containWithObject "Sum" $ \o -> do+        case Map.toList o of+            [("InL", val)] -> InL <$> safeFromJSON val+            [("InR", val)] -> InR <$> safeFromJSON val+            _ -> fail "Sum expects an object with one field: \"InL\" or \"InR\""+    safeTo = contain . safeToJSON . uncurry M.singleton . \case+        InL fa -> ("InL" :: String, safeToJSON fa)+        InR ga -> ("InR" :: String, safeToJSON ga)+    typeName _ = "Sum"+    version = noVersion++-- | @since 1.1.2.0+instance (SafeJSON (f a), SafeJSON (g a), SafeJSON a) => SafeJSON (Product f g a) where+    safeFrom val = contain $ do+        (f, g) <- parseJSON val+        Pair <$> safeFromJSON f <*> safeFromJSON g+    safeTo (Pair f g) = contain $ toJSON (safeToJSON f, safeToJSON g)+    typeName _ = "Product"+    version = noVersion

@@ -1,12 +1,19 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} module Consistency.Primitives where   import Control.Applicative (Const) import Data.Aeson (DotNetTime, Value)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM (KeyMap)+#endif import Data.DList (DList) import Data.Fixed (E12, Fixed)+import Data.Functor.Compose (Compose) import Data.Functor.Identity (Identity)+import Data.Functor.Product (Product)+import Data.Functor.Sum (Sum) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import Data.Int (Int8, Int16, Int32, Int64)@@ -107,8 +114,15 @@   , testRoundTripProp @(Map T.Text Int)     "Map"   , testRoundTripProp @(HashSet Int)        "HashSet"   , testRoundTripProp @(HashMap T.Text Int) "HashMap"+#if MIN_VERSION_aeson(2,0,0)+  , testRoundTripProp @(KM.KeyMap T.Text)   "Aeson.KeyMap"+#endif   , testRoundTripProp @(Int, Bool)                        "Tuple2"   , testRoundTripProp @(Int, Bool, T.Text)                "Tuple3"   , testRoundTripProp @(Int, Bool, T.Text, [Int])         "Tuple4"   , testRoundTripProp @(Int, Bool, T.Text, [Int], Double) "Tuple5"++  , testRoundTripProp @(Compose (Either Int) Maybe Int) "Compose"+  , testRoundTripProp @(Product (Either Int) Maybe Int) "Product"+  , testRoundTripProp @(Sum Maybe Maybe Int) "Sum"   ]

@@ -9,13 +9,21 @@   import Data.Aeson+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM+#endif import Data.DList (DList, fromList, toList) import Data.Int (Int64) import Data.Time (NominalDiffTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Vector.Primitive as VP +#if MIN_VERSION_base(4,13,0)+import Test.Tasty.QuickCheck (oneof, resize)+#else import Test.Tasty.QuickCheck (Arbitrary(..), oneof, resize)+#endif import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Instances() @@ -69,4 +77,12 @@   String{} `compare` _        = LT   Array{}  `compare` Object{} = LT   _        `compare` _        = GT+#endif++#if MIN_VERSION_aeson(2,0,0)+instance Arbitrary v => Arbitrary (KM.KeyMap v) where+    arbitrary = KM.fromList <$> arbitrary++instance Arbitrary K.Key where+    arbitrary = K.fromText <$> arbitrary #endif

@@ -14,6 +14,9 @@ import Control.Monad (forM) import Data.Aeson hiding (eitherDecodeFileStrict) import Data.Aeson as A (decodeFileStrict)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM (KeyMap)+#endif import Data.Aeson.Types (parseEither) import Data.DList (DList) import Data.Functor.Identity (Identity)@@ -93,6 +96,9 @@     , parseCollection @IntMap     @Version4 "IntMap v4"   allVersioned $ toJSON . IntMap.fromList  . zip [1..] . fmap snd     , parseCollection @(Map Text) @Version4 "Map v4"      allVersioned objectList     , parseCollection @(HashMap Text) @Version4 "HashMap v4" allVersioned objectList+#if MIN_VERSION_aeson(2,0,0)+    , parseCollection @KM.KeyMap  @Version4 "Aeson.KeyMap v4" allVersioned objectList+#endif     , parseCollection @Set        @Version4 "Set v4"      allVersioned singleList     , parseCollection @HashSet    @Version4 "HashSet v4"  allVersioned singleList     , parseCollection @Seq        @Version4 "Seq v4"      allVersioned singleList@@ -224,6 +230,6 @@                     => String -> [String] -> ([(Text,Value)] -> Value) -> TestTree parseCollectionFail = parseCollection' @f @a go   where go :: IO () -> IO ()-        go io = try io >>= \case-            Left e -> return () `const` (e :: HUnitFailure)+        go io = try @HUnitFailure io >>= \case+            Left{} -> pure ()             Right{} -> assertFailure "Should have failed"

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module PrimitiveTests where@@ -7,10 +8,17 @@ import Control.Applicative (Const) import Data.Aeson (DotNetTime, Value, (.:)) import qualified Data.Aeson as A+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as KM+#endif import Data.Aeson.Types (parseEither) import Data.DList (DList) import Data.Fixed (E12, Fixed)+import Data.Functor.Compose (Compose) import Data.Functor.Identity (Identity)+import Data.Functor.Product (Product)+import Data.Functor.Sum (Sum) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import Data.Int (Int8, Int16, Int32, Int64)@@ -25,7 +33,8 @@ import Data.Semigroup (First, Last, Max, Min) import Data.Sequence (Seq) import Data.Set (Set)-import Data.Text as T (Text, unpack)+import Data.String (fromString)+import Data.Text as T (Text) import Data.Text.Lazy as LT (Text) import Data.Time import Data.Tree (Tree)@@ -55,21 +64,21 @@   ]  -parseValueAnd :: forall a. SafeJSON a => T.Text -> (a -> IO ()) -> TestTree-parseValueAnd t f = testCase (T.unpack t) $ do+parseValueAnd :: forall a. SafeJSON a => String -> (a -> IO ()) -> TestTree+parseValueAnd s f = testCase s $ do     mVal <- A.decodeFileStrict "test/json/primitives.json"     maybe       (assertFailure "couldn't read file")       (either fail f . parseEither go)       mVal   where go = A.withObject "test" $ \o -> do-                o .: t >>= safeFromJSON+                o .: fromString s >>= safeFromJSON -parseValue :: forall a. SafeJSON a => T.Text -> TestTree+parseValue :: forall a. SafeJSON a => String -> TestTree parseValue t = parseValueAnd t (const $ return () :: a -> IO ())  fromJSONTest :: forall a. (A.FromJSON a, SafeJSON a, Eq a, Show a)-             => T.Text -> TestTree+             => String -> TestTree fromJSONTest t = parseValueAnd t $ \val -> do     let a = (parseEither A.parseJSON val :: Either String a)         b = parseEither safeFromJSON val@@ -102,6 +111,9 @@   , parseValue @Word64     "Word64"   , parseValue @T.Text     "T.Text"   , parseValue @LT.Text    "LT.Text"+#if MIN_VERSION_aeson(2,0,0)+  , parseValue @K.Key      "Aeson.Key"+#endif   , parseValue @DV.Version "Version"   , parseValue @Scientific "Scientific"   , parseValue @IntSet     "IntSet"@@ -150,11 +162,25 @@   , parseValue @(Map T.Text Int)     "Map"   , parseValue @(HashSet Int)        "HashSet"   , parseValue @(HashMap T.Text Int) "HashMap"+#if MIN_VERSION_aeson(2,0,0)+  , parseValue @(KM.KeyMap T.Text)   "Aeson.KeyMap"+#endif    , parseValue @(Int, Bool)                        "Tuple2"   , parseValue @(Int, Bool, T.Text)                "Tuple3"   , parseValue @(Int, Bool, T.Text, [Int])         "Tuple4"   , parseValue @(Int, Bool, T.Text, [Int], Double) "Tuple5"++  , parseValue @(Compose (Either T.Text) Maybe Int)   "Compose"+  , parseValue @(Compose (Either T.Text) Maybe Int)   "Compose2"+  , parseValue @(Compose (Either T.Text) Maybe Int)   "Compose3"+  , parseValue @(Product (Either T.Text) Maybe Int)   "Product"+  , parseValue @(Product (Either T.Text) Maybe Int)   "Product2"+  , parseValue @(Product (Either T.Text) Maybe Int)   "Product3"+  , parseValue @(Product (Either T.Text) Maybe Int)   "Product4"+  , parseValue @(Sum (Either T.Text) Maybe Int)       "Sum"+  , parseValue @(Sum (Either T.Text) Maybe Int)       "Sum2"+  , parseValue @(Sum (Either T.Text) Maybe Int)       "Sum3"   ]  @@ -182,6 +208,9 @@   , toJSONTest @Word64       "Word64"   , toJSONTest @T.Text       "T.Text"   , toJSONTest @LT.Text      "LT.Text"+#if MIN_VERSION_aeson(2,0,0)+  , toJSONTest @K.Key        "Aeson.Key"+#endif   , toJSONTest @DV.Version   "DV.Version"   , toJSONTest @Scientific   "Scientific"   , toJSONTest @IntSet       "IntSet"@@ -225,10 +254,16 @@   , toJSONTest @(Map T.Text Int)           "Map"   , toJSONTest @(HashSet Int)              "HashSet"   , toJSONTest @(HashMap T.Text Int)       "HashMap"+#if MIN_VERSION_aeson(2,0,0)+  , toJSONTest @(KM.KeyMap T.Text)         "Aeson.KeyMap"+#endif   , toJSONTest @(Int, Bool)                "Tuple2"   , toJSONTest @(Int, Bool, T.Text)        "Tuple3"   , toJSONTest @(Int, Bool, T.Text, [Int]) "Tuple4"   , toJSONTest @(Int, Bool, T.Text, [Int], Double) "Tuple5"+  , toJSONTest @(Compose (Either T.Text) Maybe Int) "Compose"+  , toJSONTest @(Product (Either T.Text) Maybe Int) "Product"+  , toJSONTest @(Sum (Either T.Text) Maybe Int)     "Sum"   ]  fromJSONEquivalence :: TestTree@@ -253,6 +288,9 @@   , fromJSONTest @Word64       "Word64"   , fromJSONTest @T.Text       "T.Text"   , fromJSONTest @LT.Text      "LT.Text"+#if MIN_VERSION_aeson(2,0,0)+  , fromJSONTest @K.Key        "Aeson.Key"+#endif   , fromJSONTest @DV.Version   "Version"   , fromJSONTest @Scientific   "Scientific"   , fromJSONTest @IntSet       "IntSet"@@ -296,8 +334,14 @@   , fromJSONTest @(Map T.Text Int)           "Map"   , fromJSONTest @(HashSet Int)              "HashSet"   , fromJSONTest @(HashMap T.Text Int)       "HashMap"+#if MIN_VERSION_aeson(2,0,1)+  , fromJSONTest @(KM.KeyMap T.Text)         "Aeson.KeyMap"+#endif   , fromJSONTest @(Int, Bool)                "Tuple2"   , fromJSONTest @(Int, Bool, T.Text)        "Tuple3"   , fromJSONTest @(Int, Bool, T.Text, [Int]) "Tuple4"   , fromJSONTest @(Int, Bool, T.Text, [Int], Double) "Tuple5"+  , fromJSONTest @(Compose (Either T.Text) Maybe Int) "Compose"+  , fromJSONTest @(Product (Either T.Text) Maybe Int) "Product"+  , fromJSONTest @(Sum (Either T.Text) Maybe Int)     "Sum"   ]

@@ -1,14 +1,19 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Version where   import Control.Exception (handle)-import Control.Monad (when)+import Control.Monad (unless) import qualified Data.Aeson as A+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM+import qualified Data.Map.Strict as M+#endif import Data.Aeson.Safe-import Data.Text as T+import Data.String (fromString) import Test.Tasty as Tasty import Test.Tasty.HUnit as Tasty import Test.Tasty.QuickCheck as Tasty@@ -66,16 +71,16 @@  -- | Given a field in the "version.json" object, parses as -- the given type, but hardsets version before doing so.-parseSetVersion :: forall a. SafeJSON a => Text -> a -> TestTree-parseSetVersion t val = parseAnd t go+parseSetVersion :: forall a. SafeJSON a => String -> a -> TestTree+parseSetVersion s val = parseAnd s go   where safeVal = safeToJSON val         go (with,without) = do           assertEqual "With: as regular" safeVal with           assertEqual "Without: after version added" safeVal $ setVersion @a without  -- | Like 'parseSetVersion', but expects to fail on the second.-parseSetVersionFail :: forall a. SafeJSON a => Text -> a -> Value -> TestTree-parseSetVersionFail t val actual = parseAnd t go+parseSetVersionFail :: forall a. SafeJSON a => String -> a -> Value -> TestTree+parseSetVersionFail s val actual = parseAnd s go   where safeVal = safeToJSON val         err HUnitFailure{} = return True         go (with,without) = do@@ -83,28 +88,36 @@           failed <- handle err $ do               assertEqual "Without: after version added" safeVal $ setVersion @a without               return False-          when (not failed) $ assertFailure "Expected to fail"+          unless failed $ assertFailure "Expected to fail"           assertEqual "Unexpected behaviour" actual $ setVersion @a without  -- | Given a field in the "version.json" object, tries to -- compare the plain JSON with the (removeVersion . safeToJSON) -- 'Value' of the provided type.-parseRemoveVersion :: forall a. SafeJSON a => Text -> a -> TestTree+parseRemoveVersion :: forall a. SafeJSON a => String -> a -> TestTree parseRemoveVersion t val = parseAnd t go   where safeVal = safeToJSON val         go (with,without) = do           assertEqual "With: as regular" safeVal with           assertEqual "Without: after versions removed" (removeVersion safeVal) without -parseAnd :: SafeJSON a => Text -> ((a,Value) -> IO ()) -> TestTree-parseAnd t f = testCase (T.unpack t) $-    A.decodeFileStrict ("test/json/setremoveversion.json")+parseAnd :: SafeJSON a => String -> ((a,Value) -> IO ()) -> TestTree+parseAnd s f = testCase s $+    A.decodeFileStrict "test/json/setremoveversion.json"       >>= maybe (assertFailure "couldn't read file")                 (either fail f . parseEither go)   where go = A.withObject "test" $ \o -> do-                o .: t >>= \o2 -> (,) <$> (o2 .: "with" >>= safeFromJSON) <*> o2 .: "without"+                o' <- o .: fromString s+#if MIN_VERSION_aeson(2,0,0)+                let o2 = KM.fromList $ M.toList o'+#else+                let o2 = o'+#endif+                with <- o2 .: "with" >>= safeFromJSON+                without <- o2 .: "without"+                pure (with, without) -data TestObject a = TestObject {+newtype TestObject a = TestObject {   testObject :: a } deriving (Eq, Show) @@ -135,7 +148,7 @@ ------------ USED FOR TESTING VERSION OVERRIDE ----------- ------------ USED FOR TESTING VERSION OVERRIDE ----------- -data TestObject2 a = TestObject2 {+newtype TestObject2 a = TestObject2 {   testObject2 :: a } deriving (Eq, Show) 

@@ -19,6 +19,7 @@   "Word64":18446744073709551615,   "T.Text":"testing",   "LT.Text":"lazy testing",+  "Aeson.Key":"testing",   "Version":"1.2.3-tag1-tag2",   "Scientific":1.34876e-123,   "IntSet":[1,2,3,99999999],@@ -77,9 +78,22 @@   "Map": {"a":1,"b":2},   "HashSet": [1,2,3,4,5,6],   "HashMap": {"a":1,"b":2},+  "Aeson.KeyMap": {"a":"1","b":"2"},    "Tuple2": [1,true],   "Tuple3": [1,true,"test"],   "Tuple4": [1,true,"test",[]],-  "Tuple5": [1,true,"test",[],0.45e-3]+  "Tuple5": [1,true,"test",[],0.45e-3],++  "Compose": {"Left": "test"},+  "Compose2": {"Right": null},+  "Compose3": {"Right": 4},+  "Product": [{"Left": "test"}, null],+  "Product2": [{"Left": "test"}, 7],+  "Product3": [{"Right": 5}, null],+  "Product4": [{"Right": 5}, 6],+  "Sum": {"InL": {"Left": "test"}},+  "Sum2": {"InL": {"Right": 2}},+  "Sum3": {"InR": null},+  "Sum4": {"InR": 1} }