-- This module heavily relies on code borrowed from the "safecopy"
-- library by David Himmelstrup and Felipe Lessa, found on
-- "https://github.com/acid-state/safecopy"
--
-- Though it has gone through extensive refactoring because of
-- 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 FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-|
Module      : Data.SafeJSON.Internal
Copyright   : (c) 2019 Felix Paulusma
License     : MIT
Maintainer  : felix.paulusma@gmail.com
Stability   : experimental

This module contains all "under-the-hood" functions
and types. "Data.SafeJSON" exports everything for the
outward-facing API.
-}
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.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 (..))
import Data.Functor.Product (Product (..))
import Data.Functor.Sum (Sum(..))
import Data.Hashable (Hashable)
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 as M (Map, singleton)
import Data.Maybe (fromMaybe, isJust, isNothing)
#if MIN_VERSION_base(4,11,0)
import Data.Monoid (Dual(..))
#else
import Data.Monoid (Dual(..), (<>))
#endif
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
import Data.Text as T (Text)
import qualified Data.Text.Lazy as LT (Text)
import Data.Time
    ( Day,
      DiffTime,
      NominalDiffTime,
      UTCTime,
      LocalTime,
      TimeOfDay,
      ZonedTime )
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)

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as K (Key)
import qualified Data.Aeson.KeyMap as Map (KeyMap, delete, insert, lookup, size, toList)
#if !MIN_VERSION_aeson(2,0,1)
import qualified Data.Aeson.KeyMapp as Map (fromMap)
#endif
#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
--   headaches when the need arrises to modify JSON formats while old
--   formats can't simply be disregarded.
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)
  --
  --   Version numbering __doesn't have to be sequential or continuous__.
  --
  --   /The default version is 0 (zero)./
  version :: Version a
  version = Version a
0

  -- | The kind specifies how versions are dealt with. By default,
  --   values are tagged with version 0 and don't have any
  --   previous versions.
  --
  --   /The default kind is/ 'base'
  kind :: Kind a
  kind = forall a. Kind a
Base

  -- | This method defines how a value should be serialized without worrying
  --   about adding the version. The default implementation uses 'toJSON', but
  --   can be modified if need be.
  --
  --   This function cannot be used directly. Use 'safeToJSON', instead.
  safeTo :: a -> Contained Value
  default safeTo :: ToJSON a => a -> Contained Value
  safeTo = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON

  -- | This method defines how a value should be parsed without also worrying
  --   about writing out the version tag. The default implementation uses 'parseJSON',
  --   but can be modified if need be.
  --
  --   This function cannot be used directly. Use 'safeFromJSON', instead.
  safeFrom :: Value -> Contained (Parser a)
  default safeFrom :: FromJSON a => Value -> Contained (Parser a)
  safeFrom = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

  -- | The name of the type. This is used in error message strings and the
  --   'Profile' report.
  --
  --   Doesn't have to be defined if your type is 'Data.Typeable.Typeable'. The default
  --   implementation is 'typeName0'. (cf. 'typeName1', 'typeName2', etc.)
  typeName :: Proxy a -> String
  default typeName :: Typeable a => Proxy a -> String
  typeName = forall a. Typeable a => Proxy a -> String
typeName0

  --   Internal function that should not be overrided.
  --   @Consistent@ if the version history is consistent
  --   (i.e. there are no duplicate version numbers) and
  --   the chain of migrations is valid.
  --
  --   This function is in the typeclass so that this
  --   information is calculated only once during the program
  --   lifetime, instead of everytime 'safeFrom' or 'safeTo' is used.
  internalConsistency :: Consistency a
  internalConsistency = forall a. SafeJSON a => Proxy a -> Consistency a
computeConsistency forall {k} (t :: k). Proxy t
Proxy

  -- | Version profile.
  --
  --   Shows the current version of the type and all supported
  --   versions it can migrate from.
  objectProfile :: Profile a
  objectProfile = forall a. SafeJSON a => Proxy a -> Profile a
mkProfile forall {k} (t :: k). Proxy t
Proxy

  {-# MINIMAL #-}

-- | This instance is needed to handle the migration between
--   older and newer versions.
--
--   Note that, where @('Migrate' a)@ migrates from the previous
--   version to the type @a@, @('Migrate' ('Reverse' a))@ migrates
--   from the future version to the type @a@.
--
-- === __Example__
--
-- __Two types that can migrate to each other.__
--
-- (Don't forget to give @OldType@ one of the @extended@ 'kind's,
-- and @NewType@ one of the @extension@ 'kind's.)
--
-- @
-- instance 'Migrate' NewType where
--   type 'MigrateFrom' NewType = OldType
--   'migrate' OldType = NewType
--
-- instance 'Migrate' ('Reverse' OldType) where
--   type 'MigrateFrom' ('Reverse' OldType) = NewType
--   'migrate' NewType = 'Reverse' OldType
-- @
class SafeJSON (MigrateFrom a) => Migrate a where
  -- | The type from which will be migrated to type @a@
  type MigrateFrom a
  -- | The migration from the previous version to the
  --   current type @a@. OR, in case of a @('Reverse' a)@,
  --   the migration from the future version back to
  --   the current type @a@
  migrate :: MigrateFrom a -> a


-- | 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 {forall a. Contained a -> a
unsafeUnpack :: a}
  -- Opens up mis-use of 'safeFrom' / 'safeTo', better to not
  -- derive a Functor instance

-- | Used when defining 'safeFrom' or 'safeTo'.
contain :: a -> Contained a
contain :: forall a. a -> Contained a
contain = forall a. a -> Contained a
Contained

-- | A simple numeric version id.
--
--   'Version' has a 'Num' instance and should be
--   declared using integer literals: @'version' = 2@
newtype Version a = Version {forall a. Version a -> Maybe Int32
unVersion :: Maybe Int32}
  deriving (Version a -> Version a -> Bool
forall a. Version a -> Version a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version a -> Version a -> Bool
$c/= :: forall a. Version a -> Version a -> Bool
== :: Version a -> Version a -> Bool
$c== :: forall a. Version a -> Version a -> Bool
Eq)

-- | This is used for types that don't have
--   a version tag.
--
--   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,
--   when a format is already in use, but you still want to
--   be able to 'migrate' from it to a newer type or format.
--
--   /N.B./ @'version' = 'noVersion'@ /is distinctively different/
--   /from/ @'version' = 0@/, which will add a version tag with/
--   /the number 0 (zero), whereas/ 'noVersion' /will not add a/
--   /'version' tag./
noVersion :: Version a
noVersion :: forall a. Version a
noVersion = forall a. Maybe Int32 -> Version a
Version forall a. Maybe a
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' :: forall a. SafeJSON a => Version a -> Value -> Value
setVersion' (Version Maybe Int32
mVersion) Value
val =
  case Maybe Int32
mVersion of
    Maybe Int32
Nothing -> Value
val
    Just Int32
i -> case Value
val of
      Object Object
o ->
          let vField :: Key
vField = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Key
versionField
                             (forall a b. a -> b -> a
const Key
dataVersionField)
                             forall a b. (a -> b) -> a -> b
$ Key
dataVersionField forall v. Key -> KeyMap v -> Maybe v
`Map.lookup` Object
o
          in Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v -> KeyMap v
Map.insert Key
vField (forall a. ToJSON a => a -> Value
toJSON Int32
i) Object
o
      Value
other -> [Pair] -> Value
object
          [ Key
dataVersionField forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int32
i
          , Key
dataField forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
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 :: forall a. SafeJSON a => Value -> Value
setVersion = forall a. SafeJSON a => Version a -> Value -> Value
setVersion' (forall a. SafeJSON a => Version a
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 :: Value -> Value
removeVersion = \case
    Object Object
o -> Object -> Value
go Object
o
    -- Recursively find all version tags and remove them.
    Array Array
a -> Array -> Value
Array forall a b. (a -> b) -> a -> b
$ Value -> Value
removeVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
a
    Value
other -> Value
other
        -- Recursively find all version tags and remove them.
  where go :: Object -> Value
go Object
o = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
regular Value -> Value
removeVersion forall a b. (a -> b) -> a -> b
$ do
                  Value
_ <- Key
dataVersionField forall v. Key -> KeyMap v -> Maybe v
`Map.lookup` Object
o
                  Key
dataField forall v. Key -> KeyMap v -> Maybe v
`Map.lookup` Object
o
          where regular :: Value
regular = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ Value -> Value
removeVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. Key -> KeyMap v -> KeyMap v
Map.delete Key
versionField Object
o

instance Show (Version a) where
  show :: Version a -> String
show (Version Maybe Int32
mi) = String
"Version " forall a. [a] -> [a] -> [a]
++ Maybe Int32 -> String
showV Maybe Int32
mi

liftV :: Integer -> (Int32 -> Int32 -> Int32) -> Maybe Int32 -> Maybe Int32 -> Maybe Int32
liftV :: Integer
-> (Int32 -> Int32 -> Int32)
-> Maybe Int32
-> Maybe Int32
-> Maybe Int32
liftV Integer
_ Int32 -> Int32 -> Int32
_ Maybe Int32
Nothing Maybe Int32
Nothing = forall a. Maybe a
Nothing
liftV Integer
i Int32 -> Int32 -> Int32
f Maybe Int32
ma Maybe Int32
mb = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Int32 -> Int32
toZ Maybe Int32
ma Int32 -> Int32 -> Int32
`f` Maybe Int32 -> Int32
toZ Maybe Int32
mb
  where toZ :: Maybe Int32 -> Int32
toZ = forall a. a -> Maybe a -> a
fromMaybe forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
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.
instance Num (Version a) where
  Version Maybe Int32
ma + :: Version a -> Version a -> Version a
+ Version Maybe Int32
mb = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ Integer
-> (Int32 -> Int32 -> Int32)
-> Maybe Int32
-> Maybe Int32
-> Maybe Int32
liftV Integer
0 forall a. Num a => a -> a -> a
(+) Maybe Int32
ma Maybe Int32
mb
  Version Maybe Int32
ma - :: Version a -> Version a -> Version a
- Version Maybe Int32
mb = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ Integer
-> (Int32 -> Int32 -> Int32)
-> Maybe Int32
-> Maybe Int32
-> Maybe Int32
liftV Integer
0 (-) Maybe Int32
ma Maybe Int32
mb
  Version Maybe Int32
ma * :: Version a -> Version a -> Version a
* Version Maybe Int32
mb = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ Integer
-> (Int32 -> Int32 -> Int32)
-> Maybe Int32
-> Maybe Int32
-> Maybe Int32
liftV Integer
1 forall a. Num a => a -> a -> a
(*) Maybe Int32
ma Maybe Int32
mb
  negate :: Version a -> Version a
negate (Version Maybe Int32
ma) = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
ma
  abs :: Version a -> Version a
abs    (Version Maybe Int32
ma) = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
ma
  signum :: Version a -> Version a
signum (Version Maybe Int32
ma) = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
signum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int32
ma
  fromInteger :: Integer -> Version a
fromInteger Integer
i = forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
i

-- | This instance explicitly doesn't consider 'noVersion', since it
-- is an exception in almost every sense.
instance Arbitrary (Version a) where
  arbitrary :: Gen (Version a)
arbitrary = forall a. Maybe Int32 -> Version a
Version forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Version a -> [Version a]
shrink (Version Maybe Int32
Nothing) = []
  shrink (Version (Just Int32
a)) = forall a. Maybe Int32 -> Version a
Version forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => a -> [a]
shrinkIntegral Int32
a

castVersion :: Version a -> Version b
castVersion :: forall a b. Version a -> Version b
castVersion (Version Maybe Int32
i) = forall a. Maybe Int32 -> Version a
Version Maybe Int32
i

-- | This is a wrapper type used migrating backwards in the chain of compatible types.
--
--   This is useful when running updates in production where new-format JSON will be
--   received by old-format expecting programs.
newtype Reverse a = Reverse { forall a. Reverse a -> a
unReverse :: a }

-- | The 'kind' of a 'SafeJSON' type determines how it can be migrated to.
data Kind a where
  Base :: Kind a
  Extends :: Migrate a => Proxy (MigrateFrom a) -> Kind a
  Extended :: Migrate (Reverse a) => Kind a -> Kind a

-- | Used to define 'kind'.
--   @Base@ types do not extend any type.
base :: Kind a
base :: forall a. Kind a
base = forall a. Kind a
Base

-- | Used to define 'kind'.
--   Extends a previous version.
extension :: (SafeJSON a, Migrate a) => Kind a
extension :: forall a. (SafeJSON a, Migrate a) => Kind a
extension = forall a. Migrate a => Proxy (MigrateFrom a) -> Kind a
Extends forall {k} (t :: k). Proxy t
Proxy

-- | Used to define 'kind'.
--   Types that are 'extended_base', are extended by a
--   future version and as such can migrate backward from
--   that future version. (cf. 'extended_extension', 'base')
extended_base :: (SafeJSON a, Migrate (Reverse a)) => Kind a
extended_base :: forall a. (SafeJSON a, Migrate (Reverse a)) => Kind a
extended_base = forall a. Migrate (Reverse a) => Kind a -> Kind a
Extended forall a. Kind a
base

-- | Used to define 'kind'.
--   Types that are 'extended_extension' are extended
--   by a future version and as such can migrate from
--   that future version, but they also extend a previous
--   version. (cf. 'extended_base', 'extension')
extended_extension :: (SafeJSON a, Migrate a, Migrate (Reverse a)) => Kind a
extended_extension :: forall a. (SafeJSON a, Migrate a, Migrate (Reverse a)) => Kind a
extended_extension = forall a. Migrate (Reverse a) => Kind a -> Kind a
Extended forall a. (SafeJSON a, Migrate a) => Kind a
extension

-- The '!' and '~' used in these set fields are chosen for their
-- low probability of showing up naturally in JSON objects one
-- would normally find or construct.

#if MIN_VERSION_aeson(2,0,0)
versionField, dataVersionField, dataField :: Key
#else
versionField, dataVersionField, dataField :: Text
#endif
versionField :: Key
versionField = Key
"!v"
dataVersionField :: Key
dataVersionField = Key
"~v"
dataField :: Key
dataField = Key
"~d"

-- | Use this exactly how you would use 'toJSON' from "Data.Aeson".
--   Though most use cases will probably use one of the 'Data.Aeson.Safe.encode'
--   functions from "Data.Aeson.Safe".
--
--   'safeToJSON' will add a version tag to the 'Data.Aeson.Value' created.
--   If the 'Data.Aeson.Value' resulting from 'safeTo' (by default the same as 'toJSON')
--   is an @'Object'@, an extra field with the version number will be added.
--
-- > Example value:
-- >   {"type":"test", "data":true}
-- >
-- > Resulting object:
-- >   {"!v": 1, "type":"test", "data":true}
--
--   If the resulting 'Value' is not an @'Object'@, it will be wrapped
--   in one, with a version field:
--
-- > Example value:
-- >   "arbitrary string"
-- >
-- > Resulting object:
-- >   {"~v": 1, "~d": "arbitrary string"}
--
--   __This function does not check consistency of the 'SafeJSON' instances.__
--   __It is advised to always 'Data.SafeJSON.Test.testConsistency' for all__
--   __your instances in a production setting.__
safeToJSON :: forall a. SafeJSON a => a -> Value
safeToJSON :: forall a. SafeJSON a => a -> Value
safeToJSON a
a = case Kind a
thisKind of
    Kind a
Base          | forall a. Maybe a -> Bool
isNothing Maybe Int32
i -> Value
tojson
    Extended Kind a
Base | forall a. Maybe a -> Bool
isNothing Maybe Int32
i -> Value
tojson
    Kind a
_ -> forall a. SafeJSON a => Value -> Value
setVersion @a Value
tojson
  where tojson :: Value
tojson = forall a. Contained a -> a
unsafeUnpack forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Contained Value
safeTo a
a
        Version Maybe Int32
i = forall a. SafeJSON a => Version a
version :: Version a
        thisKind :: Kind a
thisKind = forall a. SafeJSON a => Kind a
kind :: Kind a

-- The consistency is checked on first parse, after that
-- there is no overhead.
-- | Use this exactly how you would use 'parseJSON' from "Data.Aeson".
--   Though most use cases will probably use one of the 'Data.Aeson.Safe.decode'
--   functions from "Data.Aeson.Safe".
--
--   'safeFromJSON' tries to find the version number in the JSON
--   'Value' provided, find the appropriate parser and migrate the
--   parsed result back to the requested type using 'Migrate'
--   instances.
--
--   If there is no version number (that means this can also happen with
--   completely unrelated JSON messages), and there is a 'SafeJSON'
--   instance in the chain that has 'version' defined as 'noVersion',
--   it will try to parse that type.
--
--   __N.B. If the consistency of the 'SafeJSON' instance in__
--   __question is faulty, this will always fail.__
safeFromJSON :: forall a. SafeJSON a => Value -> Parser a
safeFromJSON :: forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
origVal = forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency Proxy a
p forall a b. (a -> b) -> a -> b
$ \ProfileVersions
vs -> do
    let hasVNil :: Bool
hasVNil = ProfileVersions -> Bool
noVersionPresent ProfileVersions
vs
    case Kind a
origKind of
      Kind a
Base       | forall a. Maybe a -> Bool
isNothing Maybe Int32
i -> forall a. Contained a -> a
unsafeUnpack forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => Value -> Contained (Parser a)
safeFrom Value
origVal
      Extended Kind a
k | forall a. Maybe a -> Bool
isNothing Maybe Int32
i -> Migrate (Reverse a) => Bool -> Kind a -> Parser a
extendedCase Bool
hasVNil Kind a
k
      Kind a
_ -> Bool -> Parser a
regularCase Bool
hasVNil
  where Version Maybe Int32
i = forall a. SafeJSON a => Version a
version :: Version a
        origKind :: Kind a
origKind = forall a. SafeJSON a => Kind a
kind :: Kind a
        p :: Proxy a
p = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
        safejsonErr :: String -> m a
safejsonErr String
s = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"safejson: " forall a. [a] -> [a] -> [a]
++ String
s
        regularCase :: Bool -> Parser a
regularCase Bool
hasVNil = case Value
origVal of
            Object Object
o -> do
                (Value
val, Version a
v) <- Object -> Parser (Value, Version a)
tryIt Object
o
                forall b. SafeJSON b => Version b -> Value -> Kind b -> Parser b
withVersion Version a
v Value
val Kind a
origKind
            Value
_ -> Parser a
withoutVersion forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {m :: * -> *} {a}. MonadFail m => String -> m a
safejsonErr (String
"unparsable JSON value (not an object): " forall a. [a] -> [a] -> [a]
++ forall a. SafeJSON a => Proxy a -> String
typeName Proxy a
p)
          where withoutVersion :: Parser a
withoutVersion = forall b. SafeJSON b => Version b -> Value -> Kind b -> Parser b
withVersion forall a. Version a
noVersion Value
origVal Kind a
origKind
                tryIt :: Object -> Parser (Value, Version a)
tryIt Object
o
                  | Bool
hasVNil = forall {a}. Object -> Parser (Value, Version a)
firstTry Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. FromJSON a => Object -> Parser (a, Version a)
secondTry Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
origVal, forall a. Version a
noVersion)
                  | Bool
otherwise = forall {a}. Object -> Parser (Value, Version a)
firstTry Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. FromJSON a => Object -> Parser (a, Version a)
secondTry Object
o

        -- This only runs if the SafeJSON being tried has 'kind' of 'extended_*'
        -- and the version is 'noVersion'.
        -- (internalConsistency checks that it should be an 'Extended Base' since it has 'noVersion')
        -- We check the newer version first, since it's better to try to find the
        -- version, if there is one, to guarantee the right parser.
        extendedCase :: Migrate (Reverse a) => Bool -> Kind a -> Parser a
        extendedCase :: Migrate (Reverse a) => Bool -> Kind a -> Parser a
extendedCase Bool
hasVNil Kind a
k = case Kind a
k of { Kind a
Base -> Parser a
go; Kind a
_ -> Bool -> Parser a
regularCase Bool
hasVNil }
          where go :: Parser a
go = case Value
origVal of
                        Object Object
o -> Object -> Parser a
tryNew Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
tryOrig
                        Value
_ -> Parser a
tryOrig
                tryNew :: Object -> Parser a
tryNew Object
o = do
                    (Value
val, Version Any
v) <- forall {a}. Object -> Parser (Value, Version a)
firstTry Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. FromJSON a => Object -> Parser (a, Version a)
secondTry Object
o
                    let forwardKind :: Kind (MigrateFrom (Reverse a))
forwardKind = forall a.
Migrate (Reverse a) =>
Kind a -> Kind (MigrateFrom (Reverse a))
getForwardKind Kind a
k
                        forwardVersion :: Version (MigrateFrom (Reverse a))
forwardVersion = forall a b. Version a -> Version b
castVersion Version Any
v
                        getForwardParser :: Parser (MigrateFrom (Reverse a))
getForwardParser = forall b. SafeJSON b => Version b -> Value -> Kind b -> Parser b
withVersion Version (MigrateFrom (Reverse a))
forwardVersion Value
val Kind (MigrateFrom (Reverse a))
forwardKind
                    forall a. Reverse a -> a
unReverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Migrate a => MigrateFrom a -> a
migrate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (MigrateFrom (Reverse a))
getForwardParser
                tryOrig :: Parser a
tryOrig = forall a. Contained a -> a
unsafeUnpack forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => Value -> Contained (Parser a)
safeFrom Value
origVal

        withVersion :: forall b. SafeJSON b => Version b -> Value ->  Kind b -> Parser b
        withVersion :: forall b. SafeJSON b => Version b -> Value -> Kind b -> Parser b
withVersion Version b
v Value
val Kind b
k = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a. a -> a
id Either String (Parser b)
eResult
          where eResult :: Either String (Parser b)
eResult = forall a.
SafeJSON a =>
Value -> Version a -> Kind a -> Either String (Parser a)
constructParserFromVersion Value
val Version b
v Kind b
k

        firstTry :: Object -> Parser (Value, Version a)
firstTry Object
o = do
            Int32
v <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
versionField
            let versionLessObj :: Object
versionLessObj = forall v. Key -> KeyMap v -> KeyMap v
Map.delete Key
versionField Object
o
            forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Object Object
versionLessObj, forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int32
v)
        secondTry :: Object -> Parser (a, Version a)
secondTry Object
o = do
            Int32
v  <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
dataVersionField
            a
bd <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
dataField
            -- This is an extra counter measure against false parsing.
            -- The simple data object should contain exactly the
            -- (~v) and (~d) fields
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall v. KeyMap v -> Int
Map.size Object
o forall a. Eq a => a -> a -> Bool
/= Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"malformed simple data (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int32
v) forall a. [a] -> [a] -> [a]
++ String
")"
            forall (m :: * -> *) a. Monad m => a -> m a
return (a
bd, forall a. Maybe Int32 -> Version a
Version forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int32
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
-- (try 'Migrate (Reverse a)' once) and after that down the chain.
constructParserFromVersion :: SafeJSON a => Value -> Version a -> Kind a -> Either String (Parser a)
constructParserFromVersion :: forall a.
SafeJSON a =>
Value -> Version a -> Kind a -> Either String (Parser a)
constructParserFromVersion Value
val Version a
origVersion Kind a
origKind =
    forall b.
SafeJSON b =>
Bool -> Version b -> Kind b -> Either String (Parser b)
worker Bool
False Version a
origVersion Kind a
origKind
  where
    worker :: forall b. SafeJSON b => Bool -> Version b -> Kind b -> Either String (Parser b)
    worker :: forall b.
SafeJSON b =>
Bool -> Version b -> Kind b -> Either String (Parser b)
worker Bool
fwd Version b
thisVersion Kind b
thisKind
      | forall a. SafeJSON a => Version a
version forall a. Eq a => a -> a -> Bool
== Version b
thisVersion = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Contained a -> a
unsafeUnpack forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => Value -> Contained (Parser a)
safeFrom Value
val
      | Bool
otherwise = case Kind b
thisKind of
          Kind b
Base          -> forall a b. a -> Either a b
Left String
versionNotFound
          Extends Proxy (MigrateFrom b)
p     -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Migrate a => MigrateFrom a -> a
migrate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b.
SafeJSON b =>
Bool -> Version b -> Kind b -> Either String (Parser b)
worker Bool
fwd (forall a b. Version a -> Version b
castVersion Version b
thisVersion) (forall a. SafeJSON a => Proxy a -> Kind a
kindFromProxy Proxy (MigrateFrom b)
p)
          Extended Kind b
k    -> do
              -- Technically, the forward and backward parsing could be
              -- infinite, as long as all 'Migrate' instances are defined.
              -- The problem is that chains can fork if, after going forward,
              -- the kind of that forward type is used to continue, since
              -- there's no guarantee that the migrations will continue backward
              -- down the previous chain.
              --
              -- TODO: Somehow restrict Migrate instances in such a way that, if defined:
              -- > MigrateFrom (Reverse b) = a
              -- >  THEN ALSO
              -- > MigrateFrom a = b
              --
              -- @
              -- v1 Base   v1' Base      v1'' Ext_Base
              --  |         |            /\
              --  |         |             |
              -- \/        \/            \/
              -- v2 Exs -> v3 Ext_Exs -> v4 Exs
              -- @
              --
              -- I've opted for the following approach:
              -- "Try forward once, if the version is wrong, go down your own chain"
              --
              -- IDEA: Maybe it could be written in such a way that the backward type
              -- (Base or Extends) in the Extended data constructor is passed along on
              -- up the chain until the top is reached, after which the run downward
              -- starts with Extends, or the run ends in case it was a Base type.
              let forwardParser :: Either String (Parser b)
                  forwardParser :: Either String (Parser b)
forwardParser = do
                      if forall a b. Version a -> Version b
castVersion Version b
thisVersion forall a. Eq a => a -> a -> Bool
== forall a. SafeJSON a => Proxy a -> Version a
versionFromProxy Proxy (MigrateFrom (Reverse b))
reverseProxy
                          then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Reverse a -> a
unReverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Migrate a => MigrateFrom a -> a
migrate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Contained a -> a
unsafeUnpack (forall a. SafeJSON a => Value -> Contained (Parser a)
safeFrom Value
val)
                          else Either String (Parser b)
previousParser

                  previousParser :: Either String (Parser b)
                  previousParser :: Either String (Parser b)
previousParser = forall b.
SafeJSON b =>
Bool -> Version b -> Kind b -> Either String (Parser b)
worker Bool
True Version b
thisVersion Kind b
k
              -- If we've already looked ahead, or if it's 'noVersion', we go back.
              -- ('noVersion' means we need to find the 'Base', that's always backwards)
              if Bool
fwd Bool -> Bool -> Bool
|| Version b
thisVersion forall a. Eq a => a -> a -> Bool
== forall a. Version a
noVersion
                then Either String (Parser b)
previousParser
                else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Either String (Parser b)
previousParser) forall a b. b -> Either a b
Right Either String (Parser b)
forwardParser
      where versionNotFound :: String
versionNotFound = String
"Cannot find parser associated with: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Version a
origVersion
            reverseProxy :: Proxy (MigrateFrom (Reverse b))
            reverseProxy :: Proxy (MigrateFrom (Reverse b))
reverseProxy = forall {k} (t :: k). Proxy t
Proxy

-- | Type name string representation of a __nullary__ type constructor.
typeName0 :: Typeable a => Proxy a -> String
typeName0 :: forall a. Typeable a => Proxy a -> String
typeName0 = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep

-- | Type name string representation of a __unary__ type constructor.
typeName1 :: forall t a. Typeable t => Proxy (t a) -> String
typeName1 :: forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1 Proxy (t a)
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)

-- | Type name string representation of a __binary__ type constructor.
typeName2 :: forall t a b. Typeable t => Proxy (t a b) -> String
typeName2 :: forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2 Proxy (t a b)
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)

-- | Type name string representation of a __ternary__ type constructor.
typeName3 :: forall t a b c. Typeable t => Proxy (t a b c) -> String
typeName3 :: forall (t :: * -> * -> * -> *) a b c.
Typeable t =>
Proxy (t a b c) -> String
typeName3 Proxy (t a b c)
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)

-- | Type name string representation of a __4-ary__ type constructor.
typeName4 :: forall t a b c d. Typeable t => Proxy (t a b c d) -> String
typeName4 :: forall (t :: * -> * -> * -> * -> *) a b c d.
Typeable t =>
Proxy (t a b c d) -> String
typeName4 Proxy (t a b c d)
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)

-- | Type name string representation of a __5-ary__ type constructor.
typeName5 :: forall t a b c d e. Typeable t => Proxy (t a b c d e) -> String
typeName5 :: forall (t :: * -> * -> * -> * -> * -> *) a b c d e.
Typeable t =>
Proxy (t a b c d e) -> String
typeName5 Proxy (t a b c d e)
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)


-- | Profile of the internal consistency of a 'SafeJSON' instance.
--
--   /N.B. 'noVersion' shows as/ @null@ /instead of a number./
data Profile a = InvalidProfile String -- ^ There is something wrong with versioning
               | Profile ProfileVersions -- ^ Profile of consistent versions
  deriving (Profile a -> Profile a -> Bool
forall a. Profile a -> Profile a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Profile a -> Profile a -> Bool
$c/= :: forall a. Profile a -> Profile a -> Bool
== :: Profile a -> Profile a -> Bool
$c== :: forall a. Profile a -> Profile a -> Bool
Eq)

-- | Version profile of a consistent 'SafeJSON' instance.
data ProfileVersions = ProfileVersions {
    ProfileVersions -> Maybe Int32
profileCurrentVersion :: Maybe Int32, -- ^ Version of the type checked for consistency.
    ProfileVersions -> [(Maybe Int32, String)]
profileSupportedVersions :: [(Maybe Int32, String)] -- ^ All versions in the chain with their type names.
  } deriving (ProfileVersions -> ProfileVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfileVersions -> ProfileVersions -> Bool
$c/= :: ProfileVersions -> ProfileVersions -> Bool
== :: ProfileVersions -> ProfileVersions -> Bool
$c== :: ProfileVersions -> ProfileVersions -> Bool
Eq)

noVersionPresent :: ProfileVersions -> Bool
noVersionPresent :: ProfileVersions -> Bool
noVersionPresent (ProfileVersions Maybe Int32
c [(Maybe Int32, String)]
vs) =
    forall a. Maybe a -> Bool
isNothing Maybe Int32
c Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall a. Maybe a
Nothing forall a b. Eq a => a -> [(a, b)] -> Maybe b
`List.lookup` [(Maybe Int32, String)]
vs)

showV :: Maybe Int32 -> String
showV :: Maybe Int32 -> String
showV Maybe Int32
Nothing  = String
"null"
showV (Just Int32
i) = forall a. Show a => a -> String
show Int32
i

showVs :: [(Maybe Int32, String)] -> String
showVs :: [(Maybe Int32, String)] -> String
showVs = forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int32, String) -> String
go
  where go :: (Maybe Int32, String) -> String
go (Maybe Int32
mi, String
s) = forall a. Monoid a => [a] -> a
mconcat [String
"(", Maybe Int32 -> String
showV Maybe Int32
mi, String
", ", String
s, String
")"]

-- | @'Version' Nothing@ shows as @null@
instance Show ProfileVersions where
  show :: ProfileVersions -> String
show (ProfileVersions Maybe Int32
cur [(Maybe Int32, String)]
sup) = forall a. Monoid a => [a] -> a
mconcat
      [ String
"version ", Maybe Int32 -> String
showV Maybe Int32
cur, String
": ["
      , [(Maybe Int32, String)] -> String
showVs [(Maybe Int32, String)]
sup, String
"]"
      ]

instance Typeable a => Show (Profile a) where
  show :: Profile a -> String
show (InvalidProfile String
s) = String
"InvalidProfile: " forall a. Semigroup a => a -> a -> a
<> String
s
  show (Profile ProfileVersions
pv) =
      let p :: Proxy a
p = forall {k} (t :: k). Proxy t
Proxy :: Proxy a
      in forall a. Monoid a => [a] -> a
mconcat [ String
"Profile for \"", forall a. Typeable a => Proxy a -> String
typeName0 Proxy a
p
                 , String
"\" (", forall a. Show a => a -> String
show ProfileVersions
pv, String
")"
                 ]

-- | Easy way to get a printable failure/success report
-- of the internal consistency of a SafeJSON instance.
mkProfile :: forall a. SafeJSON a => Proxy a -> Profile a
mkProfile :: forall a. SafeJSON a => Proxy a -> Profile a
mkProfile Proxy a
p = case forall a. SafeJSON a => Proxy a -> Consistency a
computeConsistency Proxy a
p of
    NotConsistent String
t -> forall a. String -> Profile a
InvalidProfile String
t
    Consistency a
Consistent -> forall a. ProfileVersions -> Profile a
Profile forall a b. (a -> b) -> a -> b
$ ProfileVersions {
        profileCurrentVersion :: Maybe Int32
profileCurrentVersion    = forall a. Version a -> Maybe Int32
unVersion (forall a. SafeJSON a => Version a
version @a),
        profileSupportedVersions :: [(Maybe Int32, String)]
profileSupportedVersions = forall a. SafeJSON a => Proxy a -> [(Maybe Int32, String)]
availableVersions Proxy a
p
      }

data Consistency a = Consistent
                   | NotConsistent String

checkConsistency :: (SafeJSON a, MonadFail m) => Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency :: forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency Proxy a
p ProfileVersions -> m b
m =
    case forall a. SafeJSON a => Proxy a -> Profile a
mkProfile Proxy a
p of
      InvalidProfile String
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
      Profile ProfileVersions
vs -> ProfileVersions -> m b
m ProfileVersions
vs

computeConsistency :: forall a. SafeJSON a => Proxy a -> Consistency a
computeConsistency :: forall a. SafeJSON a => Proxy a -> Consistency a
computeConsistency Proxy a
p
-- This checks the chain of versions to not clash or loop,
-- and it verifies only 'Base' or 'Extended Base' kinds can
-- have 'noVersion'
  | forall a. Kind a -> Bool
isObviouslyConsistent (forall a. SafeJSON a => Kind a
kind @a) = forall a. Consistency a
Consistent
  | Just String
s <- forall a. SafeJSON a => Proxy a -> Maybe String
invalidChain Proxy a
p = forall a. String -> Consistency a
NotConsistent String
s
  | Bool
otherwise = forall a. Consistency a
Consistent
{-# INLINE computeConsistency #-}

isObviouslyConsistent :: Kind a -> Bool
isObviouslyConsistent :: forall a. Kind a -> Bool
isObviouslyConsistent Kind a
Base = Bool
True
isObviouslyConsistent Kind a
_    = Bool
False

availableVersions :: forall a. SafeJSON a => Proxy a -> [(Maybe Int32, String)]
availableVersions :: forall a. SafeJSON a => Proxy a -> [(Maybe Int32, String)]
availableVersions Proxy a
_ =
    forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
worker Bool
False (forall a. SafeJSON a => Kind a
kind @a)
  where
    worker :: forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
    worker :: forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
worker Bool
fwd Kind b
thisKind = case Kind b
thisKind of
        Kind b
Base       -> [(Maybe Int32, String)
tup]
        Extends Proxy (MigrateFrom b)
p' -> (Maybe Int32, String)
tup forall a. a -> [a] -> [a]
: forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
worker Bool
fwd (forall a. SafeJSON a => Proxy a -> Kind a
kindFromProxy Proxy (MigrateFrom b)
p')
        Extended Kind b
k | Bool -> Bool
not Bool
fwd -> forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
worker Bool
True (forall a.
Migrate (Reverse a) =>
Kind a -> Kind (MigrateFrom (Reverse a))
getForwardKind Kind b
k)
        Extended Kind b
k -> forall b. SafeJSON b => Bool -> Kind b -> [(Maybe Int32, String)]
worker Bool
True Kind b
k

      where Version Maybe Int32
v = forall a. SafeJSON a => Version a
version @b
            name :: String
name = forall a. SafeJSON a => Proxy a -> String
typeName (forall {k} (t :: k). Proxy t
Proxy @b)
            tup :: (Maybe Int32, String)
tup = (Maybe Int32
v, String
name)

-- TODO: Have this output a custom type to differentiate between bad outcomes.
-- That way the tests can be more reliable. (Did they catch what they were
-- supposed to catch?)
invalidChain :: forall a. SafeJSON a => Proxy a -> Maybe String
invalidChain :: forall a. SafeJSON a => Proxy a -> Maybe String
invalidChain Proxy a
_ =
  forall b.
SafeJSON b =>
Set (Maybe Int32)
-> Set (Maybe Int32, String) -> Kind b -> Maybe String
worker forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall a. SafeJSON a => Kind a
kind @a)
  where
    --                                Version set            Version set with type name     Kind      Maybe error
    worker :: forall b. SafeJSON b => S.Set (Maybe Int32) -> S.Set (Maybe Int32, String) -> Kind b -> Maybe String
    worker :: forall b.
SafeJSON b =>
Set (Maybe Int32)
-> Set (Maybe Int32, String) -> Kind b -> Maybe String
worker Set (Maybe Int32)
vs Set (Maybe Int32, String)
vSs Kind b
k
      | Maybe Int32
i forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Maybe Int32)
vs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
          [ String
"Double occurence of version number '", Maybe Int32 -> String
showV Maybe Int32
i
          , String
"' (type: ", forall a. SafeJSON a => Proxy a -> String
typeName Proxy b
p
          , String
"). Looping instances if the previous combination of type and version number are found here: "
          , [(Maybe Int32, String)] -> String
showVs forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set (Maybe Int32, String)
vSs
          ]
      | Bool
otherwise = case Kind b
k of
          Kind b
Base -> forall a. Maybe a
Nothing
          Extends{} | forall a. Maybe a -> Bool
isNothing Maybe Int32
i -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
              [ forall a. SafeJSON a => Proxy a -> String
typeName Proxy b
p, String
" has defined 'version = noVersion', "
              , String
" but it's 'kind' definition is not 'base' or 'extended_base'"
              ]
          Extends Proxy (MigrateFrom b)
a_proxy -> forall b.
SafeJSON b =>
Set (Maybe Int32)
-> Set (Maybe Int32, String) -> Kind b -> Maybe String
worker Set (Maybe Int32)
newVSet Set (Maybe Int32, String)
newVsSet (forall a. SafeJSON a => Proxy a -> Kind a
kindFromProxy Proxy (MigrateFrom b)
a_proxy)
          Extended Kind b
a_kind -> let v :: Version (MigrateFrom (Reverse b))
v@(Version Maybe Int32
i') = forall a. SafeJSON a => Kind a -> Version a
versionFromKind forall a b. (a -> b) -> a -> b
$ forall a.
Migrate (Reverse a) =>
Kind a -> Kind (MigrateFrom (Reverse a))
getForwardKind Kind b
a_kind
                                 tup :: (Maybe Int32, String)
tup = (Maybe Int32
i', forall a. SafeJSON a => Proxy a -> String
typeName (forall a. Version a -> Proxy a
proxyFromVersion Version (MigrateFrom (Reverse b))
v))
                              in forall b.
SafeJSON b =>
Set (Maybe Int32)
-> Set (Maybe Int32, String) -> Kind b -> Maybe String
worker (forall a. Ord a => a -> Set a -> Set a
S.insert Maybe Int32
i' Set (Maybe Int32)
vs) (forall a. Ord a => a -> Set a -> Set a
S.insert (Maybe Int32, String)
tup Set (Maybe Int32, String)
vSs) Kind b
a_kind
      where Version Maybe Int32
i = forall a. SafeJSON a => Version a
version @b
            p :: Proxy b
p = forall {k} (t :: k). Proxy t
Proxy @b
            newVSet :: Set (Maybe Int32)
newVSet = forall a. Ord a => a -> Set a -> Set a
S.insert Maybe Int32
i Set (Maybe Int32)
vs
            newVsSet :: Set (Maybe Int32, String)
newVsSet = forall a. Ord a => a -> Set a -> Set a
S.insert (Maybe Int32
i, forall a. SafeJSON a => Proxy a -> String
typeName Proxy b
p) Set (Maybe Int32, String)
vSs


----------------------------------------------------------
-- Conversion functions
----------------------------------------------------------

proxyFromVersion :: Version a -> Proxy a
proxyFromVersion :: forall a. Version a -> Proxy a
proxyFromVersion Version a
_ = forall {k} (t :: k). Proxy t
Proxy

kindFromProxy :: SafeJSON a => Proxy a -> Kind a
kindFromProxy :: forall a. SafeJSON a => Proxy a -> Kind a
kindFromProxy Proxy a
_ = forall a. SafeJSON a => Kind a
kind

versionFromProxy :: SafeJSON a => Proxy a -> Version a
versionFromProxy :: forall a. SafeJSON a => Proxy a -> Version a
versionFromProxy Proxy a
_ = forall a. SafeJSON a => Version a
version

versionFromKind :: SafeJSON a => Kind a -> Version a
versionFromKind :: forall a. SafeJSON a => Kind a -> Version a
versionFromKind Kind a
_ = forall a. SafeJSON a => Version a
version

getForwardKind :: Migrate (Reverse a) => Kind a -> Kind (MigrateFrom (Reverse a))
getForwardKind :: forall a.
Migrate (Reverse a) =>
Kind a -> Kind (MigrateFrom (Reverse a))
getForwardKind Kind a
_ = forall a. SafeJSON a => Kind a
kind


-- ---------------------- --
--   Defining safeFrom    --
-- ---------------------- --

withContained :: (a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained :: forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained a -> b -> c -> m d
f a
name b
prs = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> m d
f a
name b
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 :: forall a.
String -> (Object -> Parser a) -> Value -> Contained (Parser a)
containWithObject = forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained forall a. String -> (Object -> Parser a) -> Value -> Parser a
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 :: forall a.
String -> (Array -> Parser a) -> Value -> Contained (Parser a)
containWithArray = forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained forall a. String -> (Array -> Parser a) -> Value -> Parser a
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 :: forall a.
String -> (Text -> Parser a) -> Value -> Contained (Parser a)
containWithText = forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained forall a. String -> (Text -> Parser a) -> Value -> Parser a
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 :: forall a.
String -> (Scientific -> Parser a) -> Value -> Contained (Parser a)
containWithScientific = forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
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 :: forall a.
String -> (Bool -> Parser a) -> Value -> Contained (Parser a)
containWithBool = forall a b c (m :: * -> *) d.
(a -> b -> c -> m d) -> a -> b -> c -> Contained (m d)
withContained forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool

-- | Similar to 'Data.Aeson..:', but uses `safeFromJSON` instead of parseJSON
-- 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
.:$ :: forall a. SafeJSON a => Object -> Key -> Parser a
(.:$) = forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField forall a. SafeJSON a => Value -> Parser a
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
.:$? :: forall a. SafeJSON a => Object -> Key -> Parser (Maybe a)
(.:$?) = forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe forall a. SafeJSON a => Value -> Parser a
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
.:$! :: forall a. SafeJSON a => Object -> Key -> Parser (Maybe a)
(.:$!) = forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe' forall a. SafeJSON a => Value -> Parser a
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
#if MIN_VERSION_aeson(2,2,0)
(.=$) :: (SafeJSON a, KeyValue e kv) => Key -> a -> kv
#else
#if MIN_VERSION_aeson(2,0,0)
(.=$) :: (SafeJSON a, KeyValue kv) => Key -> a -> kv
#else
(.=$) :: (SafeJSON a, KeyValue kv) => Text -> a -> kv
#endif
#endif
Key
name .=$ :: forall a kv. (SafeJSON a, KeyValue kv) => Key -> a -> kv
.=$ a
val = Key
name forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SafeJSON a => a -> Value
safeToJSON a
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)
#if MIN_VERSION_aeson(2,0,0)
BASIC_NULLARY(K.Key)
#endif
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 :: Proxy (Ratio a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Ratio a)
version = forall a. Version a
noVersion

instance HasResolution a => SafeJSON (Fixed a) where
  typeName :: Proxy (Fixed a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Fixed a)
version = forall a. Version a
noVersion

instance SafeJSON (Proxy a) where
  typeName :: Proxy (Proxy a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Proxy a)
version = forall a. Version a
noVersion

instance {-# OVERLAPPING #-} SafeJSON String where
  typeName :: Proxy String -> String
typeName Proxy String
_ = String
"String"
  version :: Version String
version = forall a. Version a
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 :: Value -> Contained (Parser (Const a b))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> Const a b
Const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
  safeTo :: Const a b -> Contained Value
safeTo (Const a
a) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON a
a
  typeName :: Proxy (Const a b) -> String
typeName = forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2
  version :: Version (Const a b)
version = forall a. Version a
noVersion

instance SafeJSON a => SafeJSON (Maybe a) where
  safeFrom :: Value -> Contained (Parser (Maybe a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. FromJSON a => Value -> Parser a
parseJSON Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. SafeJSON a => Value -> Parser a
safeFromJSON
  -- Nothing means do whatever Aeson thinks Nothing should be
  safeTo :: Maybe a -> Contained Value
safeTo Maybe a
Nothing = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. Maybe a
Nothing :: Maybe Value)
  -- If there's something, keep it safe
  safeTo (Just a
a) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON a
a
  typeName :: Proxy (Maybe a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Maybe a)
version = forall a. Version a
noVersion

instance (SafeJSON a, SafeJSON b) => SafeJSON (Either a b) where
  safeFrom :: Value -> Contained (Parser (Either a b))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      Either Value Value
eVal <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      case Either Value Value
eVal of
        Left Value
a  -> forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
a
        Right Value
b -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
b
  safeTo :: Either a b -> Contained Value
safeTo (Left a
a)  = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON a
a :: Either Value Void)
  safeTo (Right b
b) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON b
b :: Either Void Value)
  typeName :: Proxy (Either a b) -> String
typeName = forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2
  version :: Version (Either a b)
version = forall a. Version a
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 :: forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
Value -> Contained (Parser (v a))
fromGenericVector Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      Array
v <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VG.convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
VG.mapM forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Array
v :: V.Vector Value)

toGenericVector :: (SafeJSON a, VG.Vector v a) => v a -> Contained Value
toGenericVector :: forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
v a -> Contained Value
toGenericVector = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SafeJSON a => a -> Value
safeToJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList

instance SafeJSON a => SafeJSON (V.Vector a) where
  safeFrom :: Value -> Contained (Parser (Vector a))
safeFrom = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
Value -> Contained (Parser (v a))
fromGenericVector
  safeTo :: Vector a -> Contained Value
safeTo = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
v a -> Contained Value
toGenericVector
  typeName :: Proxy (Vector a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Vector a)
version = forall a. Version a
noVersion

instance (SafeJSON a, VP.Prim a) => SafeJSON (VP.Vector a) where
  safeFrom :: Value -> Contained (Parser (Vector a))
safeFrom = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
Value -> Contained (Parser (v a))
fromGenericVector
  safeTo :: Vector a -> Contained Value
safeTo = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
v a -> Contained Value
toGenericVector
  typeName :: Proxy (Vector a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Vector a)
version = forall a. Version a
noVersion

instance (SafeJSON a, VS.Storable a) => SafeJSON (VS.Vector a) where
  safeFrom :: Value -> Contained (Parser (Vector a))
safeFrom = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
Value -> Contained (Parser (v a))
fromGenericVector
  safeTo :: Vector a -> Contained Value
safeTo = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
v a -> Contained Value
toGenericVector
  typeName :: Proxy (Vector a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Vector a)
version = forall a. Version a
noVersion

instance (SafeJSON a, VG.Vector VU.Vector a) => SafeJSON (VU.Vector a) where
  safeFrom :: Value -> Contained (Parser (Vector a))
safeFrom = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
Value -> Contained (Parser (v a))
fromGenericVector
  safeTo :: Vector a -> Contained Value
safeTo = forall a (v :: * -> *).
(SafeJSON a, Vector v a) =>
v a -> Contained Value
toGenericVector
  typeName :: Proxy (Vector a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Vector a)
version = forall a. Version a
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 :: Value -> Contained (Parser [a])
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. FromJSON a => Value -> Parser a
parseJSON Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. SafeJSON a => Value -> Parser a
safeFromJSON
  safeTo :: [a] -> Contained Value
safeTo [a]
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as
  typeName :: Proxy [a] -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version [a]
version = forall a. Version a
noVersion

#define BASIC_UNARY_FUNCTOR(T)                      \
instance SafeJSON a => SafeJSON (T a) where {       \
  safeFrom val = contain $                          \
      parseJSON val >>= traverse safeFromJSON;      \
  safeTo as = contain . toJSON $ safeToJSON <$> as; \
  typeName = typeName1;                             \
  version = noVersion }

BASIC_UNARY_FUNCTOR(NonEmpty)
BASIC_UNARY_FUNCTOR(Seq)
BASIC_UNARY_FUNCTOR(Tree)

instance SafeJSON a => SafeJSON (IntMap a) where
  safeFrom :: Value -> Contained (Parser (IntMap a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. [(Int, a)] -> IntMap a
IM.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
  safeTo :: IntMap a -> Contained Value
safeTo IntMap a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap a
as
  typeName :: Proxy (IntMap a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (IntMap a)
version = forall a. Version a
noVersion

instance (SafeJSON a) => SafeJSON (DList a) where
  safeFrom :: Value -> Contained (Parser (DList a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. [a] -> DList a
DList.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
  safeTo :: DList a -> Contained Value
safeTo DList a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList a
as
  typeName :: Proxy (DList a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (DList a)
version = forall a. Version a
noVersion

instance (SafeJSON a, Ord a) => SafeJSON (S.Set a) where
  safeFrom :: Value -> Contained (Parser (Set a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
  safeTo :: Set a -> Contained Value
safeTo Set a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList Set a
as
  typeName :: Proxy (Set a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (Set a)
version = forall a. Version a
noVersion

instance (Ord k, FromJSONKey k, ToJSONKey k, SafeJSON a) => SafeJSON (Map k a) where
  safeFrom :: Value -> Contained (Parser (Map k a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. FromJSON a => Value -> Parser a
parseJSON Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. SafeJSON a => Value -> Parser a
safeFromJSON
  safeTo :: Map k a -> Contained Value
safeTo Map k a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k a
as
  typeName :: Proxy (Map k a) -> String
typeName = forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2
  version :: Version (Map k a)
version = forall a. Version a
noVersion

instance (SafeJSON a, Eq a, Hashable a) => SafeJSON (HS.HashSet a) where
  safeFrom :: Value -> Contained (Parser (HashSet a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
  safeTo :: HashSet a -> Contained Value
safeTo HashSet a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HashSet a -> [a]
HS.toList HashSet a
as
  typeName :: Proxy (HashSet a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (HashSet a)
version = forall a. Version a
noVersion

instance (Hashable a, FromJSONKey a, ToJSONKey a, Eq a, SafeJSON b) => SafeJSON (HashMap a b) where
  safeFrom :: Value -> Contained (Parser (HashMap a b))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
      forall a. FromJSON a => Value -> Parser a
parseJSON Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. SafeJSON a => Value -> Parser a
safeFromJSON
  safeTo :: HashMap a b -> Contained Value
safeTo HashMap a b
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap a b
as
  typeName :: Proxy (HashMap a b) -> String
typeName = forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2
  version :: Version (HashMap a b)
version = forall a. Version a
noVersion

#if MIN_VERSION_aeson(2,0,0)
-- | @since 1.1.2.0
instance SafeJSON a => SafeJSON (Map.KeyMap a) where
  safeFrom :: Value -> Contained (Parser (KeyMap a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$
#if !MIN_VERSION_aeson(2,0,1)
      fmap Map.fromMap $
#endif
          forall a. FromJSON a => Value -> Parser a
parseJSON Value
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. SafeJSON a => Value -> Parser a
safeFromJSON
  safeTo :: KeyMap a -> Contained Value
safeTo KeyMap a
as = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap a
as
  typeName :: Proxy (KeyMap a) -> String
typeName = forall (t :: * -> *) a. Typeable t => Proxy (t a) -> String
typeName1
  version :: Version (KeyMap a)
version = forall a. Version a
noVersion
#endif

instance (SafeJSON a, SafeJSON b) => SafeJSON (a, b) where
  safeFrom :: Value -> Contained (Parser (a, b))
safeFrom Value
x = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      (Value
a',Value
b') <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
      a
a <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
a'
      b
b <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
b'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,b
b)
  safeTo :: (a, b) -> Contained Value
safeTo (a
a,b
b) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. SafeJSON a => a -> Value
safeToJSON a
a, forall a. SafeJSON a => a -> Value
safeToJSON b
b)
  typeName :: Proxy (a, b) -> String
typeName = forall (t :: * -> * -> *) a b.
Typeable t =>
Proxy (t a b) -> String
typeName2
  version :: Version (a, b)
version = forall a. Version a
noVersion

instance (SafeJSON a, SafeJSON b, SafeJSON c) => SafeJSON (a, b, c) where
  safeFrom :: Value -> Contained (Parser (a, b, c))
safeFrom Value
x = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      (Value
a',Value
b',Value
c') <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
      a
a <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
a'
      b
b <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
b'
      c
c <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
c'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,b
b,c
c)
  safeTo :: (a, b, c) -> Contained Value
safeTo (a
a,b
b,c
c) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. SafeJSON a => a -> Value
safeToJSON a
a, forall a. SafeJSON a => a -> Value
safeToJSON b
b, forall a. SafeJSON a => a -> Value
safeToJSON c
c)
  typeName :: Proxy (a, b, c) -> String
typeName = forall (t :: * -> * -> * -> *) a b c.
Typeable t =>
Proxy (t a b c) -> String
typeName3
  version :: Version (a, b, c)
version = forall a. Version a
noVersion

instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d) => SafeJSON (a, b, c, d) where
  safeFrom :: Value -> Contained (Parser (a, b, c, d))
safeFrom Value
x = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      (Value
a',Value
b',Value
c',Value
d') <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
      a
a <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
a'
      b
b <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
b'
      c
c <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
c'
      d
d <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
d'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,b
b,c
c,d
d)
  safeTo :: (a, b, c, d) -> Contained Value
safeTo (a
a,b
b,c
c,d
d) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. SafeJSON a => a -> Value
safeToJSON a
a, forall a. SafeJSON a => a -> Value
safeToJSON b
b, forall a. SafeJSON a => a -> Value
safeToJSON c
c, forall a. SafeJSON a => a -> Value
safeToJSON d
d)
  typeName :: Proxy (a, b, c, d) -> String
typeName = forall (t :: * -> * -> * -> * -> *) a b c d.
Typeable t =>
Proxy (t a b c d) -> String
typeName4
  version :: Version (a, b, c, d)
version = forall a. Version a
noVersion

instance (SafeJSON a, SafeJSON b, SafeJSON c, SafeJSON d, SafeJSON e) => SafeJSON (a, b, c, d, e) where
  safeFrom :: Value -> Contained (Parser (a, b, c, d, e))
safeFrom Value
x = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
      (Value
a',Value
b',Value
c',Value
d',Value
e') <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
      a
a <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
a'
      b
b <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
b'
      c
c <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
c'
      d
d <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
d'
      e
e <- forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
e'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,b
b,c
c,d
d,e
e)
  safeTo :: (a, b, c, d, e) -> Contained Value
safeTo (a
a,b
b,c
c,d
d,e
e) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. SafeJSON a => a -> Value
safeToJSON a
a, forall a. SafeJSON a => a -> Value
safeToJSON b
b, forall a. SafeJSON a => a -> Value
safeToJSON c
c, forall a. SafeJSON a => a -> Value
safeToJSON d
d, forall a. SafeJSON a => a -> Value
safeToJSON e
e)
  typeName :: Proxy (a, b, c, d, e) -> String
typeName = forall (t :: * -> * -> * -> * -> * -> *) a b c d e.
Typeable t =>
Proxy (t a b c d e) -> String
typeName5
  version :: Version (a, b, c, d, e)
version = forall a. Version a
noVersion

-- | @since 1.1.2.0
instance SafeJSON (f (g a)) => SafeJSON (Compose f g a) where
    safeFrom :: Value -> Contained (Parser (Compose f g a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
    safeTo :: Compose f g a -> Contained Value
safeTo (Compose f (g a)
val) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. SafeJSON a => a -> Value
safeToJSON f (g a)
val
    typeName :: Proxy (Compose f g a) -> String
typeName Proxy (Compose f g a)
_ = String
"Compose"
    version :: Version (Compose f g a)
version = forall a. Version a
noVersion

-- | @since 1.1.2.0
instance (SafeJSON (f a), SafeJSON (g a)) => SafeJSON (Sum f g a) where
    safeFrom :: Value -> Contained (Parser (Sum f g a))
safeFrom = forall a.
String -> (Object -> Parser a) -> Value -> Contained (Parser a)
containWithObject String
"Sum" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        case forall v. KeyMap v -> [(Key, v)]
Map.toList Object
o of
            [(Key
"InL", Value
val)] -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
            [(Key
"InR", Value
val)] -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
val
            [Pair]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Sum expects an object with one field: \"InL\" or \"InR\""
    safeTo :: Sum f g a -> Contained Value
safeTo = forall a. a -> Contained a
contain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeJSON a => a -> Value
safeToJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. k -> a -> Map k a
M.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        InL f a
fa -> (String
"InL" :: String, forall a. SafeJSON a => a -> Value
safeToJSON f a
fa)
        InR g a
ga -> (String
"InR" :: String, forall a. SafeJSON a => a -> Value
safeToJSON g a
ga)
    typeName :: Proxy (Sum f g a) -> String
typeName Proxy (Sum f g a)
_ = String
"Sum"
    version :: Version (Sum f g a)
version = forall a. Version a
noVersion

-- | @since 1.1.2.0
instance (SafeJSON (f a), SafeJSON (g a), SafeJSON a) => SafeJSON (Product f g a) where
    safeFrom :: Value -> Contained (Parser (Product f g a))
safeFrom Value
val = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ do
        (Value
f, Value
g) <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. SafeJSON a => Value -> Parser a
safeFromJSON Value
g
    safeTo :: Product f g a -> Contained Value
safeTo (Pair f a
f g a
g) = forall a. a -> Contained a
contain forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON (forall a. SafeJSON a => a -> Value
safeToJSON f a
f, forall a. SafeJSON a => a -> Value
safeToJSON g a
g)
    typeName :: Proxy (Product f g a) -> String
typeName Proxy (Product f g a)
_ = String
"Product"
    version :: Version (Product f g a)
version = forall a. Version a
noVersion