module Data.ByteArray.Pack
( Packer
, Result(..)
, fill
, pack
, putWord8
, putWord16
, putWord32
, putStorable
, putBytes
, fillList
, fillUpWith
, skip
, skipStorable
) where
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import Data.Memory.Internal.Imports ()
import Data.Memory.Internal.Compat
import Data.Memory.PtrMethods
import Data.ByteArray.Pack.Internal
import Data.ByteArray (ByteArray, ByteArrayAccess, MemView(..))
import qualified Data.ByteArray as B
fill :: ByteArray byteArray => Int -> Packer a -> Either String byteArray
fill :: forall byteArray a.
ByteArray byteArray =>
Int -> Packer a -> Either String byteArray
fill Int
len Packer a
packing = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
(Result a
val, byteArray
out) <- forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> forall a. Packer a -> MemView -> IO (Result a)
runPacker_ Packer a
packing (Ptr Word8 -> Int -> MemView
MemView Ptr Word8
ptr Int
len)
case Result a
val of
PackerMore a
_ (MemView Ptr Word8
_ Int
r)
| Int
r forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right byteArray
out
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"remaining unpacked bytes " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
r forall a. [a] -> [a] -> [a]
++ String
" at the end of buffer")
PackerFail String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
err
pack :: ByteArray byteArray => Packer a -> Int -> Either String byteArray
pack :: forall byteArray a.
ByteArray byteArray =>
Packer a -> Int -> Either String byteArray
pack Packer a
packing Int
len = forall byteArray a.
ByteArray byteArray =>
Int -> Packer a -> Either String byteArray
fill Int
len Packer a
packing
{-# DEPRECATED pack "use fill instead" #-}
fillUpWithWord8' :: Word8 -> Packer ()
fillUpWithWord8' :: Word8 -> Packer ()
fillUpWithWord8' Word8
w = forall a. (MemView -> IO (Result a)) -> Packer a
Packer forall a b. (a -> b) -> a -> b
$ \(MemView Ptr Word8
ptr Int
size) -> do
Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
ptr Word8
w Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> MemView -> Result a
PackerMore () (Ptr Word8 -> Int -> MemView
MemView (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size) Int
0)
putStorable :: Storable storable => storable -> Packer ()
putStorable :: forall storable. Storable storable => storable -> Packer ()
putStorable storable
s = forall a. Int -> (Ptr Word8 -> IO a) -> Packer a
actionPacker (forall a. Storable a => a -> Int
sizeOf storable
s) (\Ptr Word8
ptr -> forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) storable
s)
putBytes :: ByteArrayAccess ba => ba -> Packer ()
putBytes :: forall ba. ByteArrayAccess ba => ba -> Packer ()
putBytes ba
bs
| Int
neededLength forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
forall a. Int -> (Ptr Word8 -> IO a) -> Packer a
actionPacker Int
neededLength forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
bs forall a b. (a -> b) -> a -> b
$ \Ptr Word8
srcPtr ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy Ptr Word8
dstPtr Ptr Word8
srcPtr Int
neededLength
where
neededLength :: Int
neededLength = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs
skip :: Int -> Packer ()
skip :: Int -> Packer ()
skip Int
n = forall a. Int -> (Ptr Word8 -> IO a) -> Packer a
actionPacker Int
n (\Ptr Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
skipStorable :: Storable storable => storable -> Packer ()
skipStorable :: forall storable. Storable storable => storable -> Packer ()
skipStorable = Int -> Packer ()
skip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => a -> Int
sizeOf
fillUpWith :: Storable storable => storable -> Packer ()
fillUpWith :: forall storable. Storable storable => storable -> Packer ()
fillUpWith storable
s = forall storable. Storable storable => [storable] -> Packer ()
fillList forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat storable
s
{-# RULES "fillUpWithWord8" forall s . fillUpWith s = fillUpWithWord8' s #-}
{-# NOINLINE fillUpWith #-}
fillList :: Storable storable => [storable] -> Packer ()
fillList :: forall storable. Storable storable => [storable] -> Packer ()
fillList [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
fillList (storable
x:[storable]
xs) = forall storable. Storable storable => storable -> Packer ()
putStorable storable
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall storable. Storable storable => [storable] -> Packer ()
fillList [storable]
xs
putWord8 :: Word8 -> Packer ()
putWord8 :: Word8 -> Packer ()
putWord8 = forall storable. Storable storable => storable -> Packer ()
putStorable
{-# INLINE putWord8 #-}
putWord16 :: Word16 -> Packer ()
putWord16 :: Word16 -> Packer ()
putWord16 = forall storable. Storable storable => storable -> Packer ()
putStorable
{-# INLINE putWord16 #-}
putWord32 :: Word32 -> Packer ()
putWord32 :: Word32 -> Packer ()
putWord32 = forall storable. Storable storable => storable -> Packer ()
putStorable
{-# INLINE putWord32 #-}