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