-- | 'ByteString's and primitive byte arrays.

{-# LANGUAGE UnboxedTuples #-}

module Bytezap.Bytes where

import Bytezap

import GHC.Exts
import Data.ByteString qualified as B
import Data.ByteString.Internal qualified as B
import GHC.IO
import Data.Word
import Foreign.ForeignPtr

byteString :: B.ByteString -> Write
byteString :: ByteString -> Write
byteString (B.BS ForeignPtr Word8
fptr Int
len) = Int -> Poke -> Write
Write Int
len (ForeignPtr Word8 -> Int -> Poke
pokeForeignPtr ForeignPtr Word8
fptr Int
len)
{-# INLINE byteString #-}

pokeForeignPtr :: ForeignPtr Word8 -> Int -> Poke
pokeForeignPtr :: ForeignPtr Word8 -> Int -> Poke
pokeForeignPtr ForeignPtr Word8
fptr len :: Int
len@(I# Int#
len#) = Poke# -> Poke
poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyForeignPtr (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) ForeignPtr Word8
fptr Int
len) State# RealWorld
st# of
      (# State# RealWorld
st'#, () #) -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
len# #)
{-# INLINE pokeForeignPtr #-}

memcpyForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyForeignPtr Ptr Word8
ptrTo ForeignPtr Word8
fptrFrom Int
len =
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
B.unsafeWithForeignPtr ForeignPtr Word8
fptrFrom ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptrFrom -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptrTo Ptr Word8
ptrFrom Int
len
{-# INLINE memcpyForeignPtr #-}

pokeByteArray# :: ByteArray# -> Int# -> Int# -> Poke
pokeByteArray# :: ByteArray# -> Int# -> Int# -> Poke
pokeByteArray# ByteArray#
arr# Int#
off# Int#
len# = Poke# -> Poke
poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
arr# Int#
off# Addr#
addr# Int#
len# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
len# #)
{-# INLINE pokeByteArray# #-}

-- TODO this seems to work but like, really? wow lol
pokeByteReplicate :: Int -> Word8 -> Poke
pokeByteReplicate :: Int -> Word8 -> Poke
pokeByteReplicate n :: Int
n@(I# Int#
n#) Word8
w8 = Poke# -> Poke
poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case IO (Ptr Word8)
-> State# RealWorld -> (# State# RealWorld, Ptr Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Word8
w8 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) State# RealWorld
st# of
      (# State# RealWorld
st'#, Ptr Word8
_ #) -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
n# #)