    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE EmptyCase #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}

    -- This module is not exposed. The reason that it is split out from
    -- "Data.Store.Internal" is to allow "Data.Store.TH" to refer to these
    -- identifiers. "Data.Store.Internal" must be separate from
    -- "Data.Store.TH" due to Template Haskell's stage restriction.
    module Data.Store.Impl where

    import           Control.Applicative
    import           Control.Exception (try)
    import           Control.Monad
    import qualified Data.ByteString as BS
    import           Data.Functor.Contravariant (Contravariant(..))
    import           Data.Proxy
    import           Data.Store.Core
    import           Data.Typeable (Typeable, typeRep)
    import           Data.Word
    import           Foreign.Storable (Storable, sizeOf)
    import           GHC.Exts (Constraint)
    import           GHC.Generics
    import           GHC.TypeLits
    import           Prelude
    import           System.IO.Unsafe (unsafePerformIO)

    ------------------------------------------------------------------------
    -- Store class

    -- TODO: write down more elaborate laws

    -- | The 'Store' typeclass provides efficient serialization and
    -- deserialization to raw pointer addresses.
    --
    -- The 'peek' and 'poke' methods should be defined such that
    -- @ decodeEx (encode x) == x @.
    class Store a where
        -- | Yields the 'Size' of the buffer, in bytes, required to store
        -- the encoded representation of the type.
        --
        -- Note that the correctness of this function is crucial for the
        -- safety of 'poke', as it does not do any bounds checking. It is
        -- the responsibility of the invoker of 'poke' ('encode' and similar
        -- functions) to ensure that there's enough space in the output
        -- buffer. If 'poke' writes beyond, then arbitrary memory can be
        -- overwritten, causing undefined behavior and segmentation faults.
        size :: Size a
        -- | Serializes a value to bytes. It is the responsibility of the
        -- caller to ensure that at least the number of bytes required by
        -- 'size' are available. These details are handled by 'encode' and
        -- similar utilities.
        poke :: a -> Poke ()
        -- | Serialized a value from bytes, throwing exceptions if it
        -- encounters invalid data or runs out of input bytes.
        peek :: Peek a

        default size :: (Generic a, GStoreSize (Rep a)) => Size a
        size = Size a
    forall a. (Generic a, GStoreSize (Rep a)) => Size a
    genericSize

        default poke :: (Generic a, GStorePoke (Rep a)) => a -> Poke ()
        poke = a -> Poke ()
    forall a. (Generic a, GStorePoke (Rep a)) => a -> Poke ()
    genericPoke

        default peek :: (Generic a , GStorePeek (Rep a)) => Peek a
        peek = Peek a
    forall a. (Generic a, GStorePeek (Rep a)) => Peek a
    genericPeek

        -- NB: Do not INLINE the default implementations of size, poke, or peek!
        -- Doing so can lead to enormous memory blowup (a maximum residency of
        -- 5.17 GB with GHC 8.0.2 has been observed). For more information, please
        -- read issue #91.

    ------------------------------------------------------------------------
    -- Utilities for encoding / decoding strict ByteStrings

    -- | Serializes a value to a 'BS.ByteString'. In order to do this, it
    -- first allocates a 'BS.ByteString' of the correct size (based on
    -- 'size'), and then uses 'poke' to fill it.
    --
    -- Safety of this function depends on correctness of the 'Store'
    -- instance. If 'size' returns a. The good news is that this isn't an
    -- issue if you use well-tested manual instances (such as those from
    -- this package) combined with auomatic definition of instances.
    encode :: Store a => a -> BS.ByteString
    encode :: a -> ByteString
    encode x :: a
    x = Poke () -> Int -> ByteString
    unsafeEncodeWith (a -> Poke ()
    forall a. Store a => a -> Poke ()
    poke a
    x) (a -> Int
    forall a. Store a => a -> Int
    getSize a
    x)

    -- | Decodes a value from a 'BS.ByteString'. Returns an exception if
    -- there's an error while decoding, or if decoding undershoots /
    -- overshoots the end of the buffer.
    decode :: Store a => BS.ByteString -> Either PeekException a
    decode :: ByteString -> Either PeekException a
    decode = IO (Either PeekException a) -> Either PeekException a
    forall a. IO a -> a
    unsafePerformIO (IO (Either PeekException a) -> Either PeekException a)
    -> (ByteString -> IO (Either PeekException a))
    -> ByteString
    -> Either PeekException a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> IO (Either PeekException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO (Either PeekException a))
    -> (ByteString -> IO a)
    -> ByteString
    -> IO (Either PeekException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> IO a
    forall a. Store a => ByteString -> IO a
    decodeIO

    -- | Decodes a value from a 'BS.ByteString', potentially throwing
    -- exceptions. It is an exception to not consume all input.
    decodeEx :: Store a => BS.ByteString -> a
    decodeEx :: ByteString -> a
    decodeEx = IO a -> a
    forall a. IO a -> a
    unsafePerformIO (IO a -> a) -> (ByteString -> IO a) -> ByteString -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> IO a
    forall a. Store a => ByteString -> IO a
    decodeIO

    -- | Decodes a value from a 'BS.ByteString', potentially throwing
    -- exceptions. It is an exception to not consume all input.
    decodeIO :: Store a => BS.ByteString -> IO a
    decodeIO :: ByteString -> IO a
    decodeIO = Peek a -> ByteString -> IO a
    forall a. Peek a -> ByteString -> IO a
    decodeIOWith Peek a
    forall a. Store a => Peek a
    peek

    ------------------------------------------------------------------------
    -- Size

    -- | Info about a type's serialized length. Either the length is known
    -- independently of the value, or the length depends on the value.
    data Size a
        = VarSize (a -> Int)
        | ConstSize !Int
        deriving Typeable

    instance Contravariant Size where
      contramap :: (a -> b) -> Size b -> Size a
    contramap f :: a -> b
    f sz :: Size b
    sz = case Size b
    sz of
        ConstSize n :: Int
    n -> Int -> Size a
    forall a. Int -> Size a
    ConstSize Int
    n
        VarSize g :: b -> Int
    g -> (a -> Int) -> Size a
    forall a. (a -> Int) -> Size a
    VarSize (\x :: a
    x -> b -> Int
    g (a -> b
    f a
    x))

    -- | Get the number of bytes needed to store the given value. See
    -- 'size'.
    getSize :: Store a => a -> Int
    getSize :: a -> Int
    getSize = Size a -> a -> Int
    forall a. Size a -> a -> Int
    getSizeWith Size a
    forall a. Store a => Size a
    size
    {-# INLINE getSize #-}

    -- | Given a 'Size' value and a value of the type @a@, returns its 'Int'
    -- size.
    getSizeWith :: Size a -> a -> Int
    getSizeWith :: Size a -> a -> Int
    getSizeWith (VarSize f :: a -> Int
    f) x :: a
    x = a -> Int
    f a
    x
    getSizeWith (ConstSize n :: Int
    n) _ = Int
    n
    {-# INLINE getSizeWith #-}

    -- | Create an aggregate 'Size' by providing functions to split the
    -- input into two pieces.
    --
    -- If both of the types are 'ConstSize', the result is 'ConstSize' and
    -- the functions will not be used.
    combineSize :: forall a b c. (Store a, Store b) => (c -> a) -> (c -> b) -> Size c
    combineSize :: (c -> a) -> (c -> b) -> Size c
    combineSize toA :: c -> a
    toA toB :: c -> b
    toB = (c -> a) -> (c -> b) -> Size a -> Size b -> Size c
    forall a b c. (c -> a) -> (c -> b) -> Size a -> Size b -> Size c
    combineSizeWith c -> a
    toA c -> b
    toB Size a
    forall a. Store a => Size a
    size Size b
    forall a. Store a => Size a
    size
    {-# INLINE combineSize #-}

    -- | Create an aggregate 'Size' by providing functions to split the
    -- input into two pieces, as well as 'Size' values to use to measure the
    -- results.
    --
    -- If both of the input 'Size' values are 'ConstSize', the result is
    -- 'ConstSize' and the functions will not be used.
    combineSizeWith :: forall a b c. (c -> a) -> (c -> b) -> Size a -> Size b -> Size c
    combineSizeWith :: (c -> a) -> (c -> b) -> Size a -> Size b -> Size c
    combineSizeWith toA :: c -> a
    toA toB :: c -> b
    toB sizeA :: Size a
    sizeA sizeB :: Size b
    sizeB =
        case (Size a
    sizeA, Size b
    sizeB) of
            (VarSize f :: a -> Int
    f, VarSize g :: b -> Int
    g) -> (c -> Int) -> Size c
    forall a. (a -> Int) -> Size a
    VarSize (\x :: c
    x -> a -> Int
    f (c -> a
    toA c
    x) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + b -> Int
    g (c -> b
    toB c
    x))
            (VarSize f :: a -> Int
    f, ConstSize m :: Int
    m) -> (c -> Int) -> Size c
    forall a. (a -> Int) -> Size a
    VarSize (\x :: c
    x -> a -> Int
    f (c -> a
    toA c
    x) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m)
            (ConstSize n :: Int
    n, VarSize g :: b -> Int
    g) -> (c -> Int) -> Size c
    forall a. (a -> Int) -> Size a
    VarSize (\x :: c
    x -> Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + b -> Int
    g (c -> b
    toB c
    x))
            (ConstSize n :: Int
    n, ConstSize m :: Int
    m) -> Int -> Size c
    forall a. Int -> Size a
    ConstSize (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m)
    {-# INLINE combineSizeWith #-}

    -- | Adds a constant amount to a 'Size' value.
    addSize :: Int -> Size a -> Size a
    addSize :: Int -> Size a -> Size a
    addSize x :: Int
    x (ConstSize n :: Int
    n) = Int -> Size a
    forall a. Int -> Size a
    ConstSize (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)
    addSize x :: Int
    x (VarSize f :: a -> Int
    f) = (a -> Int) -> Size a
    forall a. (a -> Int) -> Size a
    VarSize ((Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +) (Int -> Int) -> (a -> Int) -> a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Int
    f)
    {-# INLINE addSize #-}

    -- | A 'size' implementation based on an instance of 'Storable' and
    -- 'Typeable'.
    sizeStorable :: forall a. (Storable a, Typeable a) => Size a
    sizeStorable :: Size a
    sizeStorable = String -> Size a
    forall a. Storable a => String -> Size a
    sizeStorableTy (TypeRep -> String
    forall a. Show a => a -> String
    show (Proxy a -> TypeRep
    forall k (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy a
    forall k (t :: k). Proxy t
    Proxy :: Proxy a)))
    {-# INLINE sizeStorable #-}

    -- | A 'size' implementation based on an instance of 'Storable'. Use this
    -- if the type is not 'Typeable'.
    sizeStorableTy :: forall a. Storable a => String -> Size a
    sizeStorableTy :: String -> Size a
    sizeStorableTy ty :: String
    ty = Int -> Size a
    forall a. Int -> Size a
    ConstSize (a -> Int
    forall a. Storable a => a -> Int
    sizeOf (String -> a
    forall a. HasCallStack => String -> a
    error String
    msg :: a))
      where
        msg :: String
    msg = "In Data.Store.storableSize: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ty String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'s sizeOf evaluated its argument."
    {-# INLINE sizeStorableTy #-}

    ------------------------------------------------------------------------
    -- Generics

    genericSize :: (Generic a, GStoreSize (Rep a)) => Size a
    genericSize :: Size a
    genericSize = (a -> Rep a Any) -> Size (Rep a Any) -> Size a
    forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
    contramap a -> Rep a Any
    forall a x. Generic a => a -> Rep a x
    from Size (Rep a Any)
    forall (f :: * -> *) a. GStoreSize f => Size (f a)
    gsize
    {-# INLINE genericSize #-}

    genericPoke :: (Generic a, GStorePoke (Rep a)) => a -> Poke ()
    genericPoke :: a -> Poke ()
    genericPoke = Rep a Any -> Poke ()
    forall (f :: * -> *) a. GStorePoke f => f a -> Poke ()
    gpoke (Rep a Any -> Poke ()) -> (a -> Rep a Any) -> a -> Poke ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rep a Any
    forall a x. Generic a => a -> Rep a x
    from
    {-# INLINE genericPoke #-}

    genericPeek :: (Generic a , GStorePeek (Rep a)) => Peek a
    genericPeek :: Peek a
    genericPeek = Rep a Any -> a
    forall a x. Generic a => Rep a x -> a
    to (Rep a Any -> a) -> Peek (Rep a Any) -> Peek a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Peek (Rep a Any)
    forall (f :: * -> *) a. GStorePeek f => Peek (f a)
    gpeek
    {-# INLINE genericPeek #-}

    type family SumArity (a :: * -> *) :: Nat where
        SumArity (C1 c a) = 1
        SumArity (x :+: y) = SumArity x + SumArity y

    -- This could be just one typeclass, but currently compile times are
    -- better with things split up.
    -- https://github.com/bos/aeson/pull/335
    --

    class GStoreSize f where gsize :: Size (f a)
    class GStorePoke f where gpoke :: f a -> Poke ()
    class GStorePeek f where gpeek :: Peek (f a)

    instance GStoreSize f => GStoreSize (M1 i c f) where
        gsize :: Size (M1 i c f a)
    gsize = (M1 i c f a -> f a) -> Size (f a) -> Size (M1 i c f a)
    forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
    contramap M1 i c f a -> f a
    forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
    unM1 Size (f a)
    forall (f :: * -> *) a. GStoreSize f => Size (f a)
    gsize
        {-# INLINE gsize #-}
    instance GStorePoke f => GStorePoke (M1 i c f) where
        gpoke :: M1 i c f a -> Poke ()
    gpoke = f a -> Poke ()
    forall (f :: * -> *) a. GStorePoke f => f a -> Poke ()
    gpoke (f a -> Poke ()) -> (M1 i c f a -> f a) -> M1 i c f a -> Poke ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . M1 i c f a -> f a
    forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
    unM1
        {-# INLINE gpoke #-}
    instance GStorePeek f => GStorePeek (M1 i c f) where
        gpeek :: Peek (M1 i c f a)
    gpeek = (f a -> M1 i c f a) -> Peek (f a) -> Peek (M1 i c f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f a -> M1 i c f a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 Peek (f a)
    forall (f :: * -> *) a. GStorePeek f => Peek (f a)
    gpeek
        {-# INLINE gpeek #-}

    instance Store a => GStoreSize (K1 i a) where
        gsize :: Size (K1 i a a)
    gsize = (K1 i a a -> a) -> Size a -> Size (K1 i a a)
    forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
    contramap K1 i a a -> a
    forall i c k (p :: k). K1 i c p -> c
    unK1 Size a
    forall a. Store a => Size a
    size
        {-# INLINE gsize #-}
    instance Store a => GStorePoke (K1 i a) where
        gpoke :: K1 i a a -> Poke ()
    gpoke = a -> Poke ()
    forall a. Store a => a -> Poke ()
    poke (a -> Poke ()) -> (K1 i a a -> a) -> K1 i a a -> Poke ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . K1 i a a -> a
    forall i c k (p :: k). K1 i c p -> c
    unK1
        {-# INLINE gpoke #-}
    instance Store a => GStorePeek (K1 i a) where
        gpeek :: Peek (K1 i a a)
    gpeek = (a -> K1 i a a) -> Peek a -> Peek (K1 i a a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> K1 i a a
    forall k i c (p :: k). c -> K1 i c p
    K1 Peek a
    forall a. Store a => Peek a
    peek
        {-# INLINE gpeek #-}

    instance GStoreSize U1 where
        gsize :: Size (U1 a)
    gsize = Int -> Size (U1 a)
    forall a. Int -> Size a
    ConstSize 0
        {-# INLINE gsize #-}
    instance GStorePoke U1 where
        gpoke :: U1 a -> Poke ()
    gpoke _ = () -> Poke ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        {-# INLINE gpoke #-}
    instance GStorePeek U1 where
        gpeek :: Peek (U1 a)
    gpeek = U1 a -> Peek (U1 a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return U1 a
    forall k (p :: k). U1 p
    U1
        {-# INLINE gpeek #-}

    instance GStoreSize V1 where
        gsize :: Size (V1 a)
    gsize = Int -> Size (V1 a)
    forall a. Int -> Size a
    ConstSize 0
        {-# INLINE gsize #-}
    instance GStorePoke V1 where
        gpoke :: V1 a -> Poke ()
    gpoke x :: V1 a
    x = case V1 a
    x of {}
        {-# INLINE gpoke #-}
    instance GStorePeek V1 where
        gpeek :: Peek (V1 a)
    gpeek = Peek (V1 a)
    forall a. HasCallStack => a
    undefined
        {-# INLINE gpeek #-}

    instance (GStoreSize a, GStoreSize b) => GStoreSize (a :*: b) where
        gsize :: Size ((:*:) a b a)
    gsize = ((:*:) a b a -> a a)
    -> ((:*:) a b a -> b a)
    -> Size (a a)
    -> Size (b a)
    -> Size ((:*:) a b a)
    forall a b c. (c -> a) -> (c -> b) -> Size a -> Size b -> Size c
    combineSizeWith (\(x :: a a
    x :*: _) -> a a
    x) (\(_ :*: y :: b a
    y) -> b a
    y) Size (a a)
    forall (f :: * -> *) a. GStoreSize f => Size (f a)
    gsize Size (b a)
    forall (f :: * -> *) a. GStoreSize f => Size (f a)
    gsize
        {-# INLINE gsize #-}
    instance (GStorePoke a, GStorePoke b) => GStorePoke (a :*: b) where
        gpoke :: (:*:) a b a -> Poke ()
    gpoke (a :: a a
    a :*: b :: b a
    b) = a a -> Poke ()
    forall (f :: * -> *) a. GStorePoke f => f a -> Poke ()
    gpoke a a
    a Poke () -> Poke () -> Poke ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> b a -> Poke ()
    forall (f :: * -> *) a. GStorePoke f => f a -> Poke ()
    gpoke b a
    b
        {-# INLINE gpoke #-}
    instance (GStorePeek a, GStorePeek b) => GStorePeek (a :*: b) where
        gpeek :: Peek ((:*:) a b a)
    gpeek = a a -> b a -> (:*:) a b a
    forall k (f :: k -> *) (g :: k -> *) (p :: k).
    f p -> g p -> (:*:) f g p
    (:*:) (a a -> b a -> (:*:) a b a)
    -> Peek (a a) -> Peek (b a -> (:*:) a b a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Peek (a a)
    forall (f :: * -> *) a. GStorePeek f => Peek (f a)
    gpeek Peek (b a -> (:*:) a b a) -> Peek (b a) -> Peek ((:*:) a b a)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Peek (b a)
    forall (f :: * -> *) a. GStorePeek f => Peek (f a)
    gpeek
        {-# INLINE gpeek #-}

    -- The machinery for sum types is why UndecidableInstances is necessary.

    -- FIXME: check that this type level stuff dosen't get turned into
    -- costly runtime computation

    instance (FitsInByte (SumArity (a :+: b)), GStoreSizeSum 0 (a :+: b))
             => GStoreSize (a :+: b) where
        gsize :: Size ((:+:) a b a)
    gsize = ((:+:) a b a -> Int) -> Size ((:+:) a b a)
    forall a. (a -> Int) -> Size a
    VarSize (((:+:) a b a -> Int) -> Size ((:+:) a b a))
    -> ((:+:) a b a -> Int) -> Size ((:+:) a b a)
    forall a b. (a -> b) -> a -> b
    $ \x :: (:+:) a b a
    x -> Word8 -> Int
    forall a. Storable a => a -> Int
    sizeOf (Word8
    forall a. HasCallStack => a
    undefined :: Word8) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (:+:) a b a -> Proxy 0 -> Int
    forall (n :: Nat) (f :: * -> *) a.
    GStoreSizeSum n f =>
    f a -> Proxy n -> Int
    gsizeSum (:+:) a b a
    x (Proxy 0
    forall k (t :: k). Proxy t
    Proxy :: Proxy 0)
        {-# INLINE gsize #-}
    instance (FitsInByte (SumArity (a :+: b)), GStorePokeSum 0 (a :+: b))
             => GStorePoke (a :+: b) where
        gpoke :: (:+:) a b a -> Poke ()
    gpoke x :: (:+:) a b a
    x = (:+:) a b a -> Proxy 0 -> Poke ()
    forall (n :: Nat) (f :: * -> *) p.
    GStorePokeSum n f =>
    f p -> Proxy n -> Poke ()
    gpokeSum (:+:) a b a
    x (Proxy 0
    forall k (t :: k). Proxy t
    Proxy :: Proxy 0)
        {-# INLINE gpoke #-}
    instance (FitsInByte (SumArity (a :+: b)), GStorePeekSum 0 (a :+: b))
             => GStorePeek (a :+: b) where
        gpeek :: Peek ((:+:) a b a)
    gpeek = do
            Word8
    tag <- Peek Word8
    forall a. (Storable a, Typeable a) => Peek a
    peekStorable
            Word8 -> Proxy 0 -> Peek ((:+:) a b a)
    forall (n :: Nat) (f :: * -> *) p.
    GStorePeekSum n f =>
    Word8 -> Proxy n -> Peek (f p)
    gpeekSum Word8
    tag (Proxy 0
    forall k (t :: k). Proxy t
    Proxy :: Proxy 0)
        {-# INLINE gpeek #-}

    -- See https://github.com/fpco/store/issues/141 - this constraint type
    -- family machinery improves error messages for generic deriving on
    -- sum types with many constructors.

    type FitsInByte n = FitsInByteResult (n <=? 255)

    type family FitsInByteResult (b :: Bool) :: Constraint where
        FitsInByteResult 'True = ()
        FitsInByteResult 'False = TypeErrorMessage
            "Generic deriving of Store instances can only be used on datatypes with fewer than 256 constructors."

    type family TypeErrorMessage (a :: Symbol) :: Constraint where
    #if MIN_VERSION_base(4,9,0)
        TypeErrorMessage a = TypeError ('Text a)
    -- GHC < 8.0 does not support empty closed type families
    #elif __GLASGOW_HASKELL__ < 800
        TypeErrorMessage a = a ~ ""
    #endif

    -- Similarly to splitting up the generic class into multiple classes, we
    -- also split up the one for sum types.

    class KnownNat n => GStoreSizeSum (n :: Nat) (f :: * -> *) where gsizeSum :: f a -> Proxy n -> Int
    class KnownNat n => GStorePokeSum (n :: Nat) (f :: * -> *) where gpokeSum :: f p -> Proxy n -> Poke ()
    class KnownNat n => GStorePeekSum (n :: Nat) (f :: * -> *) where gpeekSum :: Word8 -> Proxy n -> Peek (f p)

    instance (GStoreSizeSum n a, GStoreSizeSum (n + SumArity a) b, KnownNat n)
             => GStoreSizeSum n (a :+: b) where
        gsizeSum :: (:+:) a b a -> Proxy n -> Int
    gsizeSum (L1 l :: a a
    l) _ = a a -> Proxy n -> Int
    forall (n :: Nat) (f :: * -> *) a.
    GStoreSizeSum n f =>
    f a -> Proxy n -> Int
    gsizeSum a a
    l (Proxy n
    forall k (t :: k). Proxy t
    Proxy :: Proxy n)
        gsizeSum (R1 r :: b a
    r) _ = b a -> Proxy (n + SumArity a) -> Int
    forall (n :: Nat) (f :: * -> *) a.
    GStoreSizeSum n f =>
    f a -> Proxy n -> Int
    gsizeSum b a
    r (Proxy (n + SumArity a)
    forall k (t :: k). Proxy t
    Proxy :: Proxy (n + SumArity a))
        {-# INLINE gsizeSum #-}
    instance (GStorePokeSum n a, GStorePokeSum (n + SumArity a) b, KnownNat n)
             => GStorePokeSum n (a :+: b) where
        gpokeSum :: (:+:) a b p -> Proxy n -> Poke ()
    gpokeSum (L1 l :: a p
    l) _ = a p -> Proxy n -> Poke ()
    forall (n :: Nat) (f :: * -> *) p.
    GStorePokeSum n f =>
    f p -> Proxy n -> Poke ()
    gpokeSum a p
    l (Proxy n
    forall k (t :: k). Proxy t
    Proxy :: Proxy n)
        gpokeSum (R1 r :: b p
    r) _ = b p -> Proxy (n + SumArity a) -> Poke ()
    forall (n :: Nat) (f :: * -> *) p.
    GStorePokeSum n f =>
    f p -> Proxy n -> Poke ()
    gpokeSum b p
    r (Proxy (n + SumArity a)
    forall k (t :: k). Proxy t
    Proxy :: Proxy (n + SumArity a))
        {-# INLINE gpokeSum #-}
    instance (GStorePeekSum n a, GStorePeekSum (n + SumArity a) b, KnownNat n)
             => GStorePeekSum n (a :+: b) where
        gpeekSum :: Word8 -> Proxy n -> Peek ((:+:) a b p)
    gpeekSum tag :: Word8
    tag proxyL :: Proxy n
    proxyL
            | Word8
    tag Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    sizeL = a p -> (:+:) a b p
    forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
    L1 (a p -> (:+:) a b p) -> Peek (a p) -> Peek ((:+:) a b p)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word8 -> Proxy n -> Peek (a p)
    forall (n :: Nat) (f :: * -> *) p.
    GStorePeekSum n f =>
    Word8 -> Proxy n -> Peek (f p)
    gpeekSum Word8
    tag Proxy n
    proxyL
            | Bool
    otherwise = b p -> (:+:) a b p
    forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
    R1 (b p -> (:+:) a b p) -> Peek (b p) -> Peek ((:+:) a b p)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word8 -> Proxy (n + SumArity a) -> Peek (b p)
    forall (n :: Nat) (f :: * -> *) p.
    GStorePeekSum n f =>
    Word8 -> Proxy n -> Peek (f p)
    gpeekSum Word8
    tag (Proxy (n + SumArity a)
    forall k (t :: k). Proxy t
    Proxy :: Proxy (n + SumArity a))
          where
            sizeL :: Word8
    sizeL = Integer -> Word8
    forall a. Num a => Integer -> a
    fromInteger (Proxy (n + SumArity a) -> Integer
    forall (n :: Nat) (proxy :: Nat -> *).
    KnownNat n =>
    proxy n -> Integer
    natVal (Proxy (n + SumArity a)
    forall k (t :: k). Proxy t
    Proxy :: Proxy (n + SumArity a)))
        {-# INLINE gpeekSum #-}

    instance (GStoreSize a, KnownNat n) => GStoreSizeSum n (C1 c a) where
        gsizeSum :: C1 c a a -> Proxy n -> Int
    gsizeSum x :: C1 c a a
    x _ = Size (C1 c a a) -> C1 c a a -> Int
    forall a. Size a -> a -> Int
    getSizeWith Size (C1 c a a)
    forall (f :: * -> *) a. GStoreSize f => Size (f a)
    gsize C1 c a a
    x
        {-# INLINE gsizeSum #-}
    instance (GStorePoke a, KnownNat n) => GStorePokeSum n (C1 c a) where
        gpokeSum :: C1 c a p -> Proxy n -> Poke ()
    gpokeSum x :: C1 c a p
    x _ = do
            Word8 -> Poke ()
    forall a. Storable a => a -> Poke ()
    pokeStorable (Integer -> Word8
    forall a. Num a => Integer -> a
    fromInteger (Proxy n -> Integer
    forall (n :: Nat) (proxy :: Nat -> *).
    KnownNat n =>
    proxy n -> Integer
    natVal (Proxy n
    forall k (t :: k). Proxy t
    Proxy :: Proxy n)) :: Word8)
            C1 c a p -> Poke ()
    forall (f :: * -> *) a. GStorePoke f => f a -> Poke ()
    gpoke C1 c a p
    x
        {-# INLINE gpokeSum #-}
    instance (GStorePeek a, KnownNat n) => GStorePeekSum n (C1 c a) where
        gpeekSum :: Word8 -> Proxy n -> Peek (C1 c a p)
    gpeekSum tag :: Word8
    tag _
            | Word8
    tag Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    cur = Peek (C1 c a p)
    forall (f :: * -> *) a. GStorePeek f => Peek (f a)
    gpeek
            | Word8
    tag Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    cur = Text -> Peek (C1 c a p)
    forall a. Text -> Peek a
    peekException "Sum tag invalid"
            | Bool
    otherwise = Text -> Peek (C1 c a p)
    forall a. Text -> Peek a
    peekException "Error in implementation of Store Generics"
          where
            cur :: Word8
    cur = Integer -> Word8
    forall a. Num a => Integer -> a
    fromInteger (Proxy n -> Integer
    forall (n :: Nat) (proxy :: Nat -> *).
    KnownNat n =>
    proxy n -> Integer
    natVal (Proxy n
    forall k (t :: k). Proxy t
    Proxy :: Proxy n))
        {-# INLINE gpeekSum #-}