{-# 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 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 a -> b
f Size b
sz = case Size b
sz of
    ConstSize Int
n -> Int -> Size a
forall a. Int -> Size a
ConstSize Int
n
    VarSize b -> Int
g -> (a -> Int) -> Size a
forall a. (a -> Int) -> Size a
VarSize (\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 a -> Int
f) a
x = a -> Int
f a
x
getSizeWith (ConstSize Int
n) a
_ = 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 c -> a
toA 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 c -> a
toA c -> b
toB Size a
sizeA Size b
sizeB =
    case (Size a
sizeA, Size b
sizeB) of
        (VarSize a -> Int
f, VarSize b -> Int
g) -> (c -> Int) -> Size c
forall a. (a -> Int) -> Size a
VarSize (\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 a -> Int
f, ConstSize Int
m) -> (c -> Int) -> Size c
forall a. (a -> Int) -> Size a
VarSize (\c
x -> a -> Int
f (c -> a
toA c
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
        (ConstSize Int
n, VarSize b -> Int
g) -> (c -> Int) -> Size c
forall a. (a -> Int) -> Size a
VarSize (\c
x -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
g (c -> b
toB c
x))
        (ConstSize Int
n, ConstSize 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 Int
x (ConstSize 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 Int
x (VarSize 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 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 = String
"In Data.Store.storableSize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'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 Int
0
    {-# INLINE gsize #-}
instance GStorePoke U1 where
    gpoke :: U1 a -> Poke ()
gpoke U1 a
_ = () -> 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 Int
0
    {-# INLINE gsize #-}
instance GStorePoke V1 where
    gpoke :: V1 a -> Poke ()
gpoke 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 (\(a a
x :*: b a
_) -> a a
x) (\(a a
_ :*: 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 :*: 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
$ \(:+:) 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 (:+:) 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 a a
l) Proxy n
_ = 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 b a
r) Proxy n
_ = 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 a p
l) Proxy n
_ = 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 b p
r) Proxy n
_ = 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 Word8
tag 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 C1 c a a
x Proxy n
_ = 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 C1 c a p
x Proxy n
_ = 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 Word8
tag Proxy n
_
        | 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 Text
"Sum tag invalid"
        | Bool
otherwise = Text -> Peek (C1 c a p)
forall a. Text -> Peek a
peekException Text
"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 #-}