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