{-# LANGUAGE CPP #-}

module Ptr.IO where

import qualified Data.ByteString.Internal as A
import qualified Data.ByteString.Short.Internal as B
import Ptr.Prelude
import qualified Ptr.UncheckedShifting as D

{-# INLINE peekStorable #-}
peekStorable :: Storable storable => Ptr Word8 -> IO storable
peekStorable :: Ptr Word8 -> IO storable
peekStorable =
  Ptr storable -> IO storable
forall a. Storable a => Ptr a -> IO a
peek (Ptr storable -> IO storable)
-> (Ptr Word8 -> Ptr storable) -> Ptr Word8 -> IO storable
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> Ptr storable
forall a b. Ptr a -> Ptr b
castPtr

{-# INLINE peekWord8 #-}
peekWord8 :: Ptr Word8 -> IO Word8
peekWord8 :: Ptr Word8 -> IO Word8
peekWord8 =
  Ptr Word8 -> IO Word8
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable

-- | Big-endian word of 2 bytes.
{-# INLINE peekBEWord16 #-}
peekBEWord16 :: Ptr Word8 -> IO Word16
#ifdef WORDS_BIGENDIAN
peekBEWord16 =
  peekStorable
#else
peekBEWord16 :: Ptr Word8 -> IO Word16
peekBEWord16 =
  (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word16
byteSwap16 (IO Word16 -> IO Word16)
-> (Ptr Word8 -> IO Word16) -> Ptr Word8 -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word16
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian word of 2 bytes.
{-# INLINE peekLEWord16 #-}
peekLEWord16 :: Ptr Word8 -> IO Word16
#ifdef WORDS_BIGENDIAN
peekLEWord16 =
  fmap byteSwap16 . peekStorable
#else
peekLEWord16 :: Ptr Word8 -> IO Word16
peekLEWord16 =
  Ptr Word8 -> IO Word16
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Big-endian word of 4 bytes.
{-# INLINE peekBEWord32 #-}
peekBEWord32 :: Ptr Word8 -> IO Word32
#ifdef WORDS_BIGENDIAN
peekBEWord32 =
  peekStorable
#else
peekBEWord32 :: Ptr Word8 -> IO Word32
peekBEWord32 =
  (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
byteSwap32 (IO Word32 -> IO Word32)
-> (Ptr Word8 -> IO Word32) -> Ptr Word8 -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word32
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian word of 4 bytes.
{-# INLINE peekLEWord32 #-}
peekLEWord32 :: Ptr Word8 -> IO Word32
#ifdef WORDS_BIGENDIAN
peekLEWord32 =
  fmap byteSwap32 . peekStorable
#else
peekLEWord32 :: Ptr Word8 -> IO Word32
peekLEWord32 =
  Ptr Word8 -> IO Word32
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Big-endian word of 8 bytes.
{-# INLINE peekBEWord64 #-}
peekBEWord64 :: Ptr Word8 -> IO Word64
#ifdef WORDS_BIGENDIAN
peekBEWord64 =
  peekStorable
#else
peekBEWord64 :: Ptr Word8 -> IO Word64
peekBEWord64 =
  (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word64
byteSwap64 (IO Word64 -> IO Word64)
-> (Ptr Word8 -> IO Word64) -> Ptr Word8 -> IO Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word64
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian word of 8 bytes.
{-# INLINE peekLEWord64 #-}
peekLEWord64 :: Ptr Word8 -> IO Word64
#ifdef WORDS_BIGENDIAN
peekLEWord64 =
  fmap byteSwap64 . peekStorable
#else
peekLEWord64 :: Ptr Word8 -> IO Word64
peekLEWord64 =
  Ptr Word8 -> IO Word64
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

{-# INLINE peekInt8 #-}
peekInt8 :: Ptr Word8 -> IO Int8
peekInt8 :: Ptr Word8 -> IO Int8
peekInt8 =
  Ptr Word8 -> IO Int8
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable

-- | Big-endian int of 2 bytes.
{-# INLINE peekBEInt16 #-}
peekBEInt16 :: Ptr Word8 -> IO Int16
#ifdef WORDS_BIGENDIAN
peekBEInt16 =
  peekStorable
#else
peekBEInt16 :: Ptr Word8 -> IO Int16
peekBEInt16 =
  (Word16 -> Int16) -> IO Word16 -> IO Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> (Word16 -> Word16) -> Word16 -> Int16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word16 -> Word16
byteSwap16) (IO Word16 -> IO Int16)
-> (Ptr Word8 -> IO Word16) -> Ptr Word8 -> IO Int16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word16
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian int of 2 bytes.
{-# INLINE peekLEInt16 #-}
peekLEInt16 :: Ptr Word8 -> IO Int16
#ifdef WORDS_BIGENDIAN
peekLEInt16 =
  fmap (fromIntegral . byteSwap16) . peekStorable
#else
peekLEInt16 :: Ptr Word8 -> IO Int16
peekLEInt16 =
  Ptr Word8 -> IO Int16
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Big-endian int of 4 bytes.
{-# INLINE peekBEInt32 #-}
peekBEInt32 :: Ptr Word8 -> IO Int32
#ifdef WORDS_BIGENDIAN
peekBEInt32 =
  peekStorable
#else
peekBEInt32 :: Ptr Word8 -> IO Int32
peekBEInt32 =
  (Word32 -> Int32) -> IO Word32 -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word32 -> Word32) -> Word32 -> Int32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> Word32
byteSwap32) (IO Word32 -> IO Int32)
-> (Ptr Word8 -> IO Word32) -> Ptr Word8 -> IO Int32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word32
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian int of 4 bytes.
{-# INLINE peekLEInt32 #-}
peekLEInt32 :: Ptr Word8 -> IO Int32
#ifdef WORDS_BIGENDIAN
peekLEInt32 =
  fmap (fromIntegral . byteSwap32) . peekStorable
#else
peekLEInt32 :: Ptr Word8 -> IO Int32
peekLEInt32 =
  Ptr Word8 -> IO Int32
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Big-endian int of 8 bytes.
{-# INLINE peekBEInt64 #-}
peekBEInt64 :: Ptr Word8 -> IO Int64
#ifdef WORDS_BIGENDIAN
peekBEInt64 =
  peekStorable
#else
peekBEInt64 :: Ptr Word8 -> IO Int64
peekBEInt64 =
  (Word64 -> Int64) -> IO Word64 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (Word64 -> Word64) -> Word64 -> Int64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Word64
byteSwap64) (IO Word64 -> IO Int64)
-> (Ptr Word8 -> IO Word64) -> Ptr Word8 -> IO Int64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO Word64
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- | Little-endian int of 8 bytes.
{-# INLINE peekLEInt64 #-}
peekLEInt64 :: Ptr Word8 -> IO Int64
#ifdef WORDS_BIGENDIAN
peekLEInt64 =
  fmap (fromIntegral . byteSwap64) . peekStorable
#else
peekLEInt64 :: Ptr Word8 -> IO Int64
peekLEInt64 =
  Ptr Word8 -> IO Int64
forall storable. Storable storable => Ptr Word8 -> IO storable
peekStorable
#endif

-- |
-- Allocate a new byte array with @memcpy@.
{-# INLINE peekBytes #-}
peekBytes :: Ptr Word8 -> Int -> IO ByteString
peekBytes :: Ptr Word8 -> Int -> IO ByteString
peekBytes Ptr Word8
ptr Int
amount =
  Int -> (Ptr Word8 -> IO ()) -> IO ByteString
A.create Int
amount ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
destPtr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
destPtr Ptr Word8
ptr Int
amount

{-# INLINE peekShortByteString #-}
peekShortByteString :: Ptr Word8 -> Int -> IO ShortByteString
peekShortByteString :: Ptr Word8 -> Int -> IO ShortByteString
peekShortByteString Ptr Word8
ptr Int
amount =
  Ptr Word8 -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
B.createFromPtr Ptr Word8
ptr Int
amount

{-# INLINE peekNullTerminatedShortByteString #-}
peekNullTerminatedShortByteString :: Ptr Word8 -> (Int -> IO ShortByteString -> IO a) -> IO a
peekNullTerminatedShortByteString :: Ptr Word8 -> (Int -> IO ShortByteString -> IO a) -> IO a
peekNullTerminatedShortByteString Ptr Word8
ptr Int -> IO ShortByteString -> IO a
cont =
  do
    !Int
length <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO CSize
A.c_strlen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
    Int -> IO ShortByteString -> IO a
cont Int
length (Ptr Word8 -> Int -> IO ShortByteString
forall a. Ptr a -> Int -> IO ShortByteString
B.createFromPtr Ptr Word8
ptr Int
length)

{-# INLINE pokeStorable #-}
pokeStorable :: Storable a => Ptr Word8 -> a -> IO ()
pokeStorable :: Ptr Word8 -> a -> IO ()
pokeStorable =
  Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> a -> IO ())
-> (Ptr Word8 -> Ptr a) -> Ptr Word8 -> a -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr

{-# INLINE pokeStorableByteOff #-}
pokeStorableByteOff :: Storable a => Ptr Word8 -> Int -> a -> IO ()
pokeStorableByteOff :: Ptr Word8 -> Int -> a -> IO ()
pokeStorableByteOff =
  Ptr Any -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr Any -> Int -> a -> IO ())
-> (Ptr Word8 -> Ptr Any) -> Ptr Word8 -> Int -> a -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr

{-# INLINE pokeWord8 #-}
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 Ptr Word8
ptr Word8
value =
  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
value

{-# INLINE pokeWord8Off #-}
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off Ptr Word8
ptr Int
off Word8
value =
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
off Word8
value

{-# INLINE pokeBEWord16 #-}
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord16 =
  pokeStorable
#else
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeBEWord16 Ptr Word8
ptr Word16
value =
  do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
D.shiftr_w16 Word16
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
value :: Word8)
#endif

{-# INLINE pokeBEWord16ByteOff #-}
pokeBEWord16ByteOff :: Ptr Word8 -> Int -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord16ByteOff =
  pokeStorableByteOff
#else
pokeBEWord16ByteOff :: Ptr Word8 -> Int -> Word16 -> IO ()
pokeBEWord16ByteOff Ptr Word8
ptr Int
off Word16
value =
  do
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> Int -> a -> IO ()
pokeStorableByteOff Ptr Word8
ptr Int
off (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
D.shiftr_w16 Word16
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
value :: Word8)
#endif

{-# INLINE pokeBEWord32 #-}
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord32 =
  pokeStorable
#else
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 Ptr Word8
ptr Word32
value =
  do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
24) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
16) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
2 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
3 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value :: Word8)
#endif

{-# INLINE pokeBEWord32ByteOff #-}
pokeBEWord32ByteOff :: Ptr Word8 -> Int -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord32ByteOff =
  pokeStorableByteOff
#else
pokeBEWord32ByteOff :: Ptr Word8 -> Int -> Word32 -> IO ()
pokeBEWord32ByteOff Ptr Word8
ptr Int
off Word32
value =
  do
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> Int -> a -> IO ()
pokeStorableByteOff Ptr Word8
ptr Int
off (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
24) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
16) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value :: Word8)
#endif

{-# INLINE pokeBEWord64 #-}
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord64 =
  pokeStorable
#else
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeBEWord64 Ptr Word8
ptr Word64
value =
  do
    Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 Ptr Word8
ptr (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
D.shiftr_w64 Word64
value Int
32))
    Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
4) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value)
#else
pokeBEWord64 ptr value =
  do
    pokeStorable ptr (fromIntegral (D.shiftr_w64 value 56) :: Word8)
    pokeByteOff ptr 1 (fromIntegral (D.shiftr_w64 value 48) :: Word8)
    pokeByteOff ptr 2 (fromIntegral (D.shiftr_w64 value 40) :: Word8)
    pokeByteOff ptr 3 (fromIntegral (D.shiftr_w64 value 32) :: Word8)
    pokeByteOff ptr 4 (fromIntegral (D.shiftr_w64 value 24) :: Word8)
    pokeByteOff ptr 5 (fromIntegral (D.shiftr_w64 value 16) :: Word8)
    pokeByteOff ptr 6 (fromIntegral (D.shiftr_w64 value  8) :: Word8)
    pokeByteOff ptr 7 (fromIntegral value :: Word8)
#endif
#endif

{-# INLINE pokeBEWord64ByteOff #-}
pokeBEWord64ByteOff :: Ptr Word8 -> Int -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord64ByteOff =
  pokeStorableByteOff
#else
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
pokeBEWord64ByteOff :: Ptr Word8 -> Int -> Word64 -> IO ()
pokeBEWord64ByteOff Ptr Word8
ptr Int
off Word64
value =
  do
    Ptr Word8 -> Int -> Word32 -> IO ()
pokeBEWord32ByteOff Ptr Word8
ptr Int
off (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
D.shiftr_w64 Word64
value Int
32))
    Ptr Word8 -> Int -> Word32 -> IO ()
pokeBEWord32ByteOff Ptr Word8
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value)
#else
pokeBEWord64ByteOff ptr off value =
  do
    pokeStorableByteOff ptr off (fromIntegral (D.shiftr_w64 value 56) :: Word8)
    pokeByteOff ptr (off + 1) (fromIntegral (D.shiftr_w64 value 48) :: Word8)
    pokeByteOff ptr (off + 2) (fromIntegral (D.shiftr_w64 value 40) :: Word8)
    pokeByteOff ptr (off + 3) (fromIntegral (D.shiftr_w64 value 32) :: Word8)
    pokeByteOff ptr (off + 4) (fromIntegral (D.shiftr_w64 value 24) :: Word8)
    pokeByteOff ptr (off + 5) (fromIntegral (D.shiftr_w64 value 16) :: Word8)
    pokeByteOff ptr (off + 6) (fromIntegral (D.shiftr_w64 value  8) :: Word8)
    pokeByteOff ptr (off + 7) (fromIntegral value :: Word8)
#endif
#endif

{-# INLINE pokeLEWord16 #-}
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord16 p w =
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (D.shiftr_w16 w 8))
#else
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeLEWord16 =
  Ptr Word8 -> Word16 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord32 #-}
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord32 p w =
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (D.shiftr_w32 w 8))
    pokeWord8Off p 2 (fromIntegral (D.shiftr_w32 w 16))
    pokeWord8Off p 3 (fromIntegral (D.shiftr_w32 w 24))
#else
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeLEWord32 =
  Ptr Word8 -> Word32 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord64 #-}
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
pokeLEWord64 p w =
  do
    let b = fromIntegral (D.shiftr_w64 w 32) :: Word32
        a = fromIntegral w                   :: Word32
    pokeWord8 p (fromIntegral a)
    pokeWord8Off p 1 (fromIntegral (D.shiftr_w32 a 8))
    pokeWord8Off p 2 (fromIntegral (D.shiftr_w32 a 16))
    pokeWord8Off p 3 (fromIntegral (D.shiftr_w32 a 24))
    pokeWord8Off p 4 (fromIntegral b)
    pokeWord8Off p 5 (fromIntegral (D.shiftr_w32 b 8))
    pokeWord8Off p 6 (fromIntegral (D.shiftr_w32 b 16))
    pokeWord8Off p 7 (fromIntegral (D.shiftr_w32 b 24))
#else
pokeLEWord64 p w =
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (D.shiftr_w64 w 8))
    pokeWord8Off p 2 (fromIntegral (D.shiftr_w64 w 16))
    pokeWord8Off p 3 (fromIntegral (D.shiftr_w64 w 24))
    pokeWord8Off p 4 (fromIntegral (D.shiftr_w64 w 32))
    pokeWord8Off p 5 (fromIntegral (D.shiftr_w64 w 40))
    pokeWord8Off p 6 (fromIntegral (D.shiftr_w64 w 48))
    pokeWord8Off p 7 (fromIntegral (D.shiftr_w64 w 56))
#endif
#else
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeLEWord64 =
  Ptr Word8 -> Word64 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeBytesTrimming #-}
pokeBytesTrimming :: Ptr Word8 -> Int -> ByteString -> IO ()
pokeBytesTrimming :: Ptr Word8 -> Int -> ByteString -> IO ()
pokeBytesTrimming Ptr Word8
ptr Int
maxLength (A.PS ForeignPtr Word8
fptr Int
offset Int
length) =
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bytesPtr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
ptr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bytesPtr Int
offset) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
length Int
maxLength)

{-# INLINE pokeBytes #-}
pokeBytes :: Ptr Word8 -> ByteString -> IO ()
#if MIN_VERSION_bytestring(0,11,0)
pokeBytes ptr (A.BS fptr length) =
  withForeignPtr fptr $ \bytesPtr -> A.memcpy ptr bytesPtr length
#else
pokeBytes :: Ptr Word8 -> ByteString -> IO ()
pokeBytes Ptr Word8
ptr (A.PS ForeignPtr Word8
fptr Int
offset Int
length) =
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bytesPtr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
ptr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bytesPtr Int
offset) Int
length
#endif