1-- | 2-- Module : Data.ByteArray.Pack 3-- License : BSD-Style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Simple Byte Array packer 9-- 10-- Simple example: 11-- 12-- > > flip pack 20 $ putWord8 0x41 >> putByteString "BCD" >> putWord8 0x20 >> putStorable (42 :: Word32) 13-- > Right (ABCD *\NUL\NUL\NUL") 14-- 15-- Original code from <https://hackage.haskell.org/package/bspack> 16-- generalized and adapted to run on 'memory', and spellchecked / tweaked. (2015-05) 17-- Copyright (c) 2014 Nicolas DI PRIMA 18-- 19module Data.ByteArray.Pack 20 ( Packer 21 , Result(..) 22 , fill 23 , pack 24 -- * Operations 25 -- ** put 26 , putWord8 27 , putWord16 28 , putWord32 29 , putStorable 30 , putBytes 31 , fillList 32 , fillUpWith 33 -- ** skip 34 , skip 35 , skipStorable 36 ) where 37 38import Data.Word 39import Foreign.Ptr 40import Foreign.Storable 41import Data.Memory.Internal.Imports () 42import Data.Memory.Internal.Compat 43import Data.Memory.PtrMethods 44import Data.ByteArray.Pack.Internal 45import Data.ByteArray (ByteArray, ByteArrayAccess, MemView(..)) 46import qualified Data.ByteArray as B 47 48-- | Fill a given sized buffer with the result of the Packer action 49fill :: ByteArray byteArray => Int -> Packer a -> Either String byteArray 50fill len packing = unsafeDoIO $ do 51 (val, out) <- B.allocRet len $ \ptr -> runPacker_ packing (MemView ptr len) 52 case val of 53 PackerMore _ (MemView _ r) 54 | r == 0 -> return $ Right out 55 | otherwise -> return $ Left ("remaining unpacked bytes " ++ show r ++ " at the end of buffer") 56 PackerFail err -> return $ Left err 57 58-- | Pack the given packer into the given bytestring 59pack :: ByteArray byteArray => Packer a -> Int -> Either String byteArray 60pack packing len = fill len packing 61{-# DEPRECATED pack "use fill instead" #-} 62 63fillUpWithWord8' :: Word8 -> Packer () 64fillUpWithWord8' w = Packer $ \(MemView ptr size) -> do 65 memSet ptr w size 66 return $ PackerMore () (MemView (ptr `plusPtr` size) 0) 67 68-- | Put a storable from the current position in the stream 69putStorable :: Storable storable => storable -> Packer () 70putStorable s = actionPacker (sizeOf s) (\ptr -> poke (castPtr ptr) s) 71 72-- | Put a Byte Array from the current position in the stream 73-- 74-- If the ByteArray is null, then do nothing 75putBytes :: ByteArrayAccess ba => ba -> Packer () 76putBytes bs 77 | neededLength == 0 = return () 78 | otherwise = 79 actionPacker neededLength $ \dstPtr -> B.withByteArray bs $ \srcPtr -> 80 memCopy dstPtr srcPtr neededLength 81 where 82 neededLength = B.length bs 83 84-- | Skip some bytes from the current position in the stream 85skip :: Int -> Packer () 86skip n = actionPacker n (\_ -> return ()) 87 88-- | Skip the size of a storable from the current position in the stream 89skipStorable :: Storable storable => storable -> Packer () 90skipStorable = skip . sizeOf 91 92-- | Fill up from the current position in the stream to the end 93-- 94-- It is equivalent to: 95-- 96-- > fillUpWith s == fillList (repeat s) 97-- 98fillUpWith :: Storable storable => storable -> Packer () 99fillUpWith s = fillList $ repeat s 100{-# RULES "fillUpWithWord8" forall s . fillUpWith s = fillUpWithWord8' s #-} 101{-# NOINLINE fillUpWith #-} 102 103-- | Will put the given storable list from the current position in the stream 104-- to the end. 105-- 106-- This function will fail with not enough storage if the given storable can't 107-- be written (not enough space) 108-- 109-- Example: 110-- 111-- > > pack (fillList $ [1..] :: Word8) 9 112-- > "\1\2\3\4\5\6\7\8\9" 113-- > > pack (fillList $ [1..] :: Word32) 4 114-- > "\1\0\0\0" 115-- > > pack (fillList $ [1..] :: Word32) 64 116-- > .. <..succesful..> 117-- > > pack (fillList $ [1..] :: Word32) 1 118-- > .. <.. not enough space ..> 119-- > > pack (fillList $ [1..] :: Word32) 131 120-- > .. <.. not enough space ..> 121-- 122fillList :: Storable storable => [storable] -> Packer () 123fillList [] = return () 124fillList (x:xs) = putStorable x >> fillList xs 125 126------------------------------------------------------------------------------ 127-- Common packer -- 128------------------------------------------------------------------------------ 129 130-- | put Word8 in the current position in the stream 131putWord8 :: Word8 -> Packer () 132putWord8 = putStorable 133{-# INLINE putWord8 #-} 134 135-- | put Word16 in the current position in the stream 136-- /!\ use Host Endianness 137putWord16 :: Word16 -> Packer () 138putWord16 = putStorable 139{-# INLINE putWord16 #-} 140 141-- | put Word32 in the current position in the stream 142-- /!\ use Host Endianness 143putWord32 :: Word32 -> Packer () 144putWord32 = putStorable 145{-# INLINE putWord32 #-} 146