    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE UnboxedTuples #-}

    module Data.Store.Core
        ( -- * Core Types
          Poke(..), PokeException(..), pokeException
        , Peek(..), PeekResult(..), PeekException(..), peekException, tooManyBytes
        , PokeState, pokeStatePtr
        , PeekState, peekStateEndPtr
        , Offset
          -- * Encode ByteString
        , unsafeEncodeWith
          -- * Decode ByteString
        , decodeWith
        , decodeExWith, decodeExPortionWith
        , decodeIOWith, decodeIOPortionWith
        , decodeIOWithFromPtr, decodeIOPortionWithFromPtr
          -- * Storable
        , pokeStorable, peekStorable, peekStorableTy
          -- * ForeignPtr
        , pokeFromForeignPtr, peekToPlainForeignPtr, pokeFromPtr
          -- * ByteArray
        , pokeFromByteArray, peekToByteArray
          -- * Creation of PokeState / PeekState
        , unsafeMakePokeState, unsafeMakePeekState, maybeAlignmentBufferSize
        ) where

    import           Control.Applicative
    import           Control.Exception (Exception(..), throwIO, try)
    import           Control.Monad (when)
    import           Control.Monad.IO.Class (MonadIO(..))
    import           Control.Monad.Primitive (PrimMonad (..))
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString.Internal as BS
    import           Data.Monoid ((<>))
    import           Data.Primitive.ByteArray (ByteArray, MutableByteArray(..), newByteArray, unsafeFreezeByteArray)
    import qualified Data.Text as T
    import           Data.Typeable
    import           Data.Word
    import           Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr)
    import           Foreign.Ptr
    import           Foreign.Storable as Storable
    import           GHC.Exts (unsafeCoerce#)
    import           GHC.Prim (RealWorld, ByteArray#, copyByteArrayToAddr#, copyAddrToByteArray#)
    import           GHC.Ptr (Ptr(..))
    import           GHC.Types (IO(..), Int(..))
    import           Prelude
    import           System.IO.Unsafe (unsafePerformIO)

    #if MIN_VERSION_base(4,9,0)
    import qualified Control.Monad.Fail as Fail
    #endif

    #if ALIGNED_MEMORY
    import           Foreign.Marshal.Alloc (allocaBytesAligned)
    #endif

    ------------------------------------------------------------------------
    -- Helpful Type Synonyms

    -- | How far into the given Ptr to look
    type Offset = Int

    ------------------------------------------------------------------------
    -- Poke monad

    -- | 'Poke' actions are useful for building sequential serializers.
    --
    -- They are actions which write values to bytes into memory specified by
    -- a 'Ptr' base. The 'Applicative' and 'Monad' instances make it easy to
    -- write serializations, by keeping track of the 'Offset' of the current
    -- byte. They allow you to chain 'Poke' action such that subsequent
    -- 'Poke's write into subsequent portions of the output.
    newtype Poke a = Poke
        { forall a. Poke a -> PokeState -> Offset -> IO (Offset, a)
    runPoke :: PokeState -> Offset -> IO (Offset, a)
          -- ^ Run the 'Poke' action, with the 'Ptr' to the buffer where
          -- data is poked, and the current 'Offset'. The result is the new
          -- offset, along with a return value.
          --
          -- May throw a 'PokeException', though this should be avoided when
          -- possible.  They usually indicate a programming error.
        }
        deriving (forall a b. (a -> b) -> Poke a -> Poke b)
    -> (forall a b. a -> Poke b -> Poke a) -> Functor Poke
    forall a b. a -> Poke b -> Poke a
    forall a b. (a -> b) -> Poke a -> Poke b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Poke a -> Poke b
    fmap :: forall a b. (a -> b) -> Poke a -> Poke b
    $c<$ :: forall a b. a -> Poke b -> Poke a
    <$ :: forall a b. a -> Poke b -> Poke a
    Functor

    instance Applicative Poke where
        pure :: forall a. a -> Poke a
    pure a
    x = (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, a)) -> Poke a)
    -> (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    _ptr Offset
    offset -> (Offset, a) -> IO (Offset, a)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Offset
    offset, a
    x)
        {-# INLINE pure #-}
        Poke PokeState -> Offset -> IO (Offset, a -> b)
    f <*> :: forall a b. Poke (a -> b) -> Poke a -> Poke b
    <*> Poke PokeState -> Offset -> IO (Offset, a)
    g = (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, b)) -> Poke b)
    -> (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    ptr Offset
    offset1 -> do
            (offset2, f') <- PokeState -> Offset -> IO (Offset, a -> b)
    f PokeState
    ptr Offset
    offset1
            (offset3, g') <- g ptr offset2
            return (offset3, f' g')
        {-# INLINE (<*>) #-}
        Poke PokeState -> Offset -> IO (Offset, a)
    f *> :: forall a b. Poke a -> Poke b -> Poke b
    *> Poke PokeState -> Offset -> IO (Offset, b)
    g = (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, b)) -> Poke b)
    -> (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    ptr Offset
    offset1 -> do
            (offset2, _) <- PokeState -> Offset -> IO (Offset, a)
    f PokeState
    ptr Offset
    offset1
            g ptr offset2
        {-# INLINE (*>) #-}

    instance Monad Poke where
        return :: forall a. a -> Poke a
    return = a -> Poke a
    forall a. a -> Poke a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        {-# INLINE return #-}
        >> :: forall a b. Poke a -> Poke b -> Poke b
    (>>) = Poke a -> Poke b -> Poke b
    forall a b. Poke a -> Poke b -> Poke b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)
        {-# INLINE (>>) #-}
        Poke PokeState -> Offset -> IO (Offset, a)
    x >>= :: forall a b. Poke a -> (a -> Poke b) -> Poke b
    >>= a -> Poke b
    f = (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, b)) -> Poke b)
    -> (PokeState -> Offset -> IO (Offset, b)) -> Poke b
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    ptr Offset
    offset1 -> do
            (offset2, x') <- PokeState -> Offset -> IO (Offset, a)
    x PokeState
    ptr Offset
    offset1
            runPoke (f x') ptr offset2
        {-# INLINE (>>=) #-}
    #if !(MIN_VERSION_base(4,13,0))
        fail = pokeException . T.pack
        {-# INLINE fail #-}
    #endif

    #if MIN_VERSION_base(4,9,0)
    instance Fail.MonadFail Poke where
        fail :: forall a. [Char] -> Poke a
    fail = Text -> Poke a
    forall a. Text -> Poke a
    pokeException (Text -> Poke a) -> ([Char] -> Text) -> [Char] -> Poke a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack
        {-# INLINE fail #-}
    #endif

    instance MonadIO Poke where
        liftIO :: forall a. IO a -> Poke a
    liftIO IO a
    f = (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, a)) -> Poke a)
    -> (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    _ Offset
    offset -> (Offset
    offset, ) (a -> (Offset, a)) -> IO a -> IO (Offset, a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    f
        {-# INLINE liftIO #-}

    -- | Holds a 'pokeStatePtr', which is passed in to each 'Poke' action.
    -- If the package is built with the 'force-alignment' flag, this also
    -- has a hidden 'Ptr' field, which is used as scratch space during
    -- unaligned writes.
    #if ALIGNED_MEMORY
    data PokeState = PokeState
        { pokeStatePtr :: {-# UNPACK #-} !(Ptr Word8)
        , pokeStateAlignPtr :: {-# UNPACK #-} !(Ptr Word8)
        }
    #else
    newtype PokeState = PokeState
        { PokeState -> Ptr Word8
    pokeStatePtr :: Ptr Word8
        }
    #endif

    -- | Make a 'PokeState' from a buffer pointer.
    --
    -- The first argument is a pointer to the memory to write to. The second
    -- argument is an IO action which is invoked if the store-core package
    -- was built with the @force-alignment@ flag. The action should yield a
    -- pointer to scratch memory as large as 'maybeAlignmentBufferSize'.
    --
    -- Since 0.4.2
    unsafeMakePokeState :: Ptr Word8 -- ^ pokeStatePtr
                        -> IO (Ptr Word8) -- ^ action to produce pokeStateAlignPtr
                        -> IO PokeState
    #if ALIGNED_MEMORY
    unsafeMakePokeState ptr f = PokeState ptr <$> f
    #else
    unsafeMakePokeState :: Ptr Word8 -> IO (Ptr Word8) -> IO PokeState
    unsafeMakePokeState Ptr Word8
    ptr IO (Ptr Word8)
    _ = PokeState -> IO PokeState
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PokeState -> IO PokeState) -> PokeState -> IO PokeState
    forall a b. (a -> b) -> a -> b
    $ Ptr Word8 -> PokeState
    PokeState Ptr Word8
    ptr
    #endif

    -- | Exception thrown while running 'poke'. Note that other types of
    -- exceptions could also be thrown. Invocations of 'fail' in the 'Poke'
    -- monad causes this exception to be thrown.
    --
    -- 'PokeException's are not expected to occur in ordinary circumstances,
    -- and usually indicate a programming error.
    data PokeException = PokeException
        { PokeException -> Offset
    pokeExByteIndex :: Offset
        , PokeException -> Text
    pokeExMessage :: T.Text
        }
        deriving (PokeException -> PokeException -> Bool
    (PokeException -> PokeException -> Bool)
    -> (PokeException -> PokeException -> Bool) -> Eq PokeException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PokeException -> PokeException -> Bool
    == :: PokeException -> PokeException -> Bool
    $c/= :: PokeException -> PokeException -> Bool
    /= :: PokeException -> PokeException -> Bool
    Eq, Offset -> PokeException -> ShowS
    [PokeException] -> ShowS
    PokeException -> [Char]
    (Offset -> PokeException -> ShowS)
    -> (PokeException -> [Char])
    -> ([PokeException] -> ShowS)
    -> Show PokeException
    forall a.
    (Offset -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Offset -> PokeException -> ShowS
    showsPrec :: Offset -> PokeException -> ShowS
    $cshow :: PokeException -> [Char]
    show :: PokeException -> [Char]
    $cshowList :: [PokeException] -> ShowS
    showList :: [PokeException] -> ShowS
    Show, Typeable)

    instance Exception PokeException where
    #if MIN_VERSION_base(4,8,0)
        displayException :: PokeException -> [Char]
    displayException (PokeException Offset
    offset Text
    msg) =
            [Char]
    "Exception while poking, at byte index " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    offset [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    " : " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Text -> [Char]
    T.unpack Text
    msg
    #endif

    -- | Throws a 'PokeException'. These should be avoided when possible,
    -- they usually indicate a programming error.
    pokeException :: T.Text -> Poke a
    pokeException :: forall a. Text -> Poke a
    pokeException Text
    msg = (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, a)) -> Poke a)
    -> (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    _ Offset
    off -> PokeException -> IO (Offset, a)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (Offset -> Text -> PokeException
    PokeException Offset
    off Text
    msg)

    ------------------------------------------------------------------------
    -- Peek monad

    -- | 'Peek' actions are useful for building sequential deserializers.
    --
    -- They are actions which read from memory and construct values from it.
    -- The 'Applicative' and 'Monad' instances make it easy to chain these
    -- together to get more complicated deserializers. This machinery keeps
    -- track of the current 'Ptr' and end-of-buffer 'Ptr'.
    newtype Peek a = Peek
        { forall a. Peek a -> PeekState -> Ptr Word8 -> IO (PeekResult a)
    runPeek :: PeekState -> Ptr Word8 -> IO (PeekResult a)
          -- ^ Run the 'Peek' action, with a 'Ptr' to the end of the buffer
          -- where data is poked, and a 'Ptr' to the current position. The
          -- result is the 'Ptr', along with a return value.
          --
          -- May throw a 'PeekException' if the memory contains invalid
          -- values.
        } deriving ((forall a b. (a -> b) -> Peek a -> Peek b)
    -> (forall a b. a -> Peek b -> Peek a) -> Functor Peek
    forall a b. a -> Peek b -> Peek a
    forall a b. (a -> b) -> Peek a -> Peek b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Peek a -> Peek b
    fmap :: forall a b. (a -> b) -> Peek a -> Peek b
    $c<$ :: forall a b. a -> Peek b -> Peek a
    <$ :: forall a b. a -> Peek b -> Peek a
    Functor)

    -- | A result of a 'Peek' action containing the current 'Ptr' and a return value.
    data PeekResult a = PeekResult {-# UNPACK #-} !(Ptr Word8) !a
        deriving ((forall a b. (a -> b) -> PeekResult a -> PeekResult b)
    -> (forall a b. a -> PeekResult b -> PeekResult a)
    -> Functor PeekResult
    forall a b. a -> PeekResult b -> PeekResult a
    forall a b. (a -> b) -> PeekResult a -> PeekResult b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> PeekResult a -> PeekResult b
    fmap :: forall a b. (a -> b) -> PeekResult a -> PeekResult b
    $c<$ :: forall a b. a -> PeekResult b -> PeekResult a
    <$ :: forall a b. a -> PeekResult b -> PeekResult a
    Functor)

    instance Applicative Peek where
        pure :: forall a. a -> Peek a
    pure a
    x = (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek (\PeekState
    _ Ptr Word8
    ptr -> PeekResult a -> IO (PeekResult a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PeekResult a -> IO (PeekResult a))
    -> PeekResult a -> IO (PeekResult a)
    forall a b. (a -> b) -> a -> b
    $ Ptr Word8 -> a -> PeekResult a
    forall a. Ptr Word8 -> a -> PeekResult a
    PeekResult Ptr Word8
    ptr a
    x)
        {-# INLINE pure #-}
        Peek PeekState -> Ptr Word8 -> IO (PeekResult (a -> b))
    f <*> :: forall a b. Peek (a -> b) -> Peek a -> Peek b
    <*> Peek PeekState -> Ptr Word8 -> IO (PeekResult a)
    g = (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    end Ptr Word8
    ptr1 -> do
            PeekResult ptr2 f' <- PeekState -> Ptr Word8 -> IO (PeekResult (a -> b))
    f PeekState
    end Ptr Word8
    ptr1
            PeekResult ptr3 g' <- g end ptr2
            return $ PeekResult ptr3 (f' g')
        {-# INLINE (<*>) #-}
        Peek PeekState -> Ptr Word8 -> IO (PeekResult a)
    f *> :: forall a b. Peek a -> Peek b -> Peek b
    *> Peek PeekState -> Ptr Word8 -> IO (PeekResult b)
    g = (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    end Ptr Word8
    ptr1 -> do
            PeekResult ptr2 _ <- PeekState -> Ptr Word8 -> IO (PeekResult a)
    f PeekState
    end Ptr Word8
    ptr1
            g end ptr2
        {-# INLINE (*>) #-}

    instance Monad Peek where
        return :: forall a. a -> Peek a
    return = a -> Peek a
    forall a. a -> Peek a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        {-# INLINE return #-}
        >> :: forall a b. Peek a -> Peek b -> Peek b
    (>>) = Peek a -> Peek b -> Peek b
    forall a b. Peek a -> Peek b -> Peek b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)
        {-# INLINE (>>) #-}
        Peek PeekState -> Ptr Word8 -> IO (PeekResult a)
    x >>= :: forall a b. Peek a -> (a -> Peek b) -> Peek b
    >>= a -> Peek b
    f = (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult b)) -> Peek b
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    end Ptr Word8
    ptr1 -> do
            PeekResult ptr2 x' <- PeekState -> Ptr Word8 -> IO (PeekResult a)
    x PeekState
    end Ptr Word8
    ptr1
            runPeek (f x') end ptr2
        {-# INLINE (>>=) #-}
    #if !(MIN_VERSION_base(4,13,0))
        fail = peekException . T.pack
        {-# INLINE fail #-}
    #endif

    #if MIN_VERSION_base(4,9,0)
    instance Fail.MonadFail Peek where
        fail :: forall a. [Char] -> Peek a
    fail = Text -> Peek a
    forall a. Text -> Peek a
    peekException (Text -> Peek a) -> ([Char] -> Text) -> [Char] -> Peek a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack
        {-# INLINE fail #-}
    #endif

    instance PrimMonad Peek where
        type PrimState Peek = RealWorld
        primitive :: forall a.
    (State# (PrimState Peek) -> (# State# (PrimState Peek), a #))
    -> Peek a
    primitive State# (PrimState Peek) -> (# State# (PrimState Peek), a #)
    action = (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    _ Ptr Word8
    ptr -> do
            x <- (State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
    forall a.
    (State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
    forall (m :: * -> *) a.
    PrimMonad m =>
    (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
    primitive ((State# RealWorld -> (# State# RealWorld, a #))
    -> State# RealWorld -> (# State# RealWorld, a #)
    forall a b. a -> b
    unsafeCoerce# State# RealWorld -> (# State# RealWorld, a #)
    State# (PrimState Peek) -> (# State# (PrimState Peek), a #)
    action)
            return $ PeekResult ptr x
        {-# INLINE primitive #-}

    instance MonadIO Peek where
        liftIO :: forall a. IO a -> Peek a
    liftIO IO a
    f = (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    _ Ptr Word8
    ptr -> Ptr Word8 -> a -> PeekResult a
    forall a. Ptr Word8 -> a -> PeekResult a
    PeekResult Ptr Word8
    ptr (a -> PeekResult a) -> IO a -> IO (PeekResult a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    f
        {-# INLINE liftIO #-}

    -- | Holds a 'peekStatePtr', which is passed in to each 'Peek' action.
    -- If the package is built with the 'force-alignment' flag, this also
    -- has a hidden 'Ptr' field, which is used as scratch space during
    -- unaligned reads.
    #if ALIGNED_MEMORY
    data PeekState = PeekState
        { peekStateEndPtr :: {-# UNPACK #-} !(Ptr Word8)
        , peekStateAlignPtr :: {-# UNPACK #-} !(Ptr Word8)
        }
    #else
    newtype PeekState = PeekState
        { PeekState -> Ptr Word8
    peekStateEndPtr :: Ptr Word8 }
    #endif

    -- | Make a 'PeekState' from a buffer pointer.
    --
    -- The first argument is a pointer to the memory to write to. The second
    -- argument is an IO action which is invoked if the store-core package
    -- was built with the @force-alignment@ flag. The action should yield a
    -- pointer to scratch memory as large as 'maybeAlignmentBufferSize'.
    --
    -- Since 0.4.2
    unsafeMakePeekState :: Ptr Word8 -- ^ peekStateEndPtr
                        -> IO (Ptr Word8) -- ^ action to produce peekStateAlignPtr
                        -> IO PeekState
    #if ALIGNED_MEMORY
    unsafeMakePeekState ptr f = PeekState ptr <$> f
    #else
    unsafeMakePeekState :: Ptr Word8 -> IO (Ptr Word8) -> IO PeekState
    unsafeMakePeekState Ptr Word8
    ptr IO (Ptr Word8)
    _ = PeekState -> IO PeekState
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PeekState -> IO PeekState) -> PeekState -> IO PeekState
    forall a b. (a -> b) -> a -> b
    $ Ptr Word8 -> PeekState
    PeekState Ptr Word8
    ptr
    #endif

    -- | Exception thrown while running 'peek'. Note that other types of
    -- exceptions can also be thrown. Invocations of 'fail' in the 'Poke'
    -- monad causes this exception to be thrown.
    --
    -- 'PeekException' is thrown when the data being decoded is invalid.
    data PeekException = PeekException
        { PeekException -> Offset
    peekExBytesFromEnd :: Offset
        , PeekException -> Text
    peekExMessage :: T.Text
        } deriving (PeekException -> PeekException -> Bool
    (PeekException -> PeekException -> Bool)
    -> (PeekException -> PeekException -> Bool) -> Eq PeekException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PeekException -> PeekException -> Bool
    == :: PeekException -> PeekException -> Bool
    $c/= :: PeekException -> PeekException -> Bool
    /= :: PeekException -> PeekException -> Bool
    Eq, Offset -> PeekException -> ShowS
    [PeekException] -> ShowS
    PeekException -> [Char]
    (Offset -> PeekException -> ShowS)
    -> (PeekException -> [Char])
    -> ([PeekException] -> ShowS)
    -> Show PeekException
    forall a.
    (Offset -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Offset -> PeekException -> ShowS
    showsPrec :: Offset -> PeekException -> ShowS
    $cshow :: PeekException -> [Char]
    show :: PeekException -> [Char]
    $cshowList :: [PeekException] -> ShowS
    showList :: [PeekException] -> ShowS
    Show, Typeable)

    instance Exception PeekException where
    #if MIN_VERSION_base(4,8,0)
        displayException :: PeekException -> [Char]
    displayException (PeekException Offset
    offset Text
    msg) =
            [Char]
    "Exception while peeking, " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    offset [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    " bytes from end: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Text -> [Char]
    T.unpack Text
    msg
    #endif

    -- | Throws a 'PeekException'.
    peekException :: T.Text -> Peek a
    peekException :: forall a. Text -> Peek a
    peekException Text
    msg = (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    ps Ptr Word8
    ptr -> PeekException -> IO (PeekResult a)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (Offset -> Text -> PeekException
    PeekException (PeekState -> Ptr Word8
    peekStateEndPtr PeekState
    ps Ptr Word8 -> Ptr Word8 -> Offset
    forall a b. Ptr a -> Ptr b -> Offset
    `minusPtr` Ptr Word8
    ptr) Text
    msg)

    -- | Throws a 'PeekException' about an attempt to read too many bytes.
    tooManyBytes :: Int -> Int -> String -> IO void
    tooManyBytes :: forall void. Offset -> Offset -> [Char] -> IO void
    tooManyBytes Offset
    needed Offset
    remaining [Char]
    ty =
        PeekException -> IO void
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (PeekException -> IO void) -> PeekException -> IO void
    forall a b. (a -> b) -> a -> b
    $ Offset -> Text -> PeekException
    PeekException Offset
    remaining (Text -> PeekException) -> Text -> PeekException
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "Attempted to read too many bytes for " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    ty [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    ". Needed " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    needed [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", but only " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    remaining [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " remain."

    -- | Throws a 'PeekException' about an attempt to read a negative number of bytes.
    --
    -- This can happen when we read invalid data -- the length tag is
    -- basically random in this case.
    negativeBytes :: Int -> Int -> String -> IO void
    negativeBytes :: forall void. Offset -> Offset -> [Char] -> IO void
    negativeBytes Offset
    needed Offset
    remaining [Char]
    ty =
        PeekException -> IO void
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (PeekException -> IO void) -> PeekException -> IO void
    forall a b. (a -> b) -> a -> b
    $ Offset -> Text -> PeekException
    PeekException Offset
    remaining (Text -> PeekException) -> Text -> PeekException
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "Attempted to read negative number of bytes for " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    ty [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    ". Tried to read " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    needed [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ".  This probably means that we're trying to read invalid data."

    ------------------------------------------------------------------------
    -- Decoding and encoding ByteStrings

    -- | Given a 'Poke' and its length, uses it to fill a 'ByteString'
    --
    -- This function is unsafe because the provided length must exactly
    -- match the number of bytes used by the 'Poke'. It will throw
    -- 'PokeException' errors when the buffer is under or overshot. However,
    -- in the case of overshooting the buffer, memory corruption and
    -- segfaults may occur.
    unsafeEncodeWith :: Poke () -> Int -> ByteString
    unsafeEncodeWith :: Poke () -> Offset -> ByteString
    unsafeEncodeWith Poke ()
    f Offset
    l =
        Offset -> (Ptr Word8 -> IO ()) -> ByteString
    BS.unsafeCreate Offset
    l ((Ptr Word8 -> IO ()) -> ByteString)
    -> (Ptr Word8 -> IO ()) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do
    #if ALIGNED_MEMORY
        allocaBytesAligned alignBufferSize 8 $ \aptr -> do
    #endif
            let ps :: PokeState
    ps = PokeState
                    { pokeStatePtr :: Ptr Word8
    pokeStatePtr = Ptr Word8
    ptr
    #if ALIGNED_MEMORY
                    , pokeStateAlignPtr = aptr
    #endif
                    }
            (o, ()) <- Poke () -> PokeState -> Offset -> IO (Offset, ())
    forall a. Poke a -> PokeState -> Offset -> IO (Offset, a)
    runPoke Poke ()
    f PokeState
    ps Offset
    0
            checkOffset o l

    #if ALIGNED_MEMORY
    alignBufferSize :: Int
    alignBufferSize = 32
    #endif

    -- | If store-core is built with the @force-alignment@ flag, then this
    -- will be a 'Just' value indicating the amount of memory that is
    -- expected in the alignment buffer used by 'PeekState' and 'PokeState'.
    -- Currently this will either be @Just 32@ or @Nothing@.
    maybeAlignmentBufferSize :: Maybe Int
    maybeAlignmentBufferSize :: Maybe Offset
    maybeAlignmentBufferSize =
    #if ALIGNED_MEMORY
      Just alignBufferSize
    #else
      Maybe Offset
    forall a. Maybe a
    Nothing
    #endif

    -- | Checks if the offset matches the expected length, and throw a
    -- 'PokeException' otherwise.
    checkOffset :: Int -> Int -> IO ()
    checkOffset :: Offset -> Offset -> IO ()
    checkOffset Offset
    o Offset
    l
        | Offset
    o Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    > Offset
    l = PokeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (PokeException -> IO ()) -> PokeException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Offset -> Text -> PokeException
    PokeException Offset
    o (Text -> PokeException) -> Text -> PokeException
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "encode overshot end of " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    l [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
            [Char]
    " byte long buffer"
        | Offset
    o Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    < Offset
    l = PokeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (PokeException -> IO ()) -> PokeException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Offset -> Text -> PokeException
    PokeException Offset
    o (Text -> PokeException) -> Text -> PokeException
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "encode undershot end of " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
            Offset -> [Char]
    forall a. Show a => a -> [Char]
    show Offset
    l [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
            [Char]
    " byte long buffer"
        | Bool
    otherwise = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Decodes a value from a 'ByteString', potentially throwing
    -- exceptions, and taking a 'Peek' to run. It is an exception to not
    -- consume all input.
    decodeWith :: Peek a -> ByteString -> Either PeekException a
    decodeWith :: forall a. Peek a -> ByteString -> Either PeekException a
    decodeWith Peek a
    mypeek = 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
    . Peek a -> ByteString -> IO a
    forall a. Peek a -> ByteString -> IO a
    decodeIOWith Peek a
    mypeek

    -- | Decodes a value from a 'ByteString', potentially throwing
    -- exceptions, and taking a 'Peek' to run. It is an exception to not
    -- consume all input.
    decodeExWith :: Peek a -> ByteString -> a
    decodeExWith :: forall a. Peek a -> ByteString -> a
    decodeExWith Peek a
    f = 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
    . Peek a -> ByteString -> IO a
    forall a. Peek a -> ByteString -> IO a
    decodeIOWith Peek a
    f

    -- | Similar to 'decodeExWith', but it allows there to be more of the
    -- buffer remaining. The 'Offset' of the buffer contents immediately
    -- after the decoded value is returned.
    decodeExPortionWith :: Peek a -> ByteString -> (Offset, a)
    decodeExPortionWith :: forall a. Peek a -> ByteString -> (Offset, a)
    decodeExPortionWith Peek a
    f = IO (Offset, a) -> (Offset, a)
    forall a. IO a -> a
    unsafePerformIO (IO (Offset, a) -> (Offset, a))
    -> (ByteString -> IO (Offset, a)) -> ByteString -> (Offset, a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Peek a -> ByteString -> IO (Offset, a)
    forall a. Peek a -> ByteString -> IO (Offset, a)
    decodeIOPortionWith Peek a
    f

    -- | Decodes a value from a 'ByteString', potentially throwing
    -- exceptions, and taking a 'Peek' to run. It is an exception to not
    -- consume all input.
    decodeIOWith :: Peek a -> ByteString -> IO a
    decodeIOWith :: forall a. Peek a -> ByteString -> IO a
    decodeIOWith Peek a
    mypeek (BS.PS ForeignPtr Word8
    x Offset
    s Offset
    len) =
        ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    x ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr0 ->
            let ptr :: Ptr Word8
    ptr = Ptr Word8
    ptr0 Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    s
            in Peek a -> Ptr Word8 -> Offset -> IO a
    forall a. Peek a -> Ptr Word8 -> Offset -> IO a
    decodeIOWithFromPtr Peek a
    mypeek Ptr Word8
    ptr Offset
    len

    -- | Similar to 'decodeExPortionWith', but runs in the 'IO' monad.
    decodeIOPortionWith :: Peek a -> ByteString -> IO (Offset, a)
    decodeIOPortionWith :: forall a. Peek a -> ByteString -> IO (Offset, a)
    decodeIOPortionWith Peek a
    mypeek (BS.PS ForeignPtr Word8
    x Offset
    s Offset
    len) =
        ForeignPtr Word8 -> (Ptr Word8 -> IO (Offset, a)) -> IO (Offset, a)
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    x ((Ptr Word8 -> IO (Offset, a)) -> IO (Offset, a))
    -> (Ptr Word8 -> IO (Offset, a)) -> IO (Offset, a)
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr0 ->
            let ptr :: Ptr Word8
    ptr = Ptr Word8
    ptr0 Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    s
            in Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
    forall a. Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
    decodeIOPortionWithFromPtr Peek a
    mypeek Ptr Word8
    ptr Offset
    len

    -- | Like 'decodeIOWith', but using 'Ptr' and length instead of a
    -- 'ByteString'.
    decodeIOWithFromPtr :: Peek a -> Ptr Word8 -> Int -> IO a
    decodeIOWithFromPtr :: forall a. Peek a -> Ptr Word8 -> Offset -> IO a
    decodeIOWithFromPtr Peek a
    mypeek Ptr Word8
    ptr Offset
    len = do
        (offset, x) <- Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
    forall a. Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
    decodeIOPortionWithFromPtr Peek a
    mypeek Ptr Word8
    ptr Offset
    len
        if len /= offset
           then throwIO $ PeekException (len - offset) "Didn't consume all input."
           else return x

    -- | Like 'decodeIOPortionWith', but using 'Ptr' and length instead of a 'ByteString'.
    decodeIOPortionWithFromPtr :: Peek a -> Ptr Word8 -> Int -> IO (Offset, a)
    decodeIOPortionWithFromPtr :: forall a. Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
    decodeIOPortionWithFromPtr Peek a
    mypeek Ptr Word8
    ptr Offset
    len =
        let end :: Ptr Word8
    end = Ptr Word8
    ptr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    len
            remaining :: Offset
    remaining = Ptr Word8
    end Ptr Word8 -> Ptr Word8 -> Offset
    forall a b. Ptr a -> Ptr b -> Offset
    `minusPtr` Ptr Word8
    ptr
        in do PeekResult ptr2 x' <-
    #if ALIGNED_MEMORY
                  allocaBytesAligned alignBufferSize 8 $ \aptr -> do
                      runPeek mypeek (PeekState end aptr) ptr
    #else
                  Peek a -> PeekState -> Ptr Word8 -> IO (PeekResult a)
    forall a. Peek a -> PeekState -> Ptr Word8 -> IO (PeekResult a)
    runPeek Peek a
    mypeek (Ptr Word8 -> PeekState
    PeekState Ptr Word8
    end) Ptr Word8
    ptr
    #endif
              if len > remaining -- Do not perform the check on the new pointer, since it could have overflowed
                  then throwIO $ PeekException (end `minusPtr` ptr2) "Overshot end of buffer"
                  else return (ptr2 `minusPtr` ptr, x')

    ------------------------------------------------------------------------
    -- Utilities for defining 'Store' instances based on 'Storable'

    -- | A 'poke' implementation based on an instance of 'Storable'.
    pokeStorable :: Storable a => a -> Poke ()
    pokeStorable :: forall a. Storable a => a -> Poke ()
    pokeStorable a
    x = (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, ())) -> Poke ())
    -> (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    ps Offset
    offset -> do
        let targetPtr :: Ptr a
    targetPtr = PokeState -> Ptr Word8
    pokeStatePtr PokeState
    ps Ptr Word8 -> Offset -> Ptr a
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    offset
    #if ALIGNED_MEMORY
        -- If necessary, poke into the scratch buffer, and copy the results
        -- to the output buffer.
        let bufStart = pokeStateAlignPtr ps
            alignStart = alignPtr (pokeStateAlignPtr ps) (alignment x)
            sz = sizeOf x
        if targetPtr == alignPtr targetPtr (alignment x)
            -- If we luck out and the output is already aligned, just poke it
            -- directly.
            then poke targetPtr x
            else (if (alignStart `plusPtr` sz) < (bufStart `plusPtr` alignBufferSize)
                then do
                    poke (castPtr alignStart) x
                    BS.memcpy (castPtr targetPtr) alignStart sz
                else do
                    allocaBytesAligned sz (alignment x) $ \tempPtr -> do
                        poke tempPtr x
                        BS.memcpy (castPtr targetPtr) (castPtr tempPtr) sz)
    #else
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr a
    targetPtr a
    x
    #endif
        let !newOffset :: Offset
    newOffset = Offset
    offset Offset -> Offset -> Offset
    forall a. Num a => a -> a -> a
    + a -> Offset
    forall a. Storable a => a -> Offset
    sizeOf a
    x
        (Offset, ()) -> IO (Offset, ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Offset
    newOffset, ())
    {-# INLINE pokeStorable #-}

    -- | A 'peek' implementation based on an instance of 'Storable' and
    -- 'Typeable'.
    peekStorable :: forall a. (Storable a, Typeable a) => Peek a
    peekStorable :: forall a. (Storable a, Typeable a) => Peek a
    peekStorable = [Char] -> Peek a
    forall a. Storable a => [Char] -> Peek a
    peekStorableTy (TypeRep -> [Char]
    forall a. Show a => a -> [Char]
    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 peekStorable #-}

    -- | A 'peek' implementation based on an instance of 'Storable'. Use
    -- this if the type is not 'Typeable'.
    peekStorableTy :: forall a. Storable a => String -> Peek a
    peekStorableTy :: forall a. Storable a => [Char] -> Peek a
    peekStorableTy [Char]
    ty = (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    ps Ptr Word8
    ptr -> do
        let ptr' :: Ptr Word8
    ptr' = Ptr Word8
    ptr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    sz
            sz :: Offset
    sz = a -> Offset
    forall a. Storable a => a -> Offset
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)
            remaining :: Offset
    remaining = PeekState -> Ptr Word8
    peekStateEndPtr PeekState
    ps Ptr Word8 -> Ptr Word8 -> Offset
    forall a b. Ptr a -> Ptr b -> Offset
    `minusPtr` Ptr Word8
    ptr
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Offset
    sz Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    > Offset
    remaining) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ -- Do not perform the check on the new pointer, since it could have overflowed
            Offset -> Offset -> [Char] -> IO ()
    forall void. Offset -> Offset -> [Char] -> IO void
    tooManyBytes Offset
    sz Offset
    remaining [Char]
    ty
    #if ALIGNED_MEMORY
        let bufStart = peekStateAlignPtr ps
            alignStart = alignPtr (peekStateAlignPtr ps) alignAmount
            alignAmount = alignment (undefined :: a)
        x <- if ptr == alignPtr ptr alignAmount
            then Storable.peek (castPtr ptr)
            else (if (alignStart `plusPtr` sz) < (bufStart `plusPtr` alignBufferSize)
                then do
                    BS.memcpy (castPtr alignStart) ptr sz
                    Storable.peek (castPtr alignStart)
                else do
                    allocaBytesAligned sz alignAmount $ \tempPtr -> do
                        BS.memcpy tempPtr (castPtr ptr) sz
                        Storable.peek (castPtr tempPtr))
    #else
        x <- Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    Storable.peek (Ptr Word8 -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ptr)
    #endif
        return $ PeekResult ptr' x
    {-# INLINE peekStorableTy #-}

    ------------------------------------------------------------------------
    -- Utilities for implementing 'Store' instances via memcpy

    -- | Copy a section of memory, based on a 'ForeignPtr', to the output.
    -- Note that this operation is unsafe, the offset and length parameters
    -- are not checked.
    pokeFromForeignPtr :: ForeignPtr a -> Int -> Int -> Poke ()
    pokeFromForeignPtr :: forall a. ForeignPtr a -> Offset -> Offset -> Poke ()
    pokeFromForeignPtr ForeignPtr a
    sourceFp Offset
    sourceOffset Offset
    len =
        (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, ())) -> Poke ())
    -> (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    targetState Offset
    targetOffset -> do
            let targetPtr :: Ptr Word8
    targetPtr = PokeState -> Ptr Word8
    pokeStatePtr PokeState
    targetState
            ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr a
    sourceFp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    sourcePtr ->
                Ptr Word8 -> Ptr Word8 -> Offset -> IO ()
    BS.memcpy (Ptr Word8
    targetPtr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    targetOffset)
                          (Ptr a
    sourcePtr Ptr a -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    sourceOffset)
                          Offset
    len
            let !newOffset :: Offset
    newOffset = Offset
    targetOffset Offset -> Offset -> Offset
    forall a. Num a => a -> a -> a
    + Offset
    len
            (Offset, ()) -> IO (Offset, ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Offset
    newOffset, ())

    -- | Allocate a plain ForeignPtr (no finalizers), of the specified
    -- length and fill it with bytes from the input.
    peekToPlainForeignPtr :: String -> Int -> Peek (ForeignPtr a)
    peekToPlainForeignPtr :: forall a. [Char] -> Offset -> Peek (ForeignPtr a)
    peekToPlainForeignPtr [Char]
    ty Offset
    len =
        (PeekState -> Ptr Word8 -> IO (PeekResult (ForeignPtr a)))
    -> Peek (ForeignPtr a)
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult (ForeignPtr a)))
     -> Peek (ForeignPtr a))
    -> (PeekState -> Ptr Word8 -> IO (PeekResult (ForeignPtr a)))
    -> Peek (ForeignPtr a)
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    ps Ptr Word8
    sourcePtr -> do
            let ptr2 :: Ptr Word8
    ptr2 = Ptr Word8
    sourcePtr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    len
                remaining :: Offset
    remaining = PeekState -> Ptr Word8
    peekStateEndPtr PeekState
    ps Ptr Word8 -> Ptr Word8 -> Offset
    forall a b. Ptr a -> Ptr b -> Offset
    `minusPtr` Ptr Word8
    sourcePtr
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Offset
    len Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    > Offset
    remaining) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ -- Do not perform the check on the new pointer, since it could have overflowed
                Offset -> Offset -> [Char] -> IO ()
    forall void. Offset -> Offset -> [Char] -> IO void
    tooManyBytes Offset
    len Offset
    remaining [Char]
    ty
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Offset
    len Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    < Offset
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Offset -> Offset -> [Char] -> IO ()
    forall void. Offset -> Offset -> [Char] -> IO void
    negativeBytes Offset
    len Offset
    remaining [Char]
    ty
            fp <- Offset -> IO (ForeignPtr Word8)
    forall a. Offset -> IO (ForeignPtr a)
    BS.mallocByteString Offset
    len
            withForeignPtr fp $ \Ptr Word8
    targetPtr ->
                Ptr Word8 -> Ptr Word8 -> Offset -> IO ()
    BS.memcpy Ptr Word8
    targetPtr (Ptr Word8 -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    sourcePtr) Offset
    len
            return $ PeekResult ptr2 (castForeignPtr fp)

    -- | Copy a section of memory, based on a 'Ptr', to the output. Note
    -- that this operation is unsafe, because the offset and length
    -- parameters are not checked.
    pokeFromPtr :: Ptr a -> Int -> Int -> Poke ()
    pokeFromPtr :: forall a. Ptr a -> Offset -> Offset -> Poke ()
    pokeFromPtr Ptr a
    sourcePtr Offset
    sourceOffset Offset
    len =
        (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, ())) -> Poke ())
    -> (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    targetState Offset
    targetOffset -> do
            let targetPtr :: Ptr Word8
    targetPtr = PokeState -> Ptr Word8
    pokeStatePtr PokeState
    targetState
            Ptr Word8 -> Ptr Word8 -> Offset -> IO ()
    BS.memcpy (Ptr Word8
    targetPtr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    targetOffset)
                      (Ptr a
    sourcePtr Ptr a -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    sourceOffset)
                      Offset
    len
            let !newOffset :: Offset
    newOffset = Offset
    targetOffset Offset -> Offset -> Offset
    forall a. Num a => a -> a -> a
    + Offset
    len
            (Offset, ()) -> IO (Offset, ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Offset
    newOffset, ())

    -- | Copy a section of memory, based on a 'ByteArray#', to the output.
    -- Note that this operation is unsafe, because the offset and length
    -- parameters are not checked.
    pokeFromByteArray :: ByteArray# -> Int -> Int -> Poke ()
    pokeFromByteArray :: ByteArray# -> Offset -> Offset -> Poke ()
    pokeFromByteArray ByteArray#
    sourceArr Offset
    sourceOffset Offset
    len =
        (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
    Poke ((PokeState -> Offset -> IO (Offset, ())) -> Poke ())
    -> (PokeState -> Offset -> IO (Offset, ())) -> Poke ()
    forall a b. (a -> b) -> a -> b
    $ \PokeState
    targetState Offset
    targetOffset -> do
            let target :: Ptr (ZonkAny 0)
    target = (PokeState -> Ptr Word8
    pokeStatePtr PokeState
    targetState) Ptr Word8 -> Offset -> Ptr (ZonkAny 0)
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    targetOffset
            ByteArray# -> Offset -> Ptr (ZonkAny 0) -> Offset -> IO ()
    forall a. ByteArray# -> Offset -> Ptr a -> Offset -> IO ()
    copyByteArrayToAddr ByteArray#
    sourceArr Offset
    sourceOffset Ptr (ZonkAny 0)
    target Offset
    len
            let !newOffset :: Offset
    newOffset = Offset
    targetOffset Offset -> Offset -> Offset
    forall a. Num a => a -> a -> a
    + Offset
    len
            (Offset, ()) -> IO (Offset, ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Offset
    newOffset, ())

    -- | Allocate a ByteArray of the specified length and fill it with bytes
    -- from the input.
    peekToByteArray :: String -> Int -> Peek ByteArray
    peekToByteArray :: [Char] -> Offset -> Peek ByteArray
    peekToByteArray [Char]
    ty Offset
    len =
        (PeekState -> Ptr Word8 -> IO (PeekResult ByteArray))
    -> Peek ByteArray
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
    Peek ((PeekState -> Ptr Word8 -> IO (PeekResult ByteArray))
     -> Peek ByteArray)
    -> (PeekState -> Ptr Word8 -> IO (PeekResult ByteArray))
    -> Peek ByteArray
    forall a b. (a -> b) -> a -> b
    $ \PeekState
    ps Ptr Word8
    sourcePtr -> do
            let ptr2 :: Ptr Word8
    ptr2 = Ptr Word8
    sourcePtr Ptr Word8 -> Offset -> Ptr Word8
    forall a b. Ptr a -> Offset -> Ptr b
    `plusPtr` Offset
    len
                remaining :: Offset
    remaining = PeekState -> Ptr Word8
    peekStateEndPtr PeekState
    ps Ptr Word8 -> Ptr Word8 -> Offset
    forall a b. Ptr a -> Ptr b -> Offset
    `minusPtr` Ptr Word8
    sourcePtr
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Offset
    len Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    > Offset
    remaining) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ -- Do not perform the check on the new pointer, since it could have overflowed
                Offset -> Offset -> [Char] -> IO ()
    forall void. Offset -> Offset -> [Char] -> IO void
    tooManyBytes Offset
    len Offset
    remaining [Char]
    ty
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Offset
    len Offset -> Offset -> Bool
    forall a. Ord a => a -> a -> Bool
    < Offset
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Offset -> Offset -> [Char] -> IO ()
    forall void. Offset -> Offset -> [Char] -> IO void
    negativeBytes Offset
    len Offset
    remaining [Char]
    ty
            marr <- Offset -> IO (MutableByteArray (PrimState IO))
    forall (m :: * -> *).
    PrimMonad m =>
    Offset -> m (MutableByteArray (PrimState m))
    newByteArray Offset
    len
            copyAddrToByteArray sourcePtr marr 0 len
            x <- unsafeFreezeByteArray marr
            return $ PeekResult ptr2 x

    -- | Wrapper around @copyByteArrayToAddr#@ primop.
    copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()
    copyByteArrayToAddr :: forall a. ByteArray# -> Offset -> Ptr a -> Offset -> IO ()
    copyByteArrayToAddr ByteArray#
    arr (I# Int#
    offset) (Ptr Addr#
    addr) (I# Int#
    len) =
        (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO (\State# RealWorld
    s -> (# ByteArray#
    -> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
    forall d.
    ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
    copyByteArrayToAddr# ByteArray#
    arr Int#
    offset Addr#
    addr Int#
    len State# RealWorld
    s, () #))
    {-# INLINE copyByteArrayToAddr  #-}

    -- | Wrapper around @copyAddrToByteArray#@ primop.
    copyAddrToByteArray :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
    copyAddrToByteArray :: forall a.
    Ptr a
    -> MutableByteArray (PrimState IO) -> Offset -> Offset -> IO ()
    copyAddrToByteArray (Ptr Addr#
    addr) (MutableByteArray MutableByteArray# (PrimState IO)
    arr) (I# Int#
    offset) (I# Int#
    len) =
        (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO (\State# RealWorld
    s -> (# Addr#
    -> MutableByteArray# RealWorld
    -> Int#
    -> Int#
    -> State# RealWorld
    -> State# RealWorld
    forall d.
    Addr#
    -> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
    copyAddrToByteArray# Addr#
    addr MutableByteArray# RealWorld
    MutableByteArray# (PrimState IO)
    arr Int#
    offset Int#
    len State# RealWorld
    s, () #))
    {-# INLINE copyAddrToByteArray  #-}