safe-json 0.1.0 → 1.0.0

raw patch · 24 files changed

+974/−405 lines, 24 filesdep ~hashabledep ~safe-jsonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hashable, safe-json

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−5
• safe-json.cabal +19/−7
• src/Data/Aeson/Safe.hs +6/−5
• src/Data/SafeJSON.hs +49/−3
• src/Data/SafeJSON/Instances.hs +0/−332
• src/Data/SafeJSON/Internal.hs +486/−32
• src/Data/SafeJSON/Test.hs +15/−11
• test/PrimitiveTests.hs +4/−2
• test/SafeAeson.hs +4/−4
• test/Spec.hs +2/−0
• test/Version.hs +164/−0
• test/VersionNum.hs +7/−4
• test/json/badsimpleversion.json +5/−0
• test/json/noversion.json +4/−0
• test/json/primitives.json +85/−0
• test/json/setremoveversion.json +72/−0
• test/json/simpleversion.json +1/−0
• test/json/simpleversion1.json +4/−0
• test/json/version0.json +5/−0
• test/json/version1.json +5/−0
• test/json/version2.json +5/−0
• test/json/version3.json +6/−0
• test/json/version4-2.json +5/−0
• test/json/version4.json +6/−0

@@ -1,10 +1,20 @@ # Changelog for safe-json +## 1.0.0++* Removed `FromJSON`/`ToJSON` dependecy on `SafeJSON`+    * Default implementation of `safeFrom` and `safeTo` unchanged, still require `FromJSON` and `ToJSON`+* Added unsafe `setVersion` and `removeVersion` functions.+* Integrated `Data.SafeJSON.Instances` into `Data.SafeJSON.Internal`+* Some documentation cleanup/fixes+* Added convenience functions for defining `safeFrom` and `safeTo`+    * e.g. `containWithObject`, `(.:$)`, `(.=$)`, etc.+ ## 0.1.0  * First release. Includes:-    * Data.Aeson.Safe-    * Data.SafeJSON-    * Data.SafeJSON.Instances-    * Data.SafeJSON.Internal-    * Data.SafeJSON.Test+    * `Data.Aeson.Safe`+    * `Data.SafeJSON`+    * `Data.SafeJSON.Instances`+    * `Data.SafeJSON.Internal`+    * `Data.SafeJSON.Test`

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 033525824882ae4e8d9d12a74cef044d5fad8b30e7234634d83b8dec5460b57f+-- hash: 57d54c49f4f8ea15d008d2d770db3fee6e057d771456bdc6309ffcb8cecd5637  name:           safe-json-version:        0.1.0+version:        1.0.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.                 .@@ -32,6 +32,18 @@ extra-source-files:     README     ChangeLog.md+    test/json/badsimpleversion.json+    test/json/noversion.json+    test/json/primitives.json+    test/json/setremoveversion.json+    test/json/simpleversion.json+    test/json/simpleversion1.json+    test/json/version0.json+    test/json/version1.json+    test/json/version2.json+    test/json/version3.json+    test/json/version4-2.json+    test/json/version4.json  source-repository head   type: git@@ -43,7 +55,6 @@       Data.SafeJSON       Data.SafeJSON.Test   other-modules:-      Data.SafeJSON.Instances       Data.SafeJSON.Internal       Paths_safe_json   hs-source-dirs:@@ -55,7 +66,7 @@     , bytestring >=0.10.8.1 && <0.11     , containers >=0.5.7.1 && <0.7     , dlist >=0.8.0.3 && <0.9-    , hashable >=1.2.6.1 && <1.3+    , hashable >=1.2.6.1 && <1.4     , scientific >=0.3.5.2 && <0.4     , tasty >=0.11.3 && <1.3     , tasty-hunit >=0.9.2 && <0.11@@ -79,6 +90,7 @@       PrimitiveTests       SafeAeson       Types+      Version       VersionNum       Paths_safe_json   hs-source-dirs:@@ -92,9 +104,9 @@     , containers >=0.5.7.1 && <0.7     , dlist >=0.8.0.3 && <0.9     , generic-arbitrary >=0.1.0 && <0.2-    , hashable >=1.2.6.1 && <1.3+    , hashable >=1.2.6.1 && <1.4     , quickcheck-instances >=0.3.16 && <0.4-    , safe-json >=0.1.0 && <0.2+    , safe-json >=1.0 && <1.1     , scientific >=0.3.5.2 && <0.4     , tasty     , tasty-hunit

@@ -12,11 +12,11 @@ This way, switching from "Data.Aeson" to "Data.SafeJSON" is very easy. After any "Data.Aeson" imports, just add @.Safe@. -It also exports "Data.Aeson" itself for convenience, but still-hides 'parseJSON' and 'toJSON' so you will get errors if you-use them anywhere. That way you can explicitly decide where-to switch to 'safeFromJSON' or 'safeToJSON', or keep the-current "Data.Aeson" functions.+It also exports "Data.Aeson" and "Data.SafeJSON" itself for+convenience, but still hides 'parseJSON' and 'toJSON' so you+will get errors if you use them anywhere. That way you can+explicitly decide where to switch to 'safeFromJSON' or+'safeToJSON', or keep the current "Data.Aeson" functions. -} module Data.Aeson.Safe (     module Data.SafeJSON@@ -38,6 +38,7 @@   , eitherDecodeFileStrict'   , encodeStrict +  , Parser   , parseEither   , parseMaybe   ) where

@@ -7,7 +7,7 @@  Please read the -__[README on GitHub](https://github.com/Vlix/safe-json/blob/v0.1.0/README.md)__+__[README on GitHub](https://github.com/Vlix/safe-json/blob/v1.0.0/README.md)__  for an extensive explanation of this library, why and how to use it, and examples.@@ -33,9 +33,52 @@     --   newer version) to the type, you can be sure that your programs     --   will still parse the JSON of types it is expecting.     , SafeJSON(version, kind, safeTo, safeFrom, objectProfile, typeName)-    -- *** Contained+    -- ** Contained     , Contained     , contain+    -- ** Defining 'safeFrom' and 'safeTo'+    --+    -- | If the type doesn't already have 'Data.Aeson.FromJSON' and+    --   'Data.Aeson.ToJSON' instances, the following functions can help+    --   in defining the 'safeFrom' and 'safeTo' methods.+    --+    -- @+    -- safeFrom = containWithObject \"MyType\" $ \\o ->+    --   MyType \<$\> o .:  "regular_value"+    --          \<*\> o .:$ "safe_value"+    --+    -- safeTo (MyType regular safe) =+    --   contain . object $+    --     [ "regular_value" .=  regular+    --     , "safe_value"    .=$ safe+    --     ]+    -- @++    -- *** Inspecting values in 'safeFrom'+    --+    -- | The following functions are helpful when defining 'safeFrom'.+    --   They are basically 'contain' composed with the corresponding+    --   'Data.Aeson' function, so they can be used in the same fashion+    --   as said 'Data.Aeson' function.+    , containWithObject+    , containWithArray+    , containWithText+    , containWithScientific+    , containWithBool+    -- *** Accessors+    --+    -- | These accessors can be used like their 'Data.Aeson' counterparts.+    --   The only difference is that the expected value is parsed using+    --   'safeFromJSON' instead of 'Data.Aeson.parseJSON'.+    , (.:$)+    , (.:$?)+    , (.:$!)+    -- *** Constructor for 'safeTo'+    --+    -- | This constructor of key-value pairs can be used exactly like+    --   its 'Data.Aeson' counterpart ('Data.Aeson..='), but converts the+    --   given value with 'safeToJSON' instead of 'Data.Aeson.toJSON'+    , (.=$)     -- ** Version     --     -- | All 'SafeJSON' instances have a 'version'. This version will be@@ -44,6 +87,9 @@     --   the given JSON.     , Version     , noVersion+    , setVersion+    , setVersion'+    , removeVersion     -- ** Kind     --     -- | All 'SafeJSON' instance have a declared 'kind', indicating if any@@ -89,4 +135,4 @@     ) where  import Data.SafeJSON.Internal-import Data.SafeJSON.Instances()+import Data.Aeson

@@ -1,332 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-|-Module      : Data.SafeJSON.Instances-Copyright   : (c) 2019 Felix Paulusma-License     : MIT-Maintainer  : felix.paulusma@gmail.com-Stability   : experimental--This module contains 'SafeJSON' instances for almost-all types that "Data.Aeson" has 'Data.Aeson.FromJSON'-and 'Data.Aeson.ToJSON' instances for. These instances-are all defined with 'noVersion' and 'base', since-these types should never get a version wrapper, should-use the existing "Data.Aeson" instances and do not extend-any other type.--All these types are extendable if need be. Just use-any of these types in the definition of your 'Migrate'-instance.--(e.g. @type MigrateFrom MyType = Int@)--}-module Data.SafeJSON.Instances (SafeJSON(..)) where---import Control.Applicative (Const(..))-import Data.Aeson (DotNetTime, FromJSONKey, ToJSONKey, Value(..), parseJSON, toJSON)-import Data.Aeson.Types (Parser)-import Data.Char (Char)-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.Hashable (Hashable)-import qualified Data.HashMap.Strict as HM (HashMap, fromList, toList)-import qualified Data.HashSet as HS (HashSet, fromList, toList)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.IntMap (IntMap)-import Data.IntSet (IntSet)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Map (Map)-import Data.Monoid (Dual(..))-import Data.Proxy (Proxy)-import Data.Ratio (Ratio)-import Data.Scientific (Scientific)-import Data.Semigroup (First(..), Last(..), Max(..), Min(..))-import Data.Sequence (Seq)-import qualified Data.Set as S (Set, fromList, toList)-import Data.Text as T (Text)-import Data.Text.Lazy as LT (Text)-import Data.Time-import Data.Tree (Tree)-import Data.UUID.Types (UUID)-import qualified Data.Vector as V-import qualified Data.Vector.Generic as VG-import qualified Data.Vector.Primitive as VP-import qualified Data.Vector.Storable as VS-import qualified Data.Vector.Unboxed as VU-import Data.Version as DV (Version)-import Data.Void (Void)-import Data.Word (Word8, Word16, Word32, Word64)-import Foreign.C.Types (CTime)-import Numeric.Natural (Natural)--import Data.SafeJSON.Internal----- ---------------------- -----   SafeJSON Instances   ----- ---------------------- ----#define BASIC_NULLARY(T) \-instance SafeJSON T where { version = noVersion }--BASIC_NULLARY(Void)-BASIC_NULLARY(Bool)-BASIC_NULLARY(Ordering)-BASIC_NULLARY(())-BASIC_NULLARY(Char)-BASIC_NULLARY(Float)-BASIC_NULLARY(Double)-BASIC_NULLARY(Int)-BASIC_NULLARY(Natural)-BASIC_NULLARY(Integer)-BASIC_NULLARY(Int8)-BASIC_NULLARY(Int16)-BASIC_NULLARY(Int32)-BASIC_NULLARY(Int64)-BASIC_NULLARY(Word)-BASIC_NULLARY(Word8)-BASIC_NULLARY(Word16)-BASIC_NULLARY(Word32)-BASIC_NULLARY(Word64)-BASIC_NULLARY(T.Text)-BASIC_NULLARY(LT.Text)-BASIC_NULLARY(DV.Version)-BASIC_NULLARY(Scientific)-BASIC_NULLARY(IntSet)-BASIC_NULLARY(UUID)-BASIC_NULLARY(Value)--instance (SafeJSON a, Integral a) => SafeJSON (Ratio a) where-  typeName = typeName1-  version = noVersion--instance (HasResolution a) => SafeJSON (Fixed a) where-  typeName = typeName1-  version = noVersion--instance SafeJSON (Proxy a) where-  typeName = typeName1-  version = noVersion--instance {-# OVERLAPPING #-} SafeJSON String where-  typeName _ = "String"-  version = noVersion----- --------------------------- -----   SafeJSON Time Instances   ----- --------------------------- ----BASIC_NULLARY(CTime)-BASIC_NULLARY(ZonedTime)-BASIC_NULLARY(LocalTime)-BASIC_NULLARY(TimeOfDay)-BASIC_NULLARY(UTCTime)-BASIC_NULLARY(NominalDiffTime)-BASIC_NULLARY(DiffTime)-BASIC_NULLARY(Day)-BASIC_NULLARY(DotNetTime)---- ------------------------------------ -----   More involved SafeJSON instances   ----- ------------------------------------ ----instance SafeJSON a => SafeJSON (Const a b) where-  safeFrom val = contain $ Const <$> safeFromJSON val-  safeTo (Const a) = contain $ safeToJSON a-  typeName = typeName2-  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-  -- Nothing means do whatever Aeson thinks Nothing should be-  safeTo Nothing = contain $ toJSON (Nothing :: Maybe a)-  -- If there's something, keep it safe-  safeTo (Just a) = contain $ safeToJSON a-  typeName = typeName1-  version = noVersion--instance (SafeJSON a, SafeJSON b) => SafeJSON (Either a b) where-  safeFrom val = contain $ do-      eVal <- parseJSON val-      case eVal of-        Left a  -> Left  <$> safeFromJSON a-        Right b -> Right <$> safeFromJSON b-  safeTo (Left a)  = contain $ toJSON (Left  $ safeToJSON a :: Either Value Void)-  safeTo (Right b) = contain $ toJSON (Right $ safeToJSON b :: Either Void Value)-  typeName = typeName2-  version = noVersion--#define BASIC_UNARY(T)                             \-instance SafeJSON a => SafeJSON (T a) where {      \-  safeFrom val = contain $ T <$> safeFromJSON val; \-  safeTo (T a) = contain $ safeToJSON a;           \-  typeName = typeName1;                            \-  version = noVersion }--BASIC_UNARY(Identity)-BASIC_UNARY(First)-BASIC_UNARY(Last)-BASIC_UNARY(Min)-BASIC_UNARY(Max)-BASIC_UNARY(Dual)--fromGenericVector :: (SafeJSON a, VG.Vector v a) => Value -> Contained (Parser (v a))-fromGenericVector val = contain $ do-      v <- parseJSON val-      VG.convert <$> VG.mapM safeFromJSON (v :: V.Vector Value)--toGenericVector :: (SafeJSON a, VG.Vector v a) => v a -> Contained Value-toGenericVector = contain . toJSON . fmap safeToJSON . VG.toList--instance SafeJSON a => SafeJSON (V.Vector a) where-  safeFrom = fromGenericVector-  safeTo = toGenericVector-  typeName = typeName1-  version = noVersion--instance (SafeJSON a, VP.Prim a) => SafeJSON (VP.Vector a) where-  safeFrom = fromGenericVector-  safeTo = toGenericVector-  typeName = typeName1-  version = noVersion--instance (SafeJSON a, VS.Storable a) => SafeJSON (VS.Vector a) where-  safeFrom = fromGenericVector-  safeTo = toGenericVector-  typeName = typeName1-  version = noVersion--instance (SafeJSON a, VG.Vector VU.Vector a) => SafeJSON (VU.Vector a) where-  safeFrom = fromGenericVector-  safeTo = toGenericVector-  typeName = typeName1-  version = noVersion---- | Lists and any other "container" are seen as only that:---   a container for 'SafeJSON' values.------   "Containers" are implemented in such a way that when parsing---   a collection of all migratable versions, the result will be---   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-  safeTo as = contain . toJSON $ safeToJSON <$> as-  typeName = typeName1-  version = noVersion--#define BASIC_UNARY_FUNCTOR(T)                      \-instance SafeJSON a => SafeJSON (T a) where {       \-  safeFrom val = contain $ do {                     \-      vs <- parseJSON val;                          \-      mapM safeFromJSON vs };                       \-  safeTo as = contain . toJSON $ safeToJSON <$> as; \-  typeName = typeName1;                             \-  version = noVersion }--BASIC_UNARY_FUNCTOR(IntMap)-BASIC_UNARY_FUNCTOR(NonEmpty)-BASIC_UNARY_FUNCTOR(Seq)-BASIC_UNARY_FUNCTOR(Tree)--instance (SafeJSON a) => SafeJSON (DList a) where-  safeFrom val = contain $ do-      vs <- parseJSON val-      DList.fromList <$> mapM safeFromJSON vs-  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-  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-  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-  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-  safeTo as = contain . toJSON $ safeToJSON <$> as-  typeName = typeName2-  version = noVersion--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)-  safeTo (a,b) = contain $ toJSON (safeToJSON a, safeToJSON b)-  typeName = typeName2-  version = noVersion--instance (SafeJSON a, SafeJSON b, SafeJSON c) => SafeJSON (a, b, c) where-  safeFrom x = contain $ do-      (a',b',c') <- parseJSON x-      a <- safeFromJSON a'-      b <- safeFromJSON b'-      c <- safeFromJSON c'-      return (a,b,c)-  safeTo (a,b,c) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c)-  typeName = typeName3-  version = noVersion--instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d) => SafeJSON (a, b, c, d) where-  safeFrom x = contain $ do-      (a',b',c',d') <- parseJSON x-      a <- safeFromJSON a'-      b <- safeFromJSON b'-      c <- safeFromJSON c'-      d <- safeFromJSON d'-      return (a,b,c,d)-  safeTo (a,b,c,d) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c, safeToJSON d)-  typeName = typeName4-  version = noVersion--instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d, SafeJSON e) => SafeJSON (a, b, c, d, e) where-  safeFrom x = contain $ do-      (a',b',c',d',e') <- parseJSON x-      a <- safeFromJSON a'-      b <- safeFromJSON b'-      c <- safeFromJSON c'-      d <- safeFromJSON d'-      e <- safeFromJSON e'-      return (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

@@ -6,8 +6,10 @@ -- desired behaviour being different from the safecopy library -- and the fact that this library works with JSON, instead of -- byte serialization.+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -17,6 +19,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-| Module      : Data.SafeJSON.Internal@@ -32,23 +36,56 @@ module Data.SafeJSON.Internal where  -import Control.Applicative ((<|>))+import Control.Applicative (Applicative(..), Const(..), (<|>)) import Control.Monad (when) import Control.Monad.Fail (MonadFail) import Data.Aeson-import Data.Aeson.Types (Parser)+import Data.Aeson.Types (Parser, explicitParseField, explicitParseFieldMaybe, explicitParseFieldMaybe')+import Data.Char (Char)+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.Hashable (Hashable) import Data.HashMap.Strict as HM (insert, size)+import qualified Data.HashMap.Strict as HM (HashMap, delete, fromList, lookup, toList)+import qualified Data.HashSet as HS (HashSet, fromList, toList) import Data.Int+import Data.IntMap (IntMap)+import Data.IntSet (IntSet) import qualified Data.List as List (intercalate, lookup)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Map (Map) import Data.Maybe (fromMaybe, isJust, isNothing) #if MIN_VERSION_base(4,11,0)+import Data.Monoid (Dual(..)) #else-import Data.Monoid ((<>))+import Data.Monoid (Dual(..), (<>)) #endif import Data.Proxy+import Data.Ratio (Ratio)+import Data.Scientific (Scientific)+import Data.Semigroup (First(..), Last(..), Max(..), Min(..))+import Data.Sequence (Seq) import qualified Data.Set as S-import Data.Text (Text)+import Data.Text as T (Text)+import qualified Data.Text.Lazy as LT (Text)+import Data.Time+import Data.Tree (Tree) import Data.Typeable (Typeable, typeRep)+import Data.UUID.Types (UUID)+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.Version as DV (Version)+import Data.Void (Void)+import Data.Word (Word8, Word16, Word32, Word64)+import Foreign.C.Types (CTime)+import Numeric.Natural (Natural) import Test.Tasty.QuickCheck (Arbitrary(..), shrinkIntegral)  @@ -56,7 +93,7 @@ --   in, using 'Migrate' to automate migration between versions, reducing --   headaches when the need arrises to modify JSON formats while old --   formats can't simply be disregarded.-class (ToJSON a, FromJSON a) => SafeJSON a where+class SafeJSON a where   -- | The version of the type.   --   --   Only used as a key so it __must be unique__ (this is checked at run-time)@@ -81,6 +118,7 @@   --   --   This function cannot be used directly. Use 'safeToJSON', instead.   safeTo :: a -> Contained Value+  default safeTo :: ToJSON a => a -> Contained Value   safeTo = contain . toJSON    -- | This method defines how a value should be parsed without also worrying@@ -89,6 +127,7 @@   --   --   This function cannot be used directly. Use 'safeFromJSON', instead.   safeFrom :: Value -> Contained (Parser a)+  default safeFrom :: FromJSON a => Value -> Contained (Parser a)   safeFrom = contain . parseJSON    -- | The name of the type. This is used in error message strings and the@@ -153,30 +192,36 @@   migrate :: MigrateFrom a -> a  --- | This is an inpenetrable container. A security measure+-- | This is an impenetrable container. A security measure --   used to ensure 'safeFrom' and 'safeTo' are never used --   directly. Instead, always use 'safeFromJSON' and --   'safeToJSON'. newtype Contained a = Contained {unsafeUnpack :: a}+  -- Opens up mis-use of 'safeFrom' / 'safeTo', better to not+  -- deriving (Functor)  -- | Used when defining 'safeFrom' or 'safeTo'. contain :: a -> Contained a contain = Contained +{-+-- Opens up mis-use of 'safeFrom' / 'safeTo', better to not+instance Applicative Contained where+  pure = contain+  Contained f <*> Contained a = Contained $ f a+-}  -- | A simple numeric version id. -- --   'Version' has a 'Num' instance and should be --   declared using integer literals: @version = 2@-newtype Version a = Version {unVersion :: Maybe Int64}--- Is it better to use 'Int32'?--- Maybe 'Int64' is too big for JSON?+newtype Version a = Version {unVersion :: Maybe Int32}   deriving (Eq)  -- | This is used for types that don't have --   a version tag. -----   This is used for primitive values that are tagged with+--   This is used for primitive values that are not tagged with --   a version number, like @Int@, @Text@, @[a]@, etc. -- --   But also when implementing 'SafeJSON' after the fact,@@ -190,17 +235,95 @@ noVersion :: Version a noVersion = Version Nothing +-- | Same as 'setVersion', but requires a 'Version' parameter.+--+-- >>> 'encode' $ 'setVersion'' (version :: 'Version' Test) val+-- "{\"~v\":0,\"~d\":\"test\"}"+--+-- @since 1.0.0+setVersion' :: forall a. SafeJSON a => Version a -> Value -> Value+setVersion' (Version mVersion) val =+  case mVersion of+    Nothing -> val+    Just i -> case val of+      Object o ->+          let vField = maybe versionField+                             (const dataVersionField)+                             $ dataVersionField `HM.lookup` o+          in Object $ HM.insert vField (toJSON i) o+      other -> object+          [ dataVersionField .= i+          , dataField .= other+          ]++-- | /CAUTION: Only use this function if you know what you're doing./+--   /The version will be set top-level, without inspection of the 'Value'!/+--+--   (cf. 'removeVersion') In some rare cases, you might want to interpret+--   a versionless 'Value' as a certain type/version. 'setVersion' allows+--   you to (unsafely) insert a version field.++--   __If possible, it is advised to use a 'FromJSON' instance instead.__+--   (One that doesn't also use `safeFromJSON` in its methods!)+--+--   This might be needed when data sent to an API endpoint doesn't+--   need to implement SafeJSON standards. E.g. in the case of+--   endpoints for third parties or customers.+--+-- @+-- USAGE:+--+-- {-# LANGUAGE TypeApplications#-}+-- data Test = Test String+-- instance 'SafeJSON' Test where ...+--+-- >>> val = 'Data.Aeson.String' "test" :: 'Value'+-- String "test"+-- >>> 'encode' val+-- "\"test\""+-- >>> 'encode' $ 'setVersion' @Test val+-- "{\"~v\":0,\"~d\":\"test\"}"+-- >>> parseMaybe 'safeFromJSON' $ 'setVersion' @Test val+-- Just (Test "test")+-- @+--+-- @since 1.0.0+setVersion :: forall a. SafeJSON a => Value -> Value+setVersion = setVersion' (version @a)++-- | /CAUTION: Only use this function if you know what you're doing./+--+--   (cf. 'setVersion') 'removeVersion' removes all the 'SafeJSON'+--   versioning from a JSON 'Value'. Even recursively.+--+--   This might be necessary if the resulting JSON is sent to a+--   third party (e.g. customer) and the 'SafeJSON' versioning+--   should be hidden.+--+-- @since 1.0.0+removeVersion :: Value -> Value+removeVersion = \case+    Object o -> go o+    -- Recursively find all version tags and remove them.+    Array a -> Array $ removeVersion <$> a+    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+ instance Show (Version a) where   show (Version mi) = "Version " ++ showV mi -liftV :: Integer -> (Int64 -> Int64 -> Int64) -> Maybe Int64 -> Maybe Int64 -> Maybe Int64+liftV :: Integer -> (Int32 -> Int32 -> Int32) -> Maybe Int32 -> Maybe Int32 -> Maybe Int32 liftV _ _ Nothing Nothing = Nothing liftV i f ma mb = Just $ toZ ma `f` toZ mb   where toZ = fromMaybe $ fromInteger i  -- 'Version Nothing' is handled as if it's mempty... mostly. -- | It is strongly discouraged to use any methods other---   than 'fromInteger' of 'Version' 's 'Num' instance.+--   than 'fromInteger' of 'Version'\'s 'Num' instance. instance Num (Version a) where   Version ma + Version mb = Version $ liftV 0 (+) ma mb   Version ma - Version mb = Version $ liftV 0 (-) ma mb@@ -300,12 +423,7 @@ safeToJSON a = case thisKind of     Base          | i == Nothing -> tojson     Extended Base | i == Nothing -> tojson-    _ -> case tojson of-            Object o -> Object $ HM.insert versionField (toJSON i) o-            other    -> object-                [ dataVersionField .= i-                , dataField .= other-                ]+    _ -> setVersion @a tojson   where tojson = unsafeUnpack $ safeTo a         Version i = version :: Version a         thisKind = kind :: Kind a@@ -341,13 +459,12 @@         safejsonErr s = fail $ "safejson: " ++ s         regularCase hasVNil = case origVal of             Object o -> do-                (mVal, v) <- tryIt o-                let val = fromMaybe origVal mVal+                (val, v) <- tryIt o                 withVersion v val origKind             _ -> withoutVersion <|> safejsonErr ("unparsable JSON value (not an object): " ++ typeName p)           where withoutVersion = withVersion noVersion origVal origKind                 tryIt o-                  | hasVNil = firstTry o <|> secondTry o <|> pure (Nothing, noVersion)+                  | hasVNil = firstTry o <|> secondTry o <|> pure (origVal, noVersion)                   | otherwise = firstTry o <|> secondTry o          -- This only runs if the SafeJSON being tried has 'kind' of 'extended_*'@@ -361,10 +478,9 @@                         Object o -> tryNew o <|> tryOrig                         _ -> tryOrig                 tryNew o = do-                    (mVal, v) <- firstTry o <|> secondTry o+                    (val, v) <- firstTry o <|> secondTry o                     let forwardKind = getForwardKind k                         forwardVersion = castVersion v-                        val = fromMaybe origVal mVal                         getForwardParser = withVersion forwardVersion val forwardKind                     unReverse . migrate <$> getForwardParser                 tryOrig = unsafeUnpack $ safeFrom origVal@@ -375,7 +491,8 @@          firstTry o = do             v <- o .: versionField-            return (Nothing, Version $ Just v)+            let versionLessObj = HM.delete versionField o+            return (Object versionLessObj, Version $ Just v)         secondTry o = do             v  <- o .: dataVersionField             bd <- o .: dataField@@ -383,7 +500,7 @@             -- 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) ++ ")"-            return (Just bd, Version $ Just v)+            return (bd, Version $ Just v)  -- This takes the version number found (or Nothing) and tries find the type in -- the chain that has that version number. It will attempt to go one type up@@ -477,19 +594,19 @@  -- | Version profile of a consistent 'SafeJSON' instance. data ProfileVersions = ProfileVersions {-    profileCurrentVersion :: Maybe Int64, -- ^ Version of the type checked for consistency.-    profileSupportedVersions :: [(Maybe Int64, String)] -- ^ All versions in the chain with their type names.+    profileCurrentVersion :: Maybe Int32, -- ^ Version of the type checked for consistency.+    profileSupportedVersions :: [(Maybe Int32, String)] -- ^ All versions in the chain with their type names.   } deriving (Eq)  noVersionPresent :: ProfileVersions -> Bool noVersionPresent (ProfileVersions c vs) =     isNothing c || isJust (Nothing `List.lookup` vs) -showV :: Maybe Int64 -> String+showV :: Maybe Int32 -> String showV Nothing  = "null" showV (Just i) = show i -showVs :: [(Maybe Int64, String)] -> String+showVs :: [(Maybe Int32, String)] -> String showVs = List.intercalate ", " . fmap go   where go (mi, s) = mconcat ["(", showV mi, ", ", s, ")"] @@ -541,11 +658,11 @@ isObviouslyConsistent Base = True isObviouslyConsistent _    = False -availableVersions :: forall a. SafeJSON a => Proxy a -> [(Maybe Int64, String)]+availableVersions :: forall a. SafeJSON a => Proxy a -> [(Maybe Int32, String)] availableVersions _ =     worker False (kind @a)   where-    worker :: forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int64, String)]+    worker :: forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]     worker fwd thisKind = case thisKind of         Base       -> [tup]         Extends p' -> tup : worker fwd (kindFromProxy p')@@ -564,7 +681,7 @@   worker mempty mempty (kind @a)   where     --                                Version set            Version set with type name     Kind      Maybe error-    worker :: forall b. SafeJSON b => S.Set (Maybe Int64) -> S.Set (Maybe Int64, String) -> Kind b -> Maybe String+    worker :: forall b. SafeJSON b => S.Set (Maybe Int32) -> S.Set (Maybe Int32, String) -> Kind b -> Maybe String     worker vs vSs k       | i `S.member` vs = Just $ mconcat           [ "Double occurence of version number '", showV i@@ -606,3 +723,340 @@  getForwardKind :: Migrate (Reverse a) => Kind a -> Kind (MigrateFrom (Reverse a)) getForwardKind _ = kind+++-- ---------------------- --+--   Defining safeFrom    --+-- ---------------------- --++withContained :: (a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)+withContained f name prs = contain . f name prs+++-- | Similar to 'Data.Aeson.withObject', but 'contain'ed to be used+-- in 'safeFrom' definitions+--+-- @since 1.0.0+containWithObject :: String -> (Object -> Parser a) -> Value -> Contained (Parser a)+containWithObject = withContained withObject++-- | Similar to 'Data.Aeson.withArray', but 'contain'ed to be used+-- in 'safeFrom' definitions+--+-- @since 1.0.0+containWithArray :: String -> (Array -> Parser a) -> Value -> Contained (Parser a)+containWithArray = withContained withArray++-- | Similar to 'Data.Aeson.withText', but 'contain'ed to be used+-- in 'safeFrom' definitions+--+-- @since 1.0.0+containWithText :: String -> (Text -> Parser a) -> Value -> Contained (Parser a)+containWithText = withContained withText++-- | Similar to 'Data.Aeson.withScientific', but 'contain'ed to be used+-- in 'safeFrom' definitions+--+-- @since 1.0.0+containWithScientific :: String -> (Scientific -> Parser a) -> Value -> Contained (Parser a)+containWithScientific = withContained withScientific++-- | Similar to 'Data.Aeson.withBool', but 'contain'ed to be used+-- in 'safeFrom' definitions+--+-- @since 1.0.0+containWithBool :: String -> (Bool -> Parser a) -> Value -> Contained (Parser a)+containWithBool = withContained withBool++-- | Similar to 'Data.Aeson..:', but uses `safeFromJSON` instead of parseJSON+-- to parse the value in the given field.+--+-- @since 1.0.0+(.:$) :: SafeJSON a => Object -> Text -> Parser a+(.:$) = 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+(.:$?) :: SafeJSON a => Object -> Text -> Parser (Maybe a)+(.:$?) = 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+(.:$!) :: SafeJSON a => Object -> Text -> Parser (Maybe a)+(.:$!) = explicitParseFieldMaybe' safeFromJSON+++-- -------------------- --+--   Defining safeTo    --+-- -------------------- --+++-- | Similarly to 'Data.Aeson..=', but uses 'safeToJSON' instead of toJSON+-- to convert the value in that key-value pair.+--+-- @since 1.0.0+(.=$) :: (SafeJSON a, KeyValue kv) => Text -> a -> kv+name .=$ val = name .= safeToJSON val+++-- ---------------------- --+--   SafeJSON Instances   --+-- ---------------------- --++#define BASIC_NULLARY(T) \+instance SafeJSON T where { version = noVersion }++BASIC_NULLARY(Void)+BASIC_NULLARY(Bool)+BASIC_NULLARY(Ordering)+BASIC_NULLARY(())+BASIC_NULLARY(Char)+BASIC_NULLARY(Float)+BASIC_NULLARY(Double)+BASIC_NULLARY(Int)+BASIC_NULLARY(Natural)+BASIC_NULLARY(Integer)+BASIC_NULLARY(Int8)+BASIC_NULLARY(Int16)+BASIC_NULLARY(Int32)+BASIC_NULLARY(Int64)+BASIC_NULLARY(Word)+BASIC_NULLARY(Word8)+BASIC_NULLARY(Word16)+BASIC_NULLARY(Word32)+BASIC_NULLARY(Word64)+BASIC_NULLARY(T.Text)+BASIC_NULLARY(LT.Text)+BASIC_NULLARY(DV.Version)+BASIC_NULLARY(Scientific)+BASIC_NULLARY(IntSet)+BASIC_NULLARY(UUID)+BASIC_NULLARY(Value)++instance (FromJSON a, ToJSON a, Integral a) => SafeJSON (Ratio a) where+  typeName = typeName1+  version = noVersion++instance (HasResolution a) => SafeJSON (Fixed a) where+  typeName = typeName1+  version = noVersion++instance SafeJSON (Proxy a) where+  typeName = typeName1+  version = noVersion++instance {-# OVERLAPPING #-} SafeJSON String where+  typeName _ = "String"+  version = noVersion+++-- --------------------------- --+--   SafeJSON Time Instances   --+-- --------------------------- --++BASIC_NULLARY(CTime)+BASIC_NULLARY(ZonedTime)+BASIC_NULLARY(LocalTime)+BASIC_NULLARY(TimeOfDay)+BASIC_NULLARY(UTCTime)+BASIC_NULLARY(NominalDiffTime)+BASIC_NULLARY(DiffTime)+BASIC_NULLARY(Day)+BASIC_NULLARY(DotNetTime)++-- ------------------------------------ --+--   More involved SafeJSON instances   --+-- ------------------------------------ --++instance SafeJSON a => SafeJSON (Const a b) where+  safeFrom val = contain $ Const <$> safeFromJSON val+  safeTo (Const a) = contain $ safeToJSON a+  typeName = typeName2+  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+  -- Nothing means do whatever Aeson thinks Nothing should be+  safeTo Nothing = contain $ toJSON (Nothing :: Maybe Value)+  -- If there's something, keep it safe+  safeTo (Just a) = contain $ safeToJSON a+  typeName = typeName1+  version = noVersion++instance (SafeJSON a, SafeJSON b) => SafeJSON (Either a b) where+  safeFrom val = contain $ do+      eVal <- parseJSON val+      case eVal of+        Left a  -> Left  <$> safeFromJSON a+        Right b -> Right <$> safeFromJSON b+  safeTo (Left a)  = contain $ toJSON (Left  $ safeToJSON a :: Either Value Void)+  safeTo (Right b) = contain $ toJSON (Right $ safeToJSON b :: Either Void Value)+  typeName = typeName2+  version = noVersion++#define BASIC_UNARY(T)                             \+instance SafeJSON a => SafeJSON (T a) where {      \+  safeFrom val = contain $ T <$> safeFromJSON val; \+  safeTo (T a) = contain $ safeToJSON a;           \+  typeName = typeName1;                            \+  version = noVersion }++BASIC_UNARY(Identity)+BASIC_UNARY(First)+BASIC_UNARY(Last)+BASIC_UNARY(Min)+BASIC_UNARY(Max)+BASIC_UNARY(Dual)++fromGenericVector :: (SafeJSON a, VG.Vector v a) => Value -> Contained (Parser (v a))+fromGenericVector val = contain $ do+      v <- parseJSON val+      VG.convert <$> VG.mapM safeFromJSON (v :: V.Vector Value)++toGenericVector :: (SafeJSON a, VG.Vector v a) => v a -> Contained Value+toGenericVector = contain . toJSON . fmap safeToJSON . VG.toList++instance SafeJSON a => SafeJSON (V.Vector a) where+  safeFrom = fromGenericVector+  safeTo = toGenericVector+  typeName = typeName1+  version = noVersion++instance (SafeJSON a, VP.Prim a) => SafeJSON (VP.Vector a) where+  safeFrom = fromGenericVector+  safeTo = toGenericVector+  typeName = typeName1+  version = noVersion++instance (SafeJSON a, VS.Storable a) => SafeJSON (VS.Vector a) where+  safeFrom = fromGenericVector+  safeTo = toGenericVector+  typeName = typeName1+  version = noVersion++instance (SafeJSON a, VG.Vector VU.Vector a) => SafeJSON (VU.Vector a) where+  safeFrom = fromGenericVector+  safeTo = toGenericVector+  typeName = typeName1+  version = noVersion++-- | Lists and any other "container" are seen as only that:+--   a container for 'SafeJSON' values.+--+--   "Containers" are implemented in such a way that when parsing+--   a collection of all migratable versions, the result will be+--   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+  safeTo as = contain . toJSON $ safeToJSON <$> as+  typeName = typeName1+  version = noVersion++#define BASIC_UNARY_FUNCTOR(T)                      \+instance SafeJSON a => SafeJSON (T a) where {       \+  safeFrom val = contain $ do {                     \+      vs <- parseJSON val;                          \+      mapM safeFromJSON vs };                       \+  safeTo as = contain . toJSON $ safeToJSON <$> as; \+  typeName = typeName1;                             \+  version = noVersion }++BASIC_UNARY_FUNCTOR(IntMap)+BASIC_UNARY_FUNCTOR(NonEmpty)+BASIC_UNARY_FUNCTOR(Seq)+BASIC_UNARY_FUNCTOR(Tree)++instance (SafeJSON a) => SafeJSON (DList a) where+  safeFrom val = contain $ do+      vs <- parseJSON val+      DList.fromList <$> mapM safeFromJSON vs+  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+  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+  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+  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+  safeTo as = contain . toJSON $ safeToJSON <$> as+  typeName = typeName2+  version = noVersion++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)+  safeTo (a,b) = contain $ toJSON (safeToJSON a, safeToJSON b)+  typeName = typeName2+  version = noVersion++instance (SafeJSON a, SafeJSON b, SafeJSON c) => SafeJSON (a, b, c) where+  safeFrom x = contain $ do+      (a',b',c') <- parseJSON x+      a <- safeFromJSON a'+      b <- safeFromJSON b'+      c <- safeFromJSON c'+      return (a,b,c)+  safeTo (a,b,c) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c)+  typeName = typeName3+  version = noVersion++instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d) => SafeJSON (a, b, c, d) where+  safeFrom x = contain $ do+      (a',b',c',d') <- parseJSON x+      a <- safeFromJSON a'+      b <- safeFromJSON b'+      c <- safeFromJSON c'+      d <- safeFromJSON d'+      return (a,b,c,d)+  safeTo (a,b,c,d) = contain $ toJSON (safeToJSON a, safeToJSON b, safeToJSON c, safeToJSON d)+  typeName = typeName4+  version = noVersion++instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d, SafeJSON e) => SafeJSON (a, b, c, d, e) where+  safeFrom x = contain $ do+      (a',b',c',d',e') <- parseJSON x+      a <- safeFromJSON a'+      b <- safeFromJSON b'+      c <- safeFromJSON c'+      d <- safeFromJSON d'+      e <- safeFromJSON e'+      return (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

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -69,6 +70,9 @@   import Data.Aeson.Types (parseEither)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif import Data.Proxy import Data.SafeJSON.Internal import Test.Tasty (TestTree)@@ -93,21 +97,21 @@  -- | Tests that the following holds: -----   prop> Just a == parseMaybe (safeFromJSON . safeToJSON) a-testRoundTrip :: (Show a, Eq a, SafeJSON a) => a -> Assertion-testRoundTrip a = "To JSON and back not consistent" `assertEqual` Right a $+--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a)+testRoundTrip :: forall a. (Show a, Eq a, SafeJSON a) => a -> Assertion+testRoundTrip a = (typeName (Proxy :: Proxy a) <> ": to JSON and back not consistent") `assertEqual` Right a $     parseEither (safeFromJSON . safeToJSON) a  -- | Tests that the following holds __for all @a@__: -----   prop> Just a == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a) testRoundTripProp' :: forall a. (Eq a, Show a, Arbitrary a, SafeJSON a) => Proxy a -> String -> TestTree testRoundTripProp' _ s = testProperty s $ \a ->     Right (a :: a) == parseEither (safeFromJSON . safeToJSON) a  -- | Tests that the following holds for all @a@: -----   prop> Just a == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a) -- --   === __Example usage:__ --@@ -121,7 +125,7 @@ --   First argument is the older type which should turn into --   the second argument after migrating using 'migrate'. -----   prop> Just (migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a) testMigration :: (Show a, Eq a, Migrate a) => MigrateFrom a -> a -> Assertion testMigration = assertEqual "Unexpected result of SafeJSON migration" . migrate @@ -130,7 +134,7 @@ --   The first argument here is the newer type, which will be migrated back --   to the expected second argument (older type). -----   prop> Just (unReverse $ migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a) testReverseMigration :: (Show a, Eq a, Migrate (Reverse a)) => MigrateFrom (Reverse a) -> a -> Assertion testReverseMigration = assertEqual "Unexpected result of SafeJSON migration" . unReverse . migrate @@ -170,7 +174,7 @@ --   through encoding and decoding to the newer type, is equivalent --   __for all @a@__. -----   prop> Just (migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a) migrateRoundTripProp' :: forall a b. TestMigrate a b => Proxy (a,b) -> String -> TestTree migrateRoundTripProp' _ s = testProperty s $ \a ->     Right (migrate a :: a) == parseEither (safeFromJSON . safeToJSON) a@@ -179,7 +183,7 @@ --   through encoding and decoding to the newer type, is equivalent --   __for all @a@__. -----   prop> Just (migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a) -- --   === __Example usage:__ --@@ -201,7 +205,7 @@ -- | Similar to 'migrateRoundTripProp, but tests the migration from a newer type --   to the older type, in case of a @Migrate (Reverse a)@ instance. -----   prop> Just (unReverse $ migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a) migrateReverseRoundTripProp' :: forall a b. TestReverseMigrate a b => Proxy (a,b) -> String -> TestTree migrateReverseRoundTripProp' _ s = testProperty s $ \a ->     Right (unReverse $ migrate a :: a) == parseEither (safeFromJSON . safeToJSON) a@@ -209,7 +213,7 @@ -- | Similar to 'migrateRoundTripProp', but tests the migration from a newer type --   to the older type, in case of a @Migrate (Reverse a)@ instance. -----   prop> Just (unReverse $ migrate a) == parseMaybe (safeFromJSON . safeToJSON) a+--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a) -- --   === __Example usage:__ --

@@ -69,13 +69,15 @@ parseValue :: forall a. SafeJSON a => T.Text -> TestTree parseValue t = parseValueAnd t (const $ return () :: a -> IO ()) -fromJSONTest :: forall a. (SafeJSON a, Eq a, Show a) => T.Text -> TestTree+fromJSONTest :: forall a. (A.FromJSON a, SafeJSON a, Eq a, Show a)+             => T.Text -> TestTree fromJSONTest t = parseValueAnd t $ \val -> do     let a = (parseEither A.parseJSON val :: Either String a)         b = parseEither safeFromJSON val     assertEqual "SafeJSON not equivalent to FromJSON" a b -toJSONTest :: forall a. (SafeJSON a, Arbitrary a, Show a) => String -> TestTree+toJSONTest :: forall a. (A.ToJSON a, SafeJSON a, Arbitrary a, Show a)+           => String -> TestTree toJSONTest s = testProperty s $ \a -> A.toJSON a == safeToJSON (a :: a)  

@@ -55,7 +55,7 @@     z <- A.eitherDecodeFileStrict' fp     z @=? y -parseValue :: forall a. (SafeJSON a, Eq a, Show a) => String -> TestTree+parseValue :: forall a. (FromJSON a, SafeJSON a, Eq a, Show a) => String -> TestTree parseValue s = testCase s $ do     lbs <- LBS.readFile noVersionPath     decode @a       lbs @=? A.decode       lbs@@ -65,7 +65,7 @@     decodeStrict @a       bs @=? A.decodeStrict       bs     eitherDecodeStrict @a bs @=? A.eitherDecodeStrict bs -parseValue' :: forall a. (SafeJSON a, Eq a, Show a) => String -> TestTree+parseValue' :: forall a. (FromJSON a, SafeJSON a, Eq a, Show a) => String -> TestTree parseValue' s = testCase s $ do     lbs <- LBS.readFile noVersionPath     decode' @a       lbs @=? A.decode'       lbs@@ -75,7 +75,7 @@     decodeStrict' @a       bs @=? A.decodeStrict'       bs     eitherDecodeStrict' @a bs @=? A.eitherDecodeStrict' bs -parseFile :: forall a. (SafeJSON a, Eq a, Show a) => String -> FilePath -> TestTree+parseFile :: forall a. (FromJSON a, SafeJSON a, Eq a, Show a) => String -> FilePath -> TestTree parseFile s fp = testCase s $ do     a <- decodeFileStrict @Value fp     b <- A.decodeFileStrict fp@@ -93,7 +93,7 @@     z <- A.eitherDecodeFileStrict fp     z @=? y -parseFile' :: forall a. (SafeJSON a, Eq a, Show a) => String -> FilePath -> TestTree+parseFile' :: forall a. (FromJSON a, SafeJSON a, Eq a, Show a) => String -> FilePath -> TestTree parseFile' s fp = testCase s $ do     a <- decodeFileStrict' @Value fp     b <- A.decodeFileStrict' fp

@@ -10,6 +10,7 @@ import MigrationTests import PrimitiveTests import SafeAeson+import Version import VersionNum  @@ -19,6 +20,7 @@ tests :: TestTree tests = testGroup "\nSafeJSON"     [ numTest (Proxy :: Proxy (Version a))+    , versionFuncTests     , primitiveTests     , consistencyTests     , encodeDecodeTests

@@ -0,0 +1,164 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Version where+++import Control.Exception (handle)+import Control.Monad (when)+import Data.Aeson (Value, (.:), (.=))+import qualified Data.Aeson as A+import Data.Aeson.Safe+import Data.Aeson.Types (parseEither)+import Data.Text as T+import Test.Tasty as Tasty+import Test.Tasty.HUnit as Tasty+import Test.Tasty.QuickCheck as Tasty++import Data.SafeJSON.Test+++versionFuncTests :: TestTree+versionFuncTests = testGroup "Version functions"+  [ consistency+  , setTest+  , removeTest+  ]+++consistency :: TestTree+consistency = testGroup "Consistency/Round trips"+    [ testCase "C: TestObject" $ testConsistency @(TestObject ())+    , testCase "C: TestArray" $ testConsistency @TestArray+    , testRoundTripProp @(TestObject ()) "R: TestObject"+    , testRoundTripProp @TestArray "R: TestArray"+    ]++setTest :: TestTree+setTest = testGroup "Set version"+    [ parseSetVersion "SimpleVersion" $ TestArray [0,1,2,3]+    , parseSetVersion "WithVersion1" $ TestObject $ String "testing1"+    , let shouldBe = TestObject $ TestObject $ String "testing2"+          isActually = safeToJSON $ TestObject $ go "testing2"+      in parseSetVersionFail "WithVersion2" shouldBe isActually+    , let shouldBe = TestObject [TestObject $ String "testing3", TestObject $ String "testing4"]+          isActually = safeToJSON $ TestObject $ A.toJSON [go "testing3", go "testing4"]+      in parseSetVersionFail "WithVersion3" shouldBe isActually+    , parseAnd "reSetVersion" $ \(to2, val0) -> do+        let obj2 = TestObject2 $ String "testing1"+        assertEqual "Should equal" obj2 to2+        assertBool "Should not equal" $ safeToJSON to2 /= val0+        assertEqual "Version override failed" (safeToJSON obj2) (setVersion @(TestObject2 Value) val0)+    , parseAnd "reSetVersionSimple" $ \(ta3, val1) -> do+        let arr3 = TestArray3 [0,1,2,3]+        assertEqual "Should equal" arr3 ta3+        assertBool "Should not equal" $ safeToJSON ta3 /= val1+        assertEqual "Version override failed" (safeToJSON arr3) (setVersion @TestArray3 val1)+    ]+  where go t = object [ "test" .= String t ]++removeTest :: TestTree+removeTest = testGroup "Remove version"+    [ parseRemoveVersion "SimpleVersion" $ TestArray [0,1,2,3]+    , parseRemoveVersion "WithVersion1" $ TestObject $ String "testing1"+    , parseRemoveVersion "WithVersion2" $ TestObject $ TestObject $ String "testing2"+    , parseRemoveVersion "WithVersion3" $ TestObject [TestObject $ String "testing3", TestObject $ String "testing4"]+    ]+++-- | 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+  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+  where safeVal = safeToJSON val+        err HUnitFailure{} = return True+        go (with,without) = do+          assertEqual "With: as regular" safeVal with+          failed <- handle err $ do+              assertEqual "Without: after version added" safeVal $ setVersion @a without+              return False+          when (not 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 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")+      >>= 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"++data TestObject a = TestObject {+  testObject :: a+} deriving (Eq, Show)++instance Arbitrary a => Arbitrary (TestObject a) where+  arbitrary = TestObject <$> arbitrary++instance SafeJSON a => SafeJSON (TestObject a) where+  safeFrom = contain . go+    where go = withObject "TestObject" $ \o ->+                  TestObject <$> (o .: "test" >>= safeFromJSON)+  safeTo to = contain $ object [ "test" .= safeToJSON (testObject to) ]+  typeName = typeName1+++newtype TestArray = TestArray [Int]+  deriving (Eq, Show)++instance Arbitrary TestArray where+  arbitrary = TestArray <$> arbitrary++instance SafeJSON TestArray where+  safeFrom = contain . fmap TestArray . safeFromJSON+  safeTo (TestArray is) = contain $ safeToJSON is+  version = 1+++------------ USED FOR TESTING VERSION OVERRIDE -----------+------------ USED FOR TESTING VERSION OVERRIDE -----------+------------ USED FOR TESTING VERSION OVERRIDE -----------++data TestObject2 a = TestObject2 {+  testObject2 :: a+} deriving (Eq, Show)++instance Arbitrary a => Arbitrary (TestObject2 a) where+  arbitrary = TestObject2 <$> arbitrary++instance SafeJSON a => SafeJSON (TestObject2 a) where+  safeFrom = contain . go+    where go = withObject "TestObject2" $ \o ->+                  TestObject2 <$> (o .: "test" >>= safeFromJSON)+  safeTo to = contain $ object [ "test" .= safeToJSON (testObject2 to) ]+  typeName = typeName1+  version = 2++newtype TestArray3 = TestArray3 [Int]+  deriving (Eq, Show)++instance Arbitrary TestArray3 where+  arbitrary = TestArray3 <$> arbitrary++instance SafeJSON TestArray3 where+  safeFrom = contain . fmap TestArray3 . safeFromJSON+  safeTo (TestArray3 is) = contain $ safeToJSON is+  version = 3

@@ -25,10 +25,13 @@           where go a = (a :: a) + fromInteger 0 == a  minusTest :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> TestTree-minusTest _ = testProperty "Minus law" $ \a -> (a :: a) - a == fromInteger 0+minusTest _ = testGroup "Minus laws"+  [ testProperty "Minus itself == 0" $ \a -> (a :: a) - a == fromInteger 0+  , testProperty "Minus 0 == itself" $ \a -> (a :: a) - fromInteger 0 == a+  ]  multTest :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> TestTree-multTest _ = testGroup "Plus laws"+multTest _ = testGroup "Multiplication laws"     [ multAssociative     , multCommutative     , multIdentity@@ -51,5 +54,5 @@                             \a -> negate (negate a) == (a :: a)  absSignumTest :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> TestTree-absSignumTest _ = testProperty "Absolute time signum is original" $-                      \a -> abs a * signum a == (a :: a)+absSignumTest _ = testProperty "Absolute * signum is original" $+    \a -> abs a * signum a == (a :: a)

@@ -0,0 +1,5 @@+{+  "~v":8,+  "~d":"testtests",+  "oops": null+}

@@ -0,0 +1,4 @@+{+  "type": "test",+  "int": 12345+}

@@ -0,0 +1,85 @@+{+  "Bool":true,+  "Ordering":"EQ",+  "Unit":[],+  "Char":"!",+  "Float":1.200001,+  "Double":1.2000000000000002,+  "Int":0,+  "Natural":9999999,+  "Integer":-9999999,+  "Int8":127,+  "Int16":32767,+  "Int32":2147483647,+  "Int64":9223372036854775807,+  "Word":0,+  "Word8":255,+  "Word16":65535,+  "Word32":4294967295,+  "Word64":18446744073709551615,+  "T.Text":"testing",+  "LT.Text":"lazy testing",+  "Version":"1.2.3-tag1-tag2",+  "Scientific":1.34876e-123,+  "IntSet":[1,2,3,99999999],+  "UUID":"01234567-89ab-cdef-0123-456789012345",+  "CTime":1.2498623e7,+  "ZonedTime":"2019-04-08T20:21:18.070055167+02:00",+  "LocalTime":"2019-04-08T20:21:18.070055167",+  "TimeOfDay":"20:21:18.070055167",+  "UTCTime":"2019-04-08T18:21:18.070055167Z",+  "NominalDiffTime":8234576.680,+  "DiffTime":8234576.680,+  "Day":"2019-04-08",+  "DotNetTime":"/Date(1554747678070)/",+  "Value":{+    "a":[],+    "b":1,+    "c":{},+    "d":false,+    "e":null,+    "f":"test"+  },++  "Ratio":{+    "numerator":1,+    "denominator":9001+  },+  "Fixed":0.000000000012,+  "Proxy":null,++  "Identity":"test",+  "First":"test",+  "Last":"test",+  "Min":"test",+  "Max":"test",+  "Dual":"test",++  "[]":[1,2,3,4,5],+  "IntMap":[[1,true],[9486,false]],+  "NonEmpty":[12,3,5,76],+  "Seq":["one","two","three"],+  "Tree":["one",[["two",[]],["three",[]]]],++  "Const":"test",+  "Maybe":null,+  "Maybe2":"test",+  "Either":{"Left":"test"},+  "Either2":{"Right":true},++  "DList":[1,2,34,4,5,6],+  "V.Vector":[1,2,34,4,5,6],+  "VS.Vector":[1,2,34,4,5,6],+  "VP.Vector":[1,2,34,4,5,6],+  "VU.Vector":[1,2,34,4,5,6],++  "Set": [1,2,3,4,5,6],+  "Map": {"a":1,"b":2},+  "HashSet": [1,2,3,4,5,6],+  "HashMap": {"a":1,"b":2},++  "Tuple2": [1,true],+  "Tuple3": [1,true,"test"],+  "Tuple4": [1,true,"test",[]],+  "Tuple5": [1,true,"test",[],0.45e-3]+}

@@ -0,0 +1,72 @@+{+  "SimpleVersion": {+    "with": {+      "~v":1,+      "~d": [0,1,2,3]+    },+    "without": [0,1,2,3]+  },+  "WithVersion1": {+    "with": {+      "!v":0,+      "test": "testing1"+    },+    "without":+      { "test": "testing1" }+  },+  "WithVersion2": {+    "with": {+      "!v":0,+      "test": {+        "!v":0,+        "test": "testing2"+      }+    },+    "without": {+      "test": {+        "test": "testing2"+      }+    }+  },+  "WithVersion3": {+    "with": {+      "!v":0,+      "test": [+        {+          "!v":0,+          "test": "testing3"+        },+        {+          "!v":0,+          "test": "testing4"+        }+      ]+    },+    "without": {+      "test": [+        { "test": "testing3" },+        { "test": "testing4" }+      ]+    }+  },+  "reSetVersion": {+    "with": {+      "!v":2,+      "test": "testing1"+    },+    "without": {+      "!v": 0,+      "test": "testing1"+    }+  },+  "reSetVersionSimple": {+    "with": {+      "~v":3,+      "~d": [0,1,2,3]+    },+    "without": {+      "~v":1,+      "~d": [0,1,2,3]+    }+  }+}

@@ -0,0 +1,1 @@+"00000000-0000-0000-0000-000000000000"

@@ -0,0 +1,4 @@+{+  "~v":1,+  "~d":"00000000-0000-0000-0000-000000000000:John Doe"+}

@@ -0,0 +1,5 @@+{+  "type": "test",+  "!v":0,+  "text": "success?"+}

@@ -0,0 +1,5 @@+{+  "type": "test",+  "!v":1,+  "text": "success"+}

@@ -0,0 +1,5 @@+{+  "type": "test",+  "!v":2,+  "texts": ["success!","or","is","it?!"]+}

@@ -0,0 +1,6 @@+{+  "type": "test",+  "!v":3,+  "texts": ["success!","or","is","it?!"],+  "closed": true+}

@@ -0,0 +1,5 @@+{+  "type": "test",+  "!v":4,+  "texts": ["one","two","three"]+}

@@ -0,0 +1,6 @@+{+  "type": "test",+  "!v":4,+  "texts": ["success!","or","is","it?!"],+  "closed": "2019-03-09T12:12:12.12222Z"+}