{-# 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 -> 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
<$ :: forall a b. a -> Poke b -> Poke a
$c<$ :: forall a b. a -> Poke b -> Poke a
fmap :: forall a b. (a -> b) -> Poke a -> Poke b
$cfmap :: forall a b. (a -> b) -> Poke a -> Poke b
Functor

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

instance Monad Poke where
    return :: forall a. a -> Poke a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    >> :: 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 = forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
ptr Offset
offset1 -> do
        (Offset
offset2, a
x') <- PokeState -> Offset -> IO (Offset, a)
x PokeState
ptr Offset
offset1
        forall a. Poke a -> PokeState -> Offset -> IO (Offset, a)
runPoke (a -> Poke b
f a
x') PokeState
ptr Offset
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 = forall a. Text -> Poke a
pokeException 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 = forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
_ Offset
offset -> (Offset
offset, ) 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)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PokeException -> PokeException -> Bool
$c/= :: PokeException -> PokeException -> Bool
== :: PokeException -> PokeException -> Bool
$c== :: PokeException -> PokeException -> Bool
Eq, Offset -> PokeException -> ShowS
[PokeException] -> ShowS
PokeException -> [Char]
forall a.
(Offset -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PokeException] -> ShowS
$cshowList :: [PokeException] -> ShowS
show :: PokeException -> [Char]
$cshow :: PokeException -> [Char]
showsPrec :: Offset -> PokeException -> ShowS
$cshowsPrec :: Offset -> 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 " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
offset forall a. [a] -> [a] -> [a]
++
        [Char]
" : " 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 = forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
_ Offset
off -> forall e a. 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 -> 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
<$ :: forall a b. a -> Peek b -> Peek a
$c<$ :: forall a b. a -> Peek b -> Peek a
fmap :: forall a b. (a -> b) -> Peek a -> Peek b
$cfmap :: forall a b. (a -> b) -> Peek a -> Peek b
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 -> 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
<$ :: forall a b. a -> PeekResult b -> PeekResult a
$c<$ :: forall a b. a -> PeekResult b -> PeekResult a
fmap :: forall a b. (a -> b) -> PeekResult a -> PeekResult b
$cfmap :: forall a b. (a -> b) -> PeekResult a -> PeekResult b
Functor)

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

instance Monad Peek where
    return :: forall a. a -> Peek a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    >> :: 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 = forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
end Ptr Word8
ptr1 -> do
        PeekResult Ptr Word8
ptr2 a
x' <- PeekState -> Ptr Word8 -> IO (PeekResult a)
x PeekState
end Ptr Word8
ptr1
        forall a. Peek a -> PeekState -> Ptr Word8 -> IO (PeekResult a)
runPeek (a -> Peek b
f a
x') PeekState
end Ptr Word8
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 = forall a. Text -> Peek a
peekException 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 = forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
_ Ptr Word8
ptr -> do
        a
x <- forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# State# (PrimState Peek) -> (# State# (PrimState Peek), a #)
action)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
ptr a
x
    {-# INLINE primitive #-}

instance MonadIO Peek where
    liftIO :: forall a. IO a -> Peek a
liftIO IO a
f = forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
_ Ptr Word8
ptr -> forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
ptr 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)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeekException -> PeekException -> Bool
$c/= :: PeekException -> PeekException -> Bool
== :: PeekException -> PeekException -> Bool
$c== :: PeekException -> PeekException -> Bool
Eq, Offset -> PeekException -> ShowS
[PeekException] -> ShowS
PeekException -> [Char]
forall a.
(Offset -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PeekException] -> ShowS
$cshowList :: [PeekException] -> ShowS
show :: PeekException -> [Char]
$cshow :: PeekException -> [Char]
showsPrec :: Offset -> PeekException -> ShowS
$cshowsPrec :: Offset -> 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, " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
offset forall a. [a] -> [a] -> [a]
++
        [Char]
" bytes from end: " 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 = forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
ptr -> forall e a. Exception e => e -> IO a
throwIO (Offset -> Text -> PeekException
PeekException (PeekState -> Ptr Word8
peekStateEndPtr PeekState
ps 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 =
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PeekException
PeekException Offset
remaining forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        [Char]
"Attempted to read too many bytes for " forall a. [a] -> [a] -> [a]
++
        [Char]
ty forall a. [a] -> [a] -> [a]
++
        [Char]
". Needed " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
needed forall a. [a] -> [a] -> [a]
++ [Char]
", but only " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
remaining 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 =
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PeekException
PeekException Offset
remaining forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        [Char]
"Attempted to read negative number of bytes for " forall a. [a] -> [a] -> [a]
++
        [Char]
ty forall a. [a] -> [a] -> [a]
++
        [Char]
". Tried to read " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
needed 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 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
                }
        (Offset
o, ()) <- forall a. Poke a -> PokeState -> Offset -> IO (Offset, a)
runPoke Poke ()
f PokeState
ps Offset
0
        Offset -> Offset -> IO ()
checkOffset Offset
o Offset
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
  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 forall a. Ord a => a -> a -> Bool
> Offset
l = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PokeException
PokeException Offset
o forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        [Char]
"encode overshot end of " forall a. [a] -> [a] -> [a]
++
        forall a. Show a => a -> [Char]
show Offset
l forall a. [a] -> [a] -> [a]
++
        [Char]
" byte long buffer"
    | Offset
o forall a. Ord a => a -> a -> Bool
< Offset
l = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PokeException
PokeException Offset
o forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        [Char]
"encode undershot end of " forall a. Semigroup a => a -> a -> a
<>
        forall a. Show a => a -> [Char]
show Offset
l forall a. Semigroup a => a -> a -> a
<>
        [Char]
" byte long buffer"
    | Bool
otherwise = 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 = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 ->
        let ptr :: Ptr Word8
ptr = Ptr Word8
ptr0 forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
s
        in 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) =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 ->
        let ptr :: Ptr Word8
ptr = Ptr Word8
ptr0 forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
s
        in 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
offset, a
x) <- forall a. Peek a -> Ptr Word8 -> Offset -> IO (Offset, a)
decodeIOPortionWithFromPtr Peek a
mypeek Ptr Word8
ptr Offset
len
    if Offset
len forall a. Eq a => a -> a -> Bool
/= Offset
offset
       then forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PeekException
PeekException (Offset
len forall a. Num a => a -> a -> a
- Offset
offset) Text
"Didn't consume all input."
       else forall (m :: * -> *) a. Monad m => a -> m a
return a
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 forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
        remaining :: Offset
remaining = Ptr Word8
end forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
ptr
    in do PeekResult Ptr Word8
ptr2 a
x' <-
#if ALIGNED_MEMORY
              allocaBytesAligned alignBufferSize 8 $ \aptr -> do
                  runPeek mypeek (PeekState end aptr) ptr
#else
              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 Offset
len forall a. Ord a => a -> a -> Bool
> Offset
remaining -- Do not perform the check on the new pointer, since it could have overflowed
              then forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Offset -> Text -> PeekException
PeekException (Ptr Word8
end forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
ptr2) Text
"Overshot end of buffer"
              else forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
ptr2 forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
ptr, a
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 = forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
ps Offset
offset -> do
    let targetPtr :: Ptr a
targetPtr = PokeState -> Ptr Word8
pokeStatePtr PokeState
ps 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
targetPtr a
x
#endif
    let !newOffset :: Offset
newOffset = Offset
offset forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Offset
sizeOf a
x
    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 = forall a. Storable a => [Char] -> Peek a
peekStorableTy (forall a. Show a => a -> [Char]
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (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 = forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
ptr -> do
    let ptr' :: Ptr Word8
ptr' = Ptr Word8
ptr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
sz
        sz :: Offset
sz = forall a. Storable a => a -> Offset
sizeOf (forall a. HasCallStack => a
undefined :: a)
        remaining :: Offset
remaining = PeekState -> Ptr Word8
peekStateEndPtr PeekState
ps forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
ptr
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset
sz forall a. Ord a => a -> a -> Bool
> Offset
remaining) forall a b. (a -> b) -> a -> b
$ -- Do not perform the check on the new pointer, since it could have overflowed
        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
    a
x <- forall a. Storable a => Ptr a -> IO a
Storable.peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
#endif
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
ptr' a
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 =
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
targetState Offset
targetOffset -> do
        let targetPtr :: Ptr Word8
targetPtr = PokeState -> Ptr Word8
pokeStatePtr PokeState
targetState
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
sourceFp forall a b. (a -> b) -> a -> b
$ \Ptr a
sourcePtr ->
            Ptr Word8 -> Ptr Word8 -> Offset -> IO ()
BS.memcpy (Ptr Word8
targetPtr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
targetOffset)
                      (Ptr a
sourcePtr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
sourceOffset)
                      Offset
len
        let !newOffset :: Offset
newOffset = Offset
targetOffset forall a. Num a => a -> a -> a
+ Offset
len
        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 =
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
sourcePtr -> do
        let ptr2 :: Ptr Word8
ptr2 = Ptr Word8
sourcePtr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
            remaining :: Offset
remaining = PeekState -> Ptr Word8
peekStateEndPtr PeekState
ps forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
sourcePtr
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset
len forall a. Ord a => a -> a -> Bool
> Offset
remaining) forall a b. (a -> b) -> a -> b
$ -- Do not perform the check on the new pointer, since it could have overflowed
            forall void. Offset -> Offset -> [Char] -> IO void
tooManyBytes Offset
len Offset
remaining [Char]
ty
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset
len forall a. Ord a => a -> a -> Bool
< Offset
0) forall a b. (a -> b) -> a -> b
$
            forall void. Offset -> Offset -> [Char] -> IO void
negativeBytes Offset
len Offset
remaining [Char]
ty
        ForeignPtr Word8
fp <- forall a. Offset -> IO (ForeignPtr a)
BS.mallocByteString Offset
len
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
targetPtr ->
            Ptr Word8 -> Ptr Word8 -> Offset -> IO ()
BS.memcpy Ptr Word8
targetPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
sourcePtr) Offset
len
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
ptr2 (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
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 =
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
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 forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
targetOffset)
                  (Ptr a
sourcePtr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
sourceOffset)
                  Offset
len
        let !newOffset :: Offset
newOffset = Offset
targetOffset forall a. Num a => a -> a -> a
+ Offset
len
        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 =
    forall a. (PokeState -> Offset -> IO (Offset, a)) -> Poke a
Poke forall a b. (a -> b) -> a -> b
$ \PokeState
targetState Offset
targetOffset -> do
        let target :: Ptr Any
target = (PokeState -> Ptr Word8
pokeStatePtr PokeState
targetState) forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
targetOffset
        forall a. ByteArray# -> Offset -> Ptr a -> Offset -> IO ()
copyByteArrayToAddr ByteArray#
sourceArr Offset
sourceOffset Ptr Any
target Offset
len
        let !newOffset :: Offset
newOffset = Offset
targetOffset forall a. Num a => a -> a -> a
+ Offset
len
        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 =
    forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
sourcePtr -> do
        let ptr2 :: Ptr Word8
ptr2 = Ptr Word8
sourcePtr forall a b. Ptr a -> Offset -> Ptr b
`plusPtr` Offset
len
            remaining :: Offset
remaining = PeekState -> Ptr Word8
peekStateEndPtr PeekState
ps forall a b. Ptr a -> Ptr b -> Offset
`minusPtr` Ptr Word8
sourcePtr
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset
len forall a. Ord a => a -> a -> Bool
> Offset
remaining) forall a b. (a -> b) -> a -> b
$ -- Do not perform the check on the new pointer, since it could have overflowed
            forall void. Offset -> Offset -> [Char] -> IO void
tooManyBytes Offset
len Offset
remaining [Char]
ty
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset
len forall a. Ord a => a -> a -> Bool
< Offset
0) forall a b. (a -> b) -> a -> b
$
            forall void. Offset -> Offset -> [Char] -> IO void
negativeBytes Offset
len Offset
remaining [Char]
ty
        MutableByteArray RealWorld
marr <- forall (m :: * -> *).
PrimMonad m =>
Offset -> m (MutableByteArray (PrimState m))
newByteArray Offset
len
        forall a.
Ptr a
-> MutableByteArray (PrimState IO) -> Offset -> Offset -> IO ()
copyAddrToByteArray Ptr Word8
sourcePtr MutableByteArray RealWorld
marr Offset
0 Offset
len
        ByteArray
x <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
marr
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
ptr2 ByteArray
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) =
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# 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) =
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# (PrimState IO)
arr Int#
offset Int#
len State# RealWorld
s, () #))
{-# INLINE copyAddrToByteArray  #-}