    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.SafeCopy.SafeCopy
    -- Copyright   :  PublicDomain
    --
    -- Maintainer  :  lemmih@gmail.com
    -- Portability :  non-portable (uses GHC extensions)
    --
    -- SafeCopy extends the parsing and serialization capabilities of Data.Binary
    -- to include nested version control. Nested version control means that you
    -- can change the defintion and binary format of a type nested deep within
    -- other types without problems.
    --
    module Data.SafeCopy.SafeCopy where

    import Control.Monad
    import Control.Monad.Trans.Class (lift)
    import qualified Control.Monad.Fail as Fail
    import Control.Monad.Trans.State as State (evalStateT, modify, StateT)
    import qualified Control.Monad.Trans.State as State (get)
    import Control.Monad.Trans.RWS as RWS (evalRWST, modify, RWST, tell)
    import qualified Control.Monad.Trans.RWS as RWS (get)
    import Data.Bits (shiftR)
    import Data.Int (Int32)
    import Data.List
    import Data.Map as Map (Map, lookup, insert)
    import Data.Serialize
    import Data.Set as Set (insert, member, Set)
    import Data.Typeable (Typeable, TypeRep, typeOf, typeRep)
    import Data.Word (Word8)
    import GHC.Generics
    import Generic.Data as G (Constructors, gconIndex, gconNum)
    import Unsafe.Coerce (unsafeCoerce)

    -- | The central mechanism for dealing with version control.
    --
    --   This type class specifies what data migrations can happen
    --   and how they happen.
    class SafeCopy (MigrateFrom a) => Migrate a where
        -- | This is the type we're extending. Each type capable of migration can
        --   only extend one other type.
        type MigrateFrom a

        -- | This method specifies how to migrate from the older type to the newer
        --   one. It will never be necessary to use this function manually as it
        --   all taken care of internally in the library.
        migrate :: MigrateFrom a -> a

    -- | This is a wrapper type used migrating backwards in the chain of compatible types.
    newtype Reverse a = Reverse { forall a. Reverse a -> a
    unReverse :: a }

    -- | The kind of a data type determines how it is tagged (if at all).
    --
    --   Primitives kinds (see 'primitive') are not tagged with a version
    --   id and hence cannot be extended later.
    --
    --   Extensions (see 'extension') tell the system that there exists
    --   a previous version of the data type which should be migrated if
    --   needed.
    --
    --   There is also a default kind which is neither primitive nor
    --   an extension of a previous type.
    data Kind a where
        Primitive :: Kind a
        Base      :: Kind a
        Extends   :: (Migrate a) => Proxy (MigrateFrom a) -> Kind a
        Extended  :: (Migrate (Reverse a)) => Kind a -> Kind a

    isPrimitive :: Kind a -> Bool
    isPrimitive :: forall a. Kind a -> Bool
    isPrimitive Kind a
    Primitive = Bool
    True
    isPrimitive Kind a
    _ = Bool
    False

    -- | Wrapper for data that was saved without a version tag.
    newtype Prim a = Prim { forall a. Prim a -> a
    getPrimitive :: a }

    -- | The centerpiece of this library. Defines a version for a data type
    --   together with how it should be serialized/parsed.
    --
    --   Users should define instances of 'SafeCopy' for their types
    --   even though 'getCopy' and 'putCopy' can't be used directly.
    --   To serialize/parse a data type using 'SafeCopy', see 'safeGet'
    --   and 'safePut'.
    class Typeable a => SafeCopy a where
        -- | The version of the type.
        --
        --   Only used as a key so it must be unique (this is checked at run-time)
        --   but doesn't have to be sequential or continuous.
        --
        --   The default version is '0'.
        version :: Version a
        version = Int32 -> Version a
    forall a. Int32 -> Version a
    Version Int32
    0

        -- | The kind specifies how versions are dealt with. By default,
        --   values are tagged with their version id and don't have any
        --   previous versions. See 'extension' and the much less used
        --   'primitive'.
        kind :: Kind a
        kind = Kind a
    forall a. Kind a
    Base

        -- | This method defines how a value should be parsed without also worrying
        --   about writing out the version tag. This function cannot be used directly.
        --   One should use 'safeGet', instead.
        getCopy  :: Contained (Get a)

        -- | This method defines how a value should be parsed without worrying about
        --   previous versions or migrations. This function cannot be used directly.
        --   One should use 'safePut, instead.
        putCopy  :: a -> Contained Put

        -- | Internal function that should not be overrided.
        --   @Consistent@ iff 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 'safeGet' or 'safePut' is
        --   used.
        internalConsistency :: Consistency a
        internalConsistency = Proxy a -> Consistency a
    forall a. SafeCopy a => Proxy a -> Consistency a
    computeConsistency Proxy a
    forall a. Proxy a
    Proxy

        -- | Version profile.
        objectProfile :: Profile a
        objectProfile = Proxy a -> Profile a
    forall a. SafeCopy a => Proxy a -> Profile a
    mkProfile Proxy a
    forall a. Proxy a
    Proxy

        -- | The name of the type. This is only used in error message
        -- strings.
        errorTypeName :: Proxy a -> String

        default errorTypeName :: Typeable a => Proxy a -> String
        errorTypeName Proxy a
    _ = TypeRep -> String
    forall a. Show a => a -> String
    show (Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall a. Proxy a
    Proxy @a))

        default putCopy :: (GPutCopy (Rep a) DatatypeInfo, Constructors a) => a -> Contained Put
        putCopy a
    a = (Put -> Contained Put
    forall a. a -> Contained a
    contain (Put -> Contained Put) -> (a -> Put) -> a -> Contained Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DatatypeInfo -> Rep a DatatypeInfo -> Put
    forall (f :: * -> *) p. GPutCopy f p => p -> f p -> Put
    gputCopy (Word8 -> Word8 -> DatatypeInfo
    ConstructorInfo (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (forall a. Constructors a => Int
    gconNum @a)) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int
    forall a. Constructors a => a -> Int
    gconIndex a
    a))) (Rep a DatatypeInfo -> Put)
    -> (a -> Rep a DatatypeInfo) -> a -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rep a DatatypeInfo
    forall x. a -> Rep a x
    forall a x. Generic a => a -> Rep a x
    from) a
    a

        default getCopy :: (GGetCopy (Rep a) DatatypeInfo, Constructors a) => Contained (Get a)
        getCopy = Get a -> Contained (Get a)
    forall a. a -> Contained a
    contain (Rep a (ZonkAny 0) -> a
    forall a x. Generic a => Rep a x -> a
    forall x. Rep a x -> a
    to (Rep a (ZonkAny 0) -> a) -> Get (Rep a (ZonkAny 0)) -> Get a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DatatypeInfo -> Get (Rep a (ZonkAny 0))
    forall a. DatatypeInfo -> Get (Rep a a)
    forall (f :: * -> *) p a. GGetCopy f p => p -> Get (f a)
    ggetCopy (Word8 -> DatatypeInfo
    ConstructorCount (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (forall a. Constructors a => Int
    gconNum @a))))

    class GPutCopy f p where
        gputCopy :: p -> f p -> Put

    instance GPutCopy a p => GPutCopy (M1 D c a) p where
        gputCopy :: p -> M1 D c a p -> Put
    gputCopy p
    p (M1 a p
    a) = p -> a p -> Put
    forall (f :: * -> *) p. GPutCopy f p => p -> f p -> Put
    gputCopy p
    p a p
    a
        {-# INLINE gputCopy #-}

    instance (GPutCopy f p, GPutCopy g p) => GPutCopy (f :+: g) p where
        gputCopy :: p -> (:+:) f g p -> Put
    gputCopy p
    p (L1 f p
    x) = forall (f :: * -> *) p. GPutCopy f p => p -> f p -> Put
    gputCopy @f p
    p f p
    x
        gputCopy p
    p (R1 g p
    x) = forall (f :: * -> *) p. GPutCopy f p => p -> f p -> Put
    gputCopy @g p
    p g p
    x
        {-# INLINE gputCopy #-}

    -- | A constraint that combines 'SafeCopy' and 'Typeable'.
    type SafeCopy' a = SafeCopy a
    {-# DEPRECATED SafeCopy' "SafeCopy' is now equivalent to SafeCopy " #-}

    -- To get the current safecopy behavior we need to emulate the
    -- template haskell code here - collect the (a -> Put) values for all
    -- the fields and then run them in order.o
    instance (GPutFields a p, p ~ DatatypeInfo) => GPutCopy (M1 C c a) p where
        gputCopy :: p -> M1 C c a p -> Put
    gputCopy p
    p (M1 a p
    x) =
          (Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DatatypeInfo -> Word8
    _size p
    DatatypeInfo
    p Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    2) (Putter Word8
    putWord8 (Word8 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (DatatypeInfo -> Word8
    _code p
    DatatypeInfo
    p)))) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *>
            -- This is how I tried it first, and it works well but the
            -- result is not the same as deriveSafeCopy.
            -- mconcat (fmap join (gputFields p x))
            -- join (mconcat <$> sequence (fmap snd (gputFields p x)))
          (do putter <- ([Put] -> Put
    forall a. Monoid a => [a] -> a
    mconcat ([Put] -> Put) -> (((), [Put]) -> [Put]) -> ((), [Put]) -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((), [Put]) -> [Put]
    forall a b. (a, b) -> b
    snd) (((), [Put]) -> Put) -> PutM ((), [Put]) -> PutM Put
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (RWST () [Put] (Set TypeRep) PutM ()
    -> () -> Set TypeRep -> PutM ((), [Put])
    forall (m :: * -> *) r w s a.
    Monad m =>
    RWST r w s m a -> r -> s -> m (a, w)
    evalRWST (p -> a p -> RWST () [Put] (Set TypeRep) PutM ()
    forall (f :: * -> *) p.
    GPutFields f p =>
    p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p a p
    x) () Set TypeRep
    forall a. Monoid a => a
    mempty)
              putter)
        {-# INLINE gputCopy #-}

    -- | gputFields traverses the fields of a constructor and returns a put
    -- for the safecopy versions and a put for the field values.
    class GPutFields f p where
        gputFields :: p -> f p -> RWST () [Put] (Set TypeRep) PutM ()

    instance (GPutFields f p, GPutFields g p) => GPutFields (f :*: g) p where
        gputFields :: p -> (:*:) f g p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p (f p
    a :*: g p
    b) = p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    forall (f :: * -> *) p.
    GPutFields f p =>
    p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p f p
    a RWST () [Put] (Set TypeRep) PutM ()
    -> RWST () [Put] (Set TypeRep) PutM ()
    -> RWST () [Put] (Set TypeRep) PutM ()
    forall a b.
    RWST () [Put] (Set TypeRep) PutM a
    -> RWST () [Put] (Set TypeRep) PutM b
    -> RWST () [Put] (Set TypeRep) PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> p -> g p -> RWST () [Put] (Set TypeRep) PutM ()
    forall (f :: * -> *) p.
    GPutFields f p =>
    p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p g p
    b
        {-# INLINE gputFields #-}

    instance GPutFields f p => GPutFields (M1 S c f) p where
        gputFields :: p -> M1 S c f p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p (M1 f p
    a) = p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    forall (f :: * -> *) p.
    GPutFields f p =>
    p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    p f p
    a
        {-# INLINE gputFields #-}

    instance SafeCopy a => GPutFields (K1 R a) p where
        gputFields :: p -> K1 R a p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    _ (K1 a
    a) = do
          (a -> Contained Put) -> a -> RWST () [Put] (Set TypeRep) PutM ()
    forall a.
    SafeCopy a =>
    (a -> Contained Put) -> a -> RWST () [Put] (Set TypeRep) PutM ()
    getSafePutGeneric a -> Contained Put
    forall a. SafeCopy a => a -> Contained Put
    putCopy a
    a
        {-# INLINE gputFields #-}

    -- This corresponds to ggetFields, but does it match deriveSafeCopy?
    instance GPutFields U1 p where
        gputFields :: p -> U1 p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    _ U1 p
    _ =
          () -> RWST () [Put] (Set TypeRep) PutM ()
    forall a. a -> RWST () [Put] (Set TypeRep) PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    {-
    -- This outputs the version tag for (), which is 1.
    instance (GPutFields (K1 R ()) p) => GPutFields U1 p where
        gputFields p _ =
          gputFields p (K1 () :: K1 R () p)
    -}
        {-# INLINE gputFields #-}

    instance GPutFields V1 p where
        gputFields :: p -> V1 p -> RWST () [Put] (Set TypeRep) PutM ()
    gputFields p
    _ V1 p
    _ = RWST () [Put] (Set TypeRep) PutM ()
    forall a. HasCallStack => a
    undefined
        {-# INLINE gputFields #-}

    ------------------------------------------------------------------------

    class GGetCopy f p where
        ggetCopy :: p -> Get (f a)

    -- | The M1 type has a fourth type parameter p:
    --
    --     newtype M1 i (c :: Meta) (f :: k -> *) (p :: k) = M1 {unM1 :: f p}
    --
    -- Note that the type of the M1 field is @f p@, so in order to express this
    -- type we add a parameter of type p that we can apply to values of type f.
    instance (GGetCopy f p, p ~ DatatypeInfo) => GGetCopy (M1 D d f) p where
        ggetCopy :: forall a. p -> Get (M1 D d f a)
    ggetCopy p
    p
          | DatatypeInfo -> Word8
    _size p
    DatatypeInfo
    p Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    2 = do
              !code <- Get Word8
    getWord8
              M1 <$> ggetCopy (ConstructorInfo (_size p) code)
          | Bool
    otherwise = f a -> M1 D d f a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (f a -> M1 D d f a) -> Get (f a) -> Get (M1 D d f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DatatypeInfo -> Get (f a)
    forall a. DatatypeInfo -> Get (f a)
    forall (f :: * -> *) p a. GGetCopy f p => p -> Get (f a)
    ggetCopy (Word8 -> Word8 -> DatatypeInfo
    ConstructorInfo (DatatypeInfo -> Word8
    _size p
    DatatypeInfo
    p) Word8
    0)
        {-# INLINE ggetCopy #-}

    instance (GGetCopy f p, GGetCopy g p, p ~ DatatypeInfo) => GGetCopy (f :+: g) p where
        ggetCopy :: forall a. p -> Get ((:+:) f g a)
    ggetCopy p
    p = do
          -- choose the left or right branch of the constructor types
          -- based on whether the code is in the left or right half of the
          -- remaining constructor count.
          let sizeL :: Word8
    sizeL = DatatypeInfo -> Word8
    _size p
    DatatypeInfo
    p Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    1
              sizeR :: Word8
    sizeR = DatatypeInfo -> Word8
    _size p
    DatatypeInfo
    p Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    sizeL
          case DatatypeInfo -> Word8
    _code p
    DatatypeInfo
    p Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    sizeL of
            Bool
    True -> f a -> (:+:) f g a
    forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
    L1 (f a -> (:+:) f g a) -> Get (f a) -> Get ((:+:) f g a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (f :: * -> *) p a. GGetCopy f p => p -> Get (f a)
    ggetCopy @f (Word8 -> Word8 -> DatatypeInfo
    ConstructorInfo Word8
    sizeL (DatatypeInfo -> Word8
    _code p
    DatatypeInfo
    p))
            Bool
    False -> g a -> (:+:) f g a
    forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
    R1 (g a -> (:+:) f g a) -> Get (g a) -> Get ((:+:) f g a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (f :: * -> *) p a. GGetCopy f p => p -> Get (f a)
    ggetCopy @g (Word8 -> Word8 -> DatatypeInfo
    ConstructorInfo Word8
    sizeR (DatatypeInfo -> Word8
    _code p
    DatatypeInfo
    p Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    sizeL))
        {-# INLINE ggetCopy #-}

    instance GGetFields f p => GGetCopy (M1 C c f) p where
        ggetCopy :: forall a. p -> Get (M1 C c f a)
    ggetCopy p
    p = do
          f a -> M1 C c f a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (f a -> M1 C c f a) -> Get (f a) -> Get (M1 C c f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get (Get (f a)) -> Get (f a)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (StateT (Map TypeRep Int32) Get (Get (f a))
    -> Map TypeRep Int32 -> Get (Get (f a))
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (p -> StateT (Map TypeRep Int32) Get (Get (f a))
    forall a. p -> StateT (Map TypeRep Int32) Get (Get (f a))
    forall (f :: * -> *) p a.
    GGetFields f p =>
    p -> StateT (Map TypeRep Int32) Get (Get (f a))
    ggetFields p
    p) Map TypeRep Int32
    forall a. Monoid a => a
    mempty)
        {-# INLINE ggetCopy #-}

    -- append constructor fields
    class GGetFields f p where
        ggetFields :: p -> StateT (Map TypeRep Int32) Get (Get (f a))

    instance (GGetFields f p, GGetFields g p) => GGetFields (f :*: g) p where
        ggetFields :: forall a. p -> StateT (Map TypeRep Int32) Get (Get ((:*:) f g a))
    ggetFields p
    p = do
          fgetter <- forall (f :: * -> *) p a.
    GGetFields f p =>
    p -> StateT (Map TypeRep Int32) Get (Get (f a))
    ggetFields @f p
    p
          ggetter <- ggetFields @g p
          return ((:*:) <$> fgetter <*> ggetter)
        {-# INLINE ggetFields #-}

    instance GGetFields f p => GGetFields (M1 S c f) p where
        ggetFields :: forall a. p -> StateT (Map TypeRep Int32) Get (Get (M1 S c f a))
    ggetFields p
    p = do
          getter <- p -> StateT (Map TypeRep Int32) Get (Get (f a))
    forall a. p -> StateT (Map TypeRep Int32) Get (Get (f a))
    forall (f :: * -> *) p a.
    GGetFields f p =>
    p -> StateT (Map TypeRep Int32) Get (Get (f a))
    ggetFields p
    p
          return (M1 <$> getter)
        {-# INLINE ggetFields #-}

    instance SafeCopy a => GGetFields (K1 R a) p where
        ggetFields :: forall a. p -> StateT (Map TypeRep Int32) Get (Get (K1 R a a))
    ggetFields p
    _ = do
          getter <- StateT (Map TypeRep Int32) Get (Get a)
    forall a. SafeCopy a => StateT (Map TypeRep Int32) Get (Get a)
    getSafeGetGeneric
          return (K1 <$> getter)
        {-# INLINE ggetFields #-}

    instance GGetFields U1 p where
        ggetFields :: forall a. p -> StateT (Map TypeRep Int32) Get (Get (U1 a))
    ggetFields p
    _p = Get (U1 a) -> StateT (Map TypeRep Int32) Get (Get (U1 a))
    forall a. a -> StateT (Map TypeRep Int32) Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (U1 a -> Get (U1 a)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure U1 a
    forall k (p :: k). U1 p
    U1)
        {-# INLINE ggetFields #-}

    instance GGetFields V1 p where
        ggetFields :: forall a. p -> StateT (Map TypeRep Int32) Get (Get (V1 a))
    ggetFields p
    _p = StateT (Map TypeRep Int32) Get (Get (V1 a))
    forall a. HasCallStack => a
    undefined
        {-# INLINE ggetFields #-}

    data DatatypeInfo =
        ConstructorCount {DatatypeInfo -> Word8
    _size :: Word8}
      | ConstructorInfo {_size :: Word8, DatatypeInfo -> Word8
    _code :: Word8}
      deriving Int -> DatatypeInfo -> ShowS
    [DatatypeInfo] -> ShowS
    DatatypeInfo -> String
    (Int -> DatatypeInfo -> ShowS)
    -> (DatatypeInfo -> String)
    -> ([DatatypeInfo] -> ShowS)
    -> Show DatatypeInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DatatypeInfo -> ShowS
    showsPrec :: Int -> DatatypeInfo -> ShowS
    $cshow :: DatatypeInfo -> String
    show :: DatatypeInfo -> String
    $cshowList :: [DatatypeInfo] -> ShowS
    showList :: [DatatypeInfo] -> ShowS
    Show

    -- | Whereas the other 'getSafeGet' is only run when we know we need a
    -- version, this one is run for every field and must decide whether to
    -- read a version or not.  It constructs a Map TypeRep Int32 and reads
    -- when the new TypeRep is not in the map.
    getSafeGetGeneric ::
      forall a. SafeCopy a
      => StateT (Map TypeRep Int32) Get (Get a)
    getSafeGetGeneric :: forall a. SafeCopy a => StateT (Map TypeRep Int32) Get (Get a)
    getSafeGetGeneric
        = Proxy a
    -> StateT (Map TypeRep Int32) Get (Get a)
    -> StateT (Map TypeRep Int32) Get (Get a)
    forall a (m :: * -> *) b.
    (SafeCopy a, MonadFail m) =>
    Proxy a -> m b -> m b
    checkConsistency Proxy a
    proxy (StateT (Map TypeRep Int32) Get (Get a)
     -> StateT (Map TypeRep Int32) Get (Get a))
    -> StateT (Map TypeRep Int32) Get (Get a)
    -> StateT (Map TypeRep Int32) Get (Get a)
    forall a b. (a -> b) -> a -> b
    $
          case Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    proxy of
            Kind a
    Primitive -> Get a -> StateT (Map TypeRep Int32) Get (Get a)
    forall a. a -> StateT (Map TypeRep Int32) Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Get a -> StateT (Map TypeRep Int32) Get (Get a))
    -> Get a -> StateT (Map TypeRep Int32) Get (Get a)
    forall a b. (a -> b) -> a -> b
    $ Contained (Get a) -> Get a
    forall a. Contained a -> a
    unsafeUnPack Contained (Get a)
    forall a. SafeCopy a => Contained (Get a)
    getCopy
            Kind a
    a_kind    -> do let rep :: TypeRep
    rep = Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy a
    forall a. Proxy a
    Proxy :: Proxy a)
                            reps <- StateT (Map TypeRep Int32) Get (Map TypeRep Int32)
    forall (m :: * -> *) s. Monad m => StateT s m s
    State.get
                            v <- maybe (lift get) pure (Map.lookup rep reps)
                            case constructGetterFromVersion (unsafeCoerce v) a_kind of
                              Right Get a
    getter -> (Map TypeRep Int32 -> Map TypeRep Int32)
    -> StateT (Map TypeRep Int32) Get ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    State.modify (TypeRep -> Int32 -> Map TypeRep Int32 -> Map TypeRep Int32
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert TypeRep
    rep Int32
    v) StateT (Map TypeRep Int32) Get ()
    -> StateT (Map TypeRep Int32) Get (Get a)
    -> StateT (Map TypeRep Int32) Get (Get a)
    forall a b.
    StateT (Map TypeRep Int32) Get a
    -> StateT (Map TypeRep Int32) Get b
    -> StateT (Map TypeRep Int32) Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get a -> StateT (Map TypeRep Int32) Get (Get a)
    forall a. a -> StateT (Map TypeRep Int32) Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Get a
    getter
                              Left String
    msg     -> String -> StateT (Map TypeRep Int32) Get (Get a)
    forall a. String -> StateT (Map TypeRep Int32) Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    msg
        where proxy :: Proxy a
    proxy = Proxy a
    forall a. Proxy a
    Proxy :: Proxy a

    -- | This version returns (Put, Put), the collected version tags and
    -- the collected serialized fields.  The original 'getSafePut' result
    -- type prevents doing this because each fields may have a different
    -- type.  Maybe you can show me a better way
    getSafePutGeneric ::
      forall a. SafeCopy a
      => (a -> Contained Put)
      -> a
      -> RWST () [Put] (Set TypeRep) PutM ()
    getSafePutGeneric :: forall a.
    SafeCopy a =>
    (a -> Contained Put) -> a -> RWST () [Put] (Set TypeRep) PutM ()
    getSafePutGeneric a -> Contained Put
    cput a
    a
        = Proxy a
    -> RWST () [Put] (Set TypeRep) PutM ()
    -> RWST () [Put] (Set TypeRep) PutM ()
    forall a b. SafeCopy a => Proxy a -> b -> b
    unpureCheckConsistency Proxy a
    proxy (RWST () [Put] (Set TypeRep) PutM ()
     -> RWST () [Put] (Set TypeRep) PutM ())
    -> RWST () [Put] (Set TypeRep) PutM ()
    -> RWST () [Put] (Set TypeRep) PutM ()
    forall a b. (a -> b) -> a -> b
    $
          case Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    proxy of
            Kind a
    Primitive -> [Put] -> RWST () [Put] (Set TypeRep) PutM ()
    forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
    tell [Contained Put -> Put
    forall a. Contained a -> a
    unsafeUnPack (a -> Contained Put
    cput (a -> Contained Put) -> a -> Contained Put
    forall a b. (a -> b) -> a -> b
    $ a -> Proxy a -> a
    forall a. a -> Proxy a -> a
    asProxyType a
    a Proxy a
    proxy)]
            Kind a
    _         -> do reps <- RWST () [Put] (Set TypeRep) PutM (Set TypeRep)
    forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
    RWS.get
                            let typ = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a
                            when (not (member typ reps)) $ do
                              lift (put (versionFromProxy proxy))
                              RWS.modify (Set.insert typ)
                            tell [unsafeUnPack (cput $ asProxyType a proxy)]
        where proxy :: Proxy a
    proxy = Proxy a
    forall a. Proxy a
    Proxy :: Proxy a

    type GSafeCopy a = (SafeCopy a, Generic a, GPutCopy (Rep a) DatatypeInfo, Constructors a)

    -- | Generic only version of safePut. Instead of calling 'putCopy' it
    -- calls 'putCopyDefault', a copy of the implementation of the
    -- 'SafeCopy' default method for 'putCopy'.
    safePutGeneric :: forall a. GSafeCopy a => a -> Put
    safePutGeneric :: forall a. GSafeCopy a => a -> Put
    safePutGeneric a
    a = do
      putter <- ([Put] -> Put
    forall a. Monoid a => [a] -> a
    mconcat ([Put] -> Put) -> (((), [Put]) -> [Put]) -> ((), [Put]) -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((), [Put]) -> [Put]
    forall a b. (a, b) -> b
    snd) (((), [Put]) -> Put) -> PutM ((), [Put]) -> PutM Put
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RWST () [Put] (Set TypeRep) PutM ()
    -> () -> Set TypeRep -> PutM ((), [Put])
    forall (m :: * -> *) r w s a.
    Monad m =>
    RWST r w s m a -> r -> s -> m (a, w)
    evalRWST ((a -> Contained Put) -> a -> RWST () [Put] (Set TypeRep) PutM ()
    forall a.
    SafeCopy a =>
    (a -> Contained Put) -> a -> RWST () [Put] (Set TypeRep) PutM ()
    getSafePutGeneric a -> Contained Put
    forall a. GSafeCopy a => a -> Contained Put
    putCopyDefault a
    a) () Set TypeRep
    forall a. Monoid a => a
    mempty
      putter

    -- | See 'safePutGeneric'.  A copy of the code in the default
    -- implementation of the putCopy method.
    putCopyDefault :: forall a. GSafeCopy a => a -> Contained Put
    putCopyDefault :: forall a. GSafeCopy a => a -> Contained Put
    putCopyDefault a
    a = (Put -> Contained Put
    forall a. a -> Contained a
    contain (Put -> Contained Put) -> (a -> Put) -> a -> Contained Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DatatypeInfo -> Rep a DatatypeInfo -> Put
    forall (f :: * -> *) p. GPutCopy f p => p -> f p -> Put
    gputCopy (Word8 -> Word8 -> DatatypeInfo
    ConstructorInfo (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (forall a. Constructors a => Int
    gconNum @a)) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int
    forall a. Constructors a => a -> Int
    gconIndex a
    a))) (Rep a DatatypeInfo -> Put)
    -> (a -> Rep a DatatypeInfo) -> a -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rep a DatatypeInfo
    forall x. a -> Rep a x
    forall a x. Generic a => a -> Rep a x
    from) a
    a

    -- constructGetterFromVersion :: SafeCopy a => Version a -> Kind (MigrateFrom (Reverse a)) -> Get (Get a)
    constructGetterFromVersion :: SafeCopy a => Version a -> Kind a -> Either String (Get a)
    constructGetterFromVersion :: forall a.
    SafeCopy a =>
    Version a -> Kind a -> Either String (Get a)
    constructGetterFromVersion Version a
    diskVersion Kind a
    orig_kind =
      Bool -> Version a -> Kind a -> Either String (Get a)
    forall a.
    SafeCopy a =>
    Bool -> Version a -> Kind a -> Either String (Get a)
    worker Bool
    False Version a
    diskVersion Kind a
    orig_kind
      where
        worker :: forall a. SafeCopy a => Bool -> Version a -> Kind a -> Either String (Get a)
        worker :: forall a.
    SafeCopy a =>
    Bool -> Version a -> Kind a -> Either String (Get a)
    worker Bool
    fwd Version a
    thisVersion Kind a
    thisKind
          | Version a
    forall a. SafeCopy a => Version a
    version Version a -> Version a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version a
    thisVersion = Get a -> Either String (Get a)
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Get a -> Either String (Get a)) -> Get a -> Either String (Get a)
    forall a b. (a -> b) -> a -> b
    $ Contained (Get a) -> Get a
    forall a. Contained a -> a
    unsafeUnPack Contained (Get a)
    forall a. SafeCopy a => Contained (Get a)
    getCopy
          | Bool
    otherwise =
            case Kind a
    thisKind of
              Kind a
    Primitive -> String -> Either String (Get a)
    forall a b. a -> Either a b
    Left (String -> Either String (Get a))
    -> String -> Either String (Get a)
    forall a b. (a -> b) -> a -> b
    $ Kind a -> ShowS
    forall {a}. SafeCopy a => Kind a -> ShowS
    errorMsg Kind a
    thisKind String
    "Cannot migrate from primitive types."
              Kind a
    Base      -> String -> Either String (Get a)
    forall a b. a -> Either a b
    Left (String -> Either String (Get a))
    -> String -> Either String (Get a)
    forall a b. (a -> b) -> a -> b
    $ Kind a -> ShowS
    forall {a}. SafeCopy a => Kind a -> ShowS
    errorMsg Kind a
    thisKind String
    versionNotFound
              Extends Proxy (MigrateFrom a)
    b_proxy -> do
                previousGetter <- Bool
    -> Version (MigrateFrom a)
    -> Kind (MigrateFrom a)
    -> Either String (Get (MigrateFrom a))
    forall a.
    SafeCopy a =>
    Bool -> Version a -> Kind a -> Either String (Get a)
    worker Bool
    fwd (Version a -> Version (MigrateFrom a)
    forall a b. Version a -> Version b
    castVersion Version a
    diskVersion) (Proxy (MigrateFrom a) -> Kind (MigrateFrom a)
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy (MigrateFrom a)
    b_proxy)
                return $ fmap migrate previousGetter
              Extended{} | Bool
    fwd -> String -> Either String (Get a)
    forall a b. a -> Either a b
    Left (String -> Either String (Get a))
    -> String -> Either String (Get a)
    forall a b. (a -> b) -> a -> b
    $ Kind a -> ShowS
    forall {a}. SafeCopy a => Kind a -> ShowS
    errorMsg Kind a
    thisKind String
    versionNotFound
              Extended Kind a
    a_kind -> do
                let rev_proxy :: Proxy (MigrateFrom (Reverse a))
                    rev_proxy :: Proxy (MigrateFrom (Reverse a))
    rev_proxy = Proxy (MigrateFrom (Reverse a))
    forall a. Proxy a
    Proxy
                    forwardGetter :: Either String (Get a)
                    forwardGetter :: Either String (Get a)
    forwardGetter  = (Get (MigrateFrom (Reverse a)) -> Get a)
    -> Either String (Get (MigrateFrom (Reverse a)))
    -> Either String (Get a)
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((MigrateFrom (Reverse a) -> a)
    -> Get (MigrateFrom (Reverse a)) -> Get a
    forall a b. (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Reverse a -> a
    forall a. Reverse a -> a
    unReverse (Reverse a -> a)
    -> (MigrateFrom (Reverse a) -> Reverse a)
    -> MigrateFrom (Reverse a)
    -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MigrateFrom (Reverse a) -> Reverse a
    forall a. Migrate a => MigrateFrom a -> a
    migrate)) (Either String (Get (MigrateFrom (Reverse a)))
     -> Either String (Get a))
    -> Either String (Get (MigrateFrom (Reverse a)))
    -> Either String (Get a)
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Version (MigrateFrom (Reverse a))
    -> Kind (MigrateFrom (Reverse a))
    -> Either String (Get (MigrateFrom (Reverse a)))
    forall a.
    SafeCopy a =>
    Bool -> Version a -> Kind a -> Either String (Get a)
    worker Bool
    True (Version a -> Version (MigrateFrom (Reverse a))
    forall a b. Version a -> Version b
    castVersion Version a
    thisVersion) (Proxy (MigrateFrom (Reverse a)) -> Kind (MigrateFrom (Reverse a))
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy (MigrateFrom (Reverse a))
    rev_proxy)
                    previousGetter :: Either String (Get a)
                    previousGetter :: Either String (Get a)
    previousGetter = Bool -> Version a -> Kind a -> Either String (Get a)
    forall a.
    SafeCopy a =>
    Bool -> Version a -> Kind a -> Either String (Get a)
    worker Bool
    fwd (Version a -> Version a
    forall a b. Version a -> Version b
    castVersion Version a
    thisVersion) Kind a
    a_kind
                case Either String (Get a)
    forwardGetter of
                  Left{}    -> Either String (Get a)
    previousGetter
                  Right Get a
    val -> Get a -> Either String (Get a)
    forall a b. b -> Either a b
    Right Get a
    val
        versionNotFound :: String
    versionNotFound   = String
    "Cannot find getter associated with this version number: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Version a -> String
    forall a. Show a => a -> String
    show Version a
    diskVersion
        errorMsg :: Kind a -> ShowS
    errorMsg Kind a
    fail_kind String
    msg =
            [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
             [ String
    "safecopy: "
             , Proxy a -> String
    forall a. SafeCopy a => Proxy a -> String
    errorTypeName (Kind a -> Proxy a
    forall a. Kind a -> Proxy a
    proxyFromKind Kind a
    fail_kind)
             , String
    ": "
             , String
    msg
             ]

    -------------------------------------------------
    -- The public interface. These functions are used
    -- to parse/serialize and to create new parsers &
    -- serialisers.

    -- | Parse a version tagged data type and then migrate it to the desired type.
    --   Any serialized value has been extended by the return type can be parsed.
    safeGet :: SafeCopy a => Get a
    safeGet :: forall a. SafeCopy a => Get a
    safeGet
        = Get (Get a) -> Get a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join Get (Get a)
    forall a. SafeCopy a => Get (Get a)
    getSafeGet

    -- | Parse a version tag and return the corresponding migrated parser. This is
    --   useful when you can prove that multiple values have the same version.
    --   See 'getSafePut'.
    getSafeGet :: forall a. SafeCopy a => Get (Get a)
    getSafeGet :: forall a. SafeCopy a => Get (Get a)
    getSafeGet
        = Proxy a -> Get (Get a) -> Get (Get a)
    forall a (m :: * -> *) b.
    (SafeCopy a, MonadFail m) =>
    Proxy a -> m b -> m b
    checkConsistency Proxy a
    proxy (Get (Get a) -> Get (Get a)) -> Get (Get a) -> Get (Get a)
    forall a b. (a -> b) -> a -> b
    $
          case Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    proxy of
            Kind a
    Primitive -> Get a -> Get (Get a)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Get a -> Get (Get a)) -> Get a -> Get (Get a)
    forall a b. (a -> b) -> a -> b
    $ Contained (Get a) -> Get a
    forall a. Contained a -> a
    unsafeUnPack Contained (Get a)
    forall a. SafeCopy a => Contained (Get a)
    getCopy
            Kind a
    a_kind    -> do v <- Get (Version a)
    forall t. Serialize t => Get t
    get
                            case constructGetterFromVersion v a_kind of
                              Right Get a
    getter -> Get a -> Get (Get a)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Get a
    getter
                              Left String
    msg     -> String -> Get (Get a)
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    msg
        where proxy :: Proxy a
    proxy = Proxy a
    forall a. Proxy a
    Proxy :: Proxy a

    -- | Serialize a data type by first writing out its version tag. This is much
    --   simpler than the corresponding 'safeGet' since previous versions don't
    --   come into play.
    safePut :: SafeCopy a => a -> Put
    safePut :: forall a. SafeCopy a => a -> Put
    safePut a
    a
        = do putter <- PutM (a -> Put)
    forall a. SafeCopy a => PutM (a -> Put)
    getSafePut
             putter a

    -- | Serialize the version tag and return the associated putter. This is useful
    --   when serializing multiple values with the same version. See 'getSafeGet'.
    getSafePut :: forall a. SafeCopy a => PutM (a -> Put)
    getSafePut :: forall a. SafeCopy a => PutM (a -> Put)
    getSafePut
        = Proxy a -> PutM (a -> Put) -> PutM (a -> Put)
    forall a b. SafeCopy a => Proxy a -> b -> b
    unpureCheckConsistency Proxy a
    proxy (PutM (a -> Put) -> PutM (a -> Put))
    -> PutM (a -> Put) -> PutM (a -> Put)
    forall a b. (a -> b) -> a -> b
    $
          case Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    proxy of
            Kind a
    Primitive -> (a -> Put) -> PutM (a -> Put)
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a -> Put) -> PutM (a -> Put)) -> (a -> Put) -> PutM (a -> Put)
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> Contained Put -> Put
    forall a. Contained a -> a
    unsafeUnPack (a -> Contained Put
    forall a. SafeCopy a => a -> Contained Put
    putCopy (a -> Contained Put) -> a -> Contained Put
    forall a b. (a -> b) -> a -> b
    $ a -> Proxy a -> a
    forall a. a -> Proxy a -> a
    asProxyType a
    a Proxy a
    proxy)
            Kind a
    _         -> do Putter (Version a)
    forall t. Serialize t => Putter t
    put (Proxy a -> Version a
    forall a. SafeCopy a => Proxy a -> Version a
    versionFromProxy Proxy a
    proxy)
                            (a -> Put) -> PutM (a -> Put)
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a -> Put) -> PutM (a -> Put)) -> (a -> Put) -> PutM (a -> Put)
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> Contained Put -> Put
    forall a. Contained a -> a
    unsafeUnPack (a -> Contained Put
    forall a. SafeCopy a => a -> Contained Put
    putCopy (a -> Contained Put) -> a -> Contained Put
    forall a b. (a -> b) -> a -> b
    $ a -> Proxy a -> a
    forall a. a -> Proxy a -> a
    asProxyType a
    a Proxy a
    proxy)
        where proxy :: Proxy a
    proxy = Proxy a
    forall a. Proxy a
    Proxy :: Proxy a

    -- | The extended_extension kind lets the system know that there is
    --   at least one previous and one future version of this type.
    extended_extension :: (Migrate a, Migrate (Reverse a)) => Kind a
    extended_extension :: forall a. (Migrate a, Migrate (Reverse a)) => Kind a
    extended_extension = Kind a -> Kind a
    forall a. Migrate (Reverse a) => Kind a -> Kind a
    Extended Kind a
    forall a. Migrate a => Kind a
    extension

    -- | The extended_base kind lets the system know that there is
    --   at least one future version of this type.
    extended_base :: (Migrate (Reverse a)) => Kind a
    extended_base :: forall a. Migrate (Reverse a) => Kind a
    extended_base = Kind a -> Kind a
    forall a. Migrate (Reverse a) => Kind a -> Kind a
    Extended Kind a
    forall a. Kind a
    base

    -- | The extension kind lets the system know that there is
    --   at least one previous version of this type. A given data type
    --   can only extend a single other data type. However, it is
    --   perfectly fine to build chains of extensions. The migrations
    --   between each step is handled automatically.
    extension :: Migrate a => Kind a
    extension :: forall a. Migrate a => Kind a
    extension = Proxy (MigrateFrom a) -> Kind a
    forall a. Migrate a => Proxy (MigrateFrom a) -> Kind a
    Extends Proxy (MigrateFrom a)
    forall a. Proxy a
    Proxy

    -- | The default kind. Does not extend any type.
    base :: Kind a
    base :: forall a. Kind a
    base = Kind a
    forall a. Kind a
    Base

    -- | Primitive kinds aren't version tagged. This kind is used for small or built-in
    --   types that won't change such as 'Int' or 'Bool'.
    primitive :: Kind a
    primitive :: forall a. Kind a
    primitive = Kind a
    forall a. Kind a
    Primitive

    -------------------------------------------------
    -- Data type versions. Essentially just a unique
    -- identifier used to lookup the corresponding
    -- parser function.

    -- | A simple numeric version id.
    newtype Version a = Version {forall a. Version a -> Int32
    unVersion :: Int32} deriving (ReadPrec [Version a]
    ReadPrec (Version a)
    Int -> ReadS (Version a)
    ReadS [Version a]
    (Int -> ReadS (Version a))
    -> ReadS [Version a]
    -> ReadPrec (Version a)
    -> ReadPrec [Version a]
    -> Read (Version a)
    forall a. ReadPrec [Version a]
    forall a. ReadPrec (Version a)
    forall a. Int -> ReadS (Version a)
    forall a. ReadS [Version a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (Version a)
    readsPrec :: Int -> ReadS (Version a)
    $creadList :: forall a. ReadS [Version a]
    readList :: ReadS [Version a]
    $creadPrec :: forall a. ReadPrec (Version a)
    readPrec :: ReadPrec (Version a)
    $creadListPrec :: forall a. ReadPrec [Version a]
    readListPrec :: ReadPrec [Version a]
    Read,Int -> Version a -> ShowS
    [Version a] -> ShowS
    Version a -> String
    (Int -> Version a -> ShowS)
    -> (Version a -> String)
    -> ([Version a] -> ShowS)
    -> Show (Version a)
    forall a. Int -> Version a -> ShowS
    forall a. [Version a] -> ShowS
    forall a. Version a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> Version a -> ShowS
    showsPrec :: Int -> Version a -> ShowS
    $cshow :: forall a. Version a -> String
    show :: Version a -> String
    $cshowList :: forall a. [Version a] -> ShowS
    showList :: [Version a] -> ShowS
    Show,Version a -> Version a -> Bool
    (Version a -> Version a -> Bool)
    -> (Version a -> Version a -> Bool) -> Eq (Version a)
    forall a. Version a -> Version a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Version a -> Version a -> Bool
    == :: Version a -> Version a -> Bool
    $c/= :: forall a. Version a -> Version a -> Bool
    /= :: Version a -> Version a -> Bool
    Eq)

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

    instance Num (Version a) where
        Version Int32
    a + :: Version a -> Version a -> Version a
    + Version Int32
    b = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32
    aInt32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    +Int32
    b)
        Version Int32
    a - :: Version a -> Version a -> Version a
    - Version Int32
    b = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32
    aInt32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    -Int32
    b)
        Version Int32
    a * :: Version a -> Version a -> Version a
    * Version Int32
    b = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32
    aInt32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    *Int32
    b)
        negate :: Version a -> Version a
    negate (Version Int32
    a) = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32 -> Int32
    forall a. Num a => a -> a
    negate Int32
    a)
        abs :: Version a -> Version a
    abs (Version Int32
    a) = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    a)
        signum :: Version a -> Version a
    signum (Version Int32
    a) = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Int32 -> Int32
    forall a. Num a => a -> a
    signum Int32
    a)
        fromInteger :: Integer -> Version a
    fromInteger Integer
    i = Int32 -> Version a
    forall a. Int32 -> Version a
    Version (Integer -> Int32
    forall a. Num a => Integer -> a
    fromInteger Integer
    i)

    instance Serialize (Version a) where
        get :: Get (Version a)
    get = (Int32 -> Version a) -> Get Int32 -> Get (Version a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int32 -> Version a
    forall a. Int32 -> Version a
    Version Get Int32
    forall t. Serialize t => Get t
    get
        put :: Putter (Version a)
    put = Putter Int32
    forall t. Serialize t => Putter t
    put Putter Int32 -> (Version a -> Int32) -> Putter (Version a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Version a -> Int32
    forall a. Version a -> Int32
    unVersion

    -------------------------------------------------
    -- Container type to control the access to the
    -- parsers/putters.

    -- | To ensure that no-one reads or writes values without handling versions
    --   correctly, it is necessary to restrict access to 'getCopy' and 'putCopy'.
    --   This is where 'Contained' enters the picture. It allows you to put
    --   values in to a container but not to take them out again.
    newtype Contained a = Contained {forall a. Contained a -> a
    unsafeUnPack :: a}

    -- | Place a value in an unbreakable container.
    contain :: a -> Contained a
    contain :: forall a. a -> Contained a
    contain = a -> Contained a
    forall a. a -> Contained a
    Contained

    -------------------------------------------------
    -- Consistency checking

    data Profile a =
      PrimitiveProfile |
      InvalidProfile String |
      Profile
      { forall a. Profile a -> Int32
    profileCurrentVersion :: Int32
      , forall a. Profile a -> [Int32]
    profileSupportedVersions :: [Int32]
      } deriving (Int -> Profile a -> ShowS
    [Profile a] -> ShowS
    Profile a -> String
    (Int -> Profile a -> ShowS)
    -> (Profile a -> String)
    -> ([Profile a] -> ShowS)
    -> Show (Profile a)
    forall a. Int -> Profile a -> ShowS
    forall a. [Profile a] -> ShowS
    forall a. Profile a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> Profile a -> ShowS
    showsPrec :: Int -> Profile a -> ShowS
    $cshow :: forall a. Profile a -> String
    show :: Profile a -> String
    $cshowList :: forall a. [Profile a] -> ShowS
    showList :: [Profile a] -> ShowS
    Show)

    mkProfile :: SafeCopy a => Proxy a -> Profile a
    mkProfile :: forall a. SafeCopy a => Proxy a -> Profile a
    mkProfile Proxy a
    a_proxy =
      case Proxy a -> Consistency a
    forall a. SafeCopy a => Proxy a -> Consistency a
    computeConsistency Proxy a
    a_proxy of
        NotConsistent String
    msg -> String -> Profile a
    forall a. String -> Profile a
    InvalidProfile String
    msg
        Consistency a
    Consistent | Kind a -> Bool
    forall a. Kind a -> Bool
    isPrimitive (Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    a_proxy) -> Profile a
    forall a. Profile a
    PrimitiveProfile
        Consistency a
    Consistent ->
          Profile{ profileCurrentVersion :: Int32
    profileCurrentVersion    = Version a -> Int32
    forall a. Version a -> Int32
    unVersion (Proxy a -> Version a
    forall a. SafeCopy a => Proxy a -> Version a
    versionFromProxy Proxy a
    a_proxy)
                 , profileSupportedVersions :: [Int32]
    profileSupportedVersions = Proxy a -> [Int32]
    forall a. SafeCopy a => Proxy a -> [Int32]
    availableVersions Proxy a
    a_proxy
                 }

    data Consistency a = Consistent | NotConsistent String

    availableVersions :: SafeCopy a => Proxy a -> [Int32]
    availableVersions :: forall a. SafeCopy a => Proxy a -> [Int32]
    availableVersions Proxy a
    a_proxy =
      Bool -> Kind a -> [Int32]
    forall b. SafeCopy b => Bool -> Kind b -> [Int32]
    worker Bool
    True (Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    a_proxy)
      where
        worker :: SafeCopy b => Bool -> Kind b -> [Int32]
        worker :: forall b. SafeCopy b => Bool -> Kind b -> [Int32]
    worker Bool
    fwd Kind b
    b_kind =
          case Kind b
    b_kind of
            Kind b
    Primitive         -> []
            Kind b
    Base              -> [Version b -> Int32
    forall a. Version a -> Int32
    unVersion (Kind b -> Version b
    forall a. SafeCopy a => Kind a -> Version a
    versionFromKind Kind b
    b_kind)]
            Extends Proxy (MigrateFrom b)
    b_proxy   -> Version b -> Int32
    forall a. Version a -> Int32
    unVersion (Kind b -> Version b
    forall a. SafeCopy a => Kind a -> Version a
    versionFromKind Kind b
    b_kind) Int32 -> [Int32] -> [Int32]
    forall a. a -> [a] -> [a]
    : Bool -> Kind (MigrateFrom b) -> [Int32]
    forall b. SafeCopy b => Bool -> Kind b -> [Int32]
    worker Bool
    False (Proxy (MigrateFrom b) -> Kind (MigrateFrom b)
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy (MigrateFrom b)
    b_proxy)
            Extended Kind b
    sub_kind | Bool
    fwd  -> Bool -> Kind (MigrateFrom (Reverse b)) -> [Int32]
    forall b. SafeCopy b => Bool -> Kind b -> [Int32]
    worker Bool
    False (Kind b -> Kind (MigrateFrom (Reverse b))
    forall a.
    Migrate (Reverse a) =>
    Kind a -> Kind (MigrateFrom (Reverse a))
    getForwardKind Kind b
    sub_kind)
            Extended Kind b
    sub_kind -> Bool -> Kind b -> [Int32]
    forall b. SafeCopy b => Bool -> Kind b -> [Int32]
    worker Bool
    False Kind b
    sub_kind

    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
    _ = Kind (MigrateFrom (Reverse a))
    forall a. SafeCopy a => Kind a
    kind

    -- Extend chains must end in a Base kind. Ending in a Primitive is an error.
    validChain :: SafeCopy a => Proxy a -> Bool
    validChain :: forall a. SafeCopy a => Proxy a -> Bool
    validChain Proxy a
    a_proxy =
      Kind a -> Bool
    forall a. Kind a -> Bool
    worker (Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    a_proxy)
      where
        worker :: Kind a -> Bool
    worker Kind a
    Primitive         = Bool
    True
        worker Kind a
    Base              = Bool
    True
        worker (Extends Proxy (MigrateFrom a)
    b_proxy) = Kind (MigrateFrom a) -> Bool
    forall b. SafeCopy b => Kind b -> Bool
    check (Proxy (MigrateFrom a) -> Kind (MigrateFrom a)
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy (MigrateFrom a)
    b_proxy)
        worker (Extended Kind a
    a_kind)   = Kind a -> Bool
    worker Kind a
    a_kind
        check :: SafeCopy b => Kind b -> Bool
        check :: forall b. SafeCopy b => Kind b -> Bool
    check Kind b
    b_kind
                  = case Kind b
    b_kind of
                      Kind b
    Primitive       -> Bool
    False
                      Kind b
    Base            -> Bool
    True
                      Extends Proxy (MigrateFrom b)
    c_proxy -> Kind (MigrateFrom b) -> Bool
    forall b. SafeCopy b => Kind b -> Bool
    check (Proxy (MigrateFrom b) -> Kind (MigrateFrom b)
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy (MigrateFrom b)
    c_proxy)
                      Extended Kind b
    sub_kind   -> Kind b -> Bool
    forall b. SafeCopy b => Kind b -> Bool
    check Kind b
    sub_kind

    -- Verify that the SafeCopy instance is consistent.
    checkConsistency :: (SafeCopy a, Fail.MonadFail m) => Proxy a -> m b -> m b
    checkConsistency :: forall a (m :: * -> *) b.
    (SafeCopy a, MonadFail m) =>
    Proxy a -> m b -> m b
    checkConsistency Proxy a
    proxy m b
    ks
        = case Proxy a -> Consistency a
    forall a. SafeCopy a => Proxy a -> Consistency a
    consistentFromProxy Proxy a
    proxy of
            NotConsistent String
    msg -> String -> m b
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail String
    msg
            Consistency a
    Consistent        -> m b
    ks

    -- | PutM doesn't have reasonable 'fail' implementation.
    -- It just throws an unpure exception anyway.
    unpureCheckConsistency :: SafeCopy a => Proxy a -> b -> b
    unpureCheckConsistency :: forall a b. SafeCopy a => Proxy a -> b -> b
    unpureCheckConsistency Proxy a
    proxy b
    ks
        = case Proxy a -> Consistency a
    forall a. SafeCopy a => Proxy a -> Consistency a
    consistentFromProxy Proxy a
    proxy of
            NotConsistent String
    msg -> String -> b
    forall a. HasCallStack => String -> a
    error (String -> b) -> String -> b
    forall a b. (a -> b) -> a -> b
    $ String
    "unpureCheckConsistency: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg
            Consistency a
    Consistent        -> b
    ks

    {-# INLINE computeConsistency #-}
    computeConsistency :: forall a. SafeCopy a => Proxy a -> Consistency a
    computeConsistency :: forall a. SafeCopy a => Proxy a -> Consistency a
    computeConsistency Proxy a
    proxy
        -- Match a few common cases before falling through to the general case.
        -- This allows use to generate nearly all consistencies at compile-time.
        | Kind a -> Bool
    forall a. Kind a -> Bool
    isObviouslyConsistent (Proxy a -> Kind a
    forall a. SafeCopy a => Proxy a -> Kind a
    kindFromProxy Proxy a
    proxy)
        = Consistency a
    forall a. Consistency a
    Consistent
        | [Int32]
    versions [Int32] -> [Int32] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Int32] -> [Int32]
    forall a. Eq a => [a] -> [a]
    nub [Int32]
    versions
        = String -> Consistency a
    forall a. String -> Consistency a
    NotConsistent (String -> Consistency a) -> String -> Consistency a
    forall a b. (a -> b) -> a -> b
    $ String
    "Duplicate version tags for " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ TypeRep -> String
    forall a. Show a => a -> String
    show (Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall a. Proxy a
    Proxy @a)) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Int32] -> String
    forall a. Show a => a -> String
    show [Int32]
    versions
        | Bool -> Bool
    not (Proxy a -> Bool
    forall a. SafeCopy a => Proxy a -> Bool
    validChain Proxy a
    proxy)
        = String -> Consistency a
    forall a. String -> Consistency a
    NotConsistent String
    "Primitive types cannot be extended as they have no version tag."
        | Bool
    otherwise
        = Consistency a
    forall a. Consistency a
    Consistent
        where versions :: [Int32]
    versions = Proxy a -> [Int32]
    forall a. SafeCopy a => Proxy a -> [Int32]
    availableVersions Proxy a
    proxy

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

    -------------------------------------------------
    -- Small utility functions that mean we don't
    -- have to depend on ScopedTypeVariables.

    proxyFromConsistency :: Consistency a -> Proxy a
    proxyFromConsistency :: forall a. Consistency a -> Proxy a
    proxyFromConsistency Consistency a
    _ = Proxy a
    forall a. Proxy a
    Proxy

    proxyFromKind :: Kind a -> Proxy a
    proxyFromKind :: forall a. Kind a -> Proxy a
    proxyFromKind Kind a
    _ = Proxy a
    forall a. Proxy a
    Proxy

    consistentFromProxy :: SafeCopy a => Proxy a -> Consistency a
    consistentFromProxy :: forall a. SafeCopy a => Proxy a -> Consistency a
    consistentFromProxy Proxy a
    _ = Consistency a
    forall a. SafeCopy a => Consistency a
    internalConsistency

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

    versionFromKind :: (SafeCopy a) => Kind a -> Version a
    versionFromKind :: forall a. SafeCopy a => Kind a -> Version a
    versionFromKind Kind a
    _ = Version a
    forall a. SafeCopy a => Version a
    version

    versionFromReverseKind :: (SafeCopy (MigrateFrom (Reverse a))) => Kind a -> Version (MigrateFrom (Reverse a))
    versionFromReverseKind :: forall a.
    SafeCopy (MigrateFrom (Reverse a)) =>
    Kind a -> Version (MigrateFrom (Reverse a))
    versionFromReverseKind Kind a
    _ = Version (MigrateFrom (Reverse a))
    forall a. SafeCopy a => Version a
    version

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

    -------------------------------------------------
    -- Type proxies

    data Proxy a = Proxy

    mkProxy :: a -> Proxy a
    mkProxy :: forall a. a -> Proxy a
    mkProxy a
    _ = Proxy a
    forall a. Proxy a
    Proxy

    asProxyType :: a -> Proxy a -> a
    asProxyType :: forall a. a -> Proxy a -> a
    asProxyType a
    a Proxy a
    _ = a
    a