@@ -1,39 +1,93 @@
11{-# LANGUAGE RankNTypes, MagicHash, BangPatterns, CPP #-}
22
3+-----------------------------------------------------------------------------
4+-- |
5+-- Module : Data.Binary.Bits.Get
6+-- Copyright : (c) Lennart Kolmodin 2010-2011
7+-- License : BSD3-style (see LICENSE)
8+--
9+-- Maintainer : kolmodin@gmail.com
10+-- Stability : experimental
11+-- Portability : portable (should run where the package binary runs)
12+--
13+-- Parse bits easily. Parsing can be done either in a monadic style, or more
14+-- efficiently, using the 'Applicative' style.
15+--
16+-- For the monadic style, write your parser as a 'BitGet' monad using the
17+--
18+-- * 'getBool'
19+--
20+-- * 'getWord8'
21+--
22+-- * 'getWord16be'
23+--
24+-- * 'getWord32be'
25+--
26+-- * 'getWord64be'
27+--
28+-- * 'getByteString'
29+--
30+-- functions and run it with 'runBitGet'.
31+--
32+-- For the applicative style, compose the fuctions
33+--
34+-- * 'bool'
35+--
36+-- * 'word8'
37+--
38+-- * 'word16be'
39+--
40+-- * 'word32be'
41+--
42+-- * 'word64be'
43+--
44+-- * 'byteString'
45+--
46+-- to make a 'Block'.
47+-- Use 'block' to turn it into the 'BitGet' monad to be able to run it with
48+-- 'runBitGet'.
49+-----------------------------------------------------------------------------
50+
351module Data.Binary.Bits.Get
4− ( BitGet
5− , Block
52+ (
53+ -- * BitGet monad
54+
55+ -- $bitget
56+
57+ BitGet
658 , runBitGet
759
60+ -- ** Get bytes
861 , getBool
962 , getWord8
1063 , getWord16be
1164 , getWord32be
1265 , getWord64be
1366
67+ -- * Blocks
68+
69+ -- $blocks
70+ , Block
71+ , block
72+
73+ -- ** Read in Blocks
1474 , bool
1575 , word8
1676 , word16be
1777 , word32be
1878 , word64be
1979 , byteString
20−
21− , block
22−
2380 , Data.Binary.Bits.Get.getByteString
81+
2482 ) where
2583
2684import Data.Binary.Get as B ( runGet, Get, getByteString )
2785
2886import Data.ByteString as B
29−import Data.ByteString.Internal
3087import Data.ByteString.Unsafe
3188
32−import qualified Data.ByteString.Lazy as L
33−
3489import Data.Bits
3590import Data.Word
36−import Data.List as List ( reverse )
3791
3892import Control.Applicative
3993
@@ -42,32 +96,31 @@ import Prelude as P
4296#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
4397import GHC.Base
4498import GHC.Word
45−import GHC.Int
4699#endif
47100
48−data S = S !ByteString -- Input
49− !Int -- Bit offset (0-7)
50− deriving (Show)
51−
52−-- | A block that will be read with only one boundry check. Needs to know the
53−-- number of bits in advance.
54−data Block a = Block !Int (S -> a)
55101
56−instance Functor Block where
57− fmap f (Block i p) = Block i (\s -> f (p s))
58−
59−instance Applicative Block where
60− pure a = Block 0 (\_ -> a)
61− (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
62− (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
63− (Block i p) <* (Block j _) = Block (i+j) p
64−
65−-- | Get a block. Guaranteed to be done with one single boundry check, and must
66−-- therefore require a statically known number of bits.
67−-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be' and 'Applicative'.
102+-- $bitget
103+-- Parse bits using a monad.
104+--
105+-- @
106+--myBitParser :: 'Get' ('Word8', 'Word8')
107+--myBitParser = 'runGetBit' parse4by4
68108--
109+--parse4by4 :: 'BitGet' ('Word8', 'Word8')
110+--parse4by4 = do
111+-- bits <- 'getWord8' 4
112+-- more <- 'getWord8' 4
113+-- return (bits,more)
69114-- @
70−-- data IPV6Header = IPV6Header {
115+
116+-- $blocks
117+-- Parse more efficiently in blocks. Each block is read with only one boundry
118+-- check (checking that there is enough input) as the size of the block can be
119+-- calculated statically. This is somewhat limiting as you cannot make the
120+-- parsing depend on the input being parsed.
121+--
122+-- @
123+--data IPV6Header = IPV6Header {
71124-- ipv6Version :: 'Word8'
72125-- , ipv6TrafficClass :: 'Word8'
73126-- , ipv6FlowLabel :: 'Word32
@@ -78,7 +131,8 @@ instance Applicative Block where
78131-- , ipv6DestinationAddress :: 'ByteString'
79132-- }
80133--
81−-- parse = IPV6Header '<$>' 'word8' 4
134+-- ipv6headerblock =
135+-- IPV6Header '<$>' 'word8' 4
82136-- '<*>' 'word8' 8
83137-- '<*>' 'word32be' 24
84138-- '<*>' 'word16be' 16
@@ -86,12 +140,45 @@ instance Applicative Block where
86140-- '<*>' 'word8' 8
87141-- '<*>' 'byteString' 16
88142-- '<*>' 'byteString' 16
143+--
144+--ipv6Header :: 'Get' IPV6Header
145+--ipv6Header = 'runBitGet' ('block' ipv6headerblock)
89146-- @
147+
148+data S = S !ByteString -- Input
149+ !Int -- Bit offset (0-7)
150+ deriving (Show)
151+
152+-- | A block that will be read with only one boundry check. Needs to know the
153+-- number of bits in advance.
154+data Block a = Block !Int (S -> a)
155+
156+instance Functor Block where
157+ fmap f (Block i p) = Block i (\s -> f (p s))
158+
159+instance Applicative Block where
160+ pure a = Block 0 (\_ -> a)
161+ (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
162+ (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
163+ (Block i p) <* (Block j _) = Block (i+j) p
164+
165+-- | Get a block. Will be read with one single boundry check, and
166+-- therefore requires a statically known number of bits.
167+-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
168+-- 'byteString' and 'Applicative'.
90169block :: Block a -> BitGet a
91170block (Block i p) = do
92171 ensureBits i
93172 modifyState (\s -> (incS i s, p s))
94173
174+
175+incS :: Int -> S -> S
176+incS o (S bs n) =
177+ let !o' = (n+o)
178+ !d = o' `shiftR` 3
179+ !n' = o' .&. make_mask 3
180+ in S (unsafeDrop d bs) n'
181+
95182-- | make_mask 3 = 00000111
96183make_mask :: Bits a => Int -> a
97184make_mask n = (1 `shiftL` fromIntegral n) - 1
@@ -102,25 +189,17 @@ make_mask n = (1 `shiftL` fromIntegral n) - 1
102189{-# SPECIALIZE make_mask :: Int -> Word32 #-}
103190{-# SPECIALIZE make_mask :: Int -> Word64 #-}
104191
105−readBool :: S -> Bool
106−readBool (S bs n) = testBit (unsafeHead bs) (7-n)
192+bit_offset :: Int -> Int
193+bit_offset n = make_mask 3 .&. n
107194
108−incS :: Int -> S -> S
109−incS o (S bs n) =
110− let !o' = (n+o)
111− !d = o' `shiftR` 3
112− !n' = o' .&. make_mask 3
113− in S (unsafeDrop d bs) n'
195+byte_offset :: Int -> Int
196+byte_offset n = n `shiftR` 3
114197
115−readByteString :: Int -> S -> ByteString
116−readByteString n s@(S bs o)
117− -- no offset, easy.
118− | o == 0 = unsafeTake n bs
119− -- offset. ugg. this is really naive and slow. but also pretty easy :)
120− | otherwise = B.pack (P.map (readWord8 8) (P.take n (iterate (incS 8) s)))
198+readBool :: S -> Bool
199+readBool (S bs n) = testBit (unsafeHead bs) (7-n)
121200
122201readWord8 :: Int -> S -> Word8
123−readWord8 n s@(S bs o)
202+readWord8 n (S bs o)
124203 -- no bits at all, return 0
125204 | n == 0 = 0
126205
@@ -139,11 +218,6 @@ readWord8 n s@(S bs o)
139218 w' = (w `shiftr_w16` (16 - o - n)) .&. m
140219 in fromIntegral w'
141220
142−bit_offset :: Int -> Int
143−bit_offset n = make_mask 3 .&. n
144−
145−byte_offset :: Int -> Int
146−byte_offset n = n `shiftR` 3
147221
148222readWord16be :: Int -> S -> Word16
149223readWord16be n s@(S bs o)
@@ -170,9 +244,46 @@ readWord16be n s@(S bs o)
170244
171245 | otherwise = error "readWord16be: tried to read more than 16 bits"
172246
247+readWord32be :: Int -> S -> Word32
248+readWord32be n s@(S _ o)
249+ -- 8 or fewer bits, use readWord8
250+ | n <= 8 = fromIntegral (readWord8 n s)
251+
252+ -- 16 or fewer bits, use readWord16be
253+ | n <= 16 = fromIntegral (readWord16be n s)
254+
255+ | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
256+
257+ | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
258+
259+ | otherwise = error "readWord32be: tried to read more than 32 bits"
260+
261+
262+readWord64be :: Int -> S -> Word64
263+readWord64be n s@(S _ o)
264+ -- 8 or fewer bits, use readWord8
265+ | n <= 8 = fromIntegral (readWord8 n s)
266+
267+ -- 16 or fewer bits, use readWord16be
268+ | n <= 16 = fromIntegral (readWord16be n s)
269+
270+ | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
271+
272+ | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
273+
274+ | otherwise = error "readWord64be: tried to read more than 64 bits"
275+
276+
277+readByteString :: Int -> S -> ByteString
278+readByteString n s@(S bs o)
279+ -- no offset, easy.
280+ | o == 0 = unsafeTake n bs
281+ -- offset. ugg. this is really naive and slow. but also pretty easy :)
282+ | otherwise = B.pack (P.map (readWord8 8) (P.take n (iterate (incS 8) s)))
283+
173284readWithoutOffset :: (Bits a, Num a)
174285 => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
175−readWithoutOffset s@(S bs o) shifterL shifterR n
286+readWithoutOffset (S bs o) shifterL shifterR n
176287 | o /= 0 = error "readWithoutOffset: there is an offset"
177288
178289 | bit_offset n == 0 && byte_offset n <= 4 =
@@ -196,8 +307,8 @@ readWithoutOffset s@(S bs o) shifterL shifterR n
196307 in w
197308
198309readWithOffset :: (Bits a, Num a)
199− => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
200−readWithOffset s@(S bs o) shifterL shifterR n
310+ => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
311+readWithOffset (S bs o) shifterL shifterR n
201312 | n <= 64 = let bits_in_msb = 8 - o
202313 (n',top) = (n - bits_in_msb
203314 , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shifterL` n')
@@ -217,38 +328,9 @@ readWithOffset s@(S bs o) shifterL shifterR n
217328 w = top .|. mseg .|. last
218329 in w
219330
220−
221−readWord32be :: Int -> S -> Word32
222−readWord32be n s@(S bs o)
223− -- 8 or fewer bits, use readWord8
224− | n <= 8 = fromIntegral (readWord8 n s)
225−
226− -- 16 or fewer bits, use readWord16be
227− | n <= 16 = fromIntegral (readWord16be n s)
228−
229− | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
230−
231− | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
232−
233− | otherwise = error "readWord32be: tried to read more than 32 bits"
234−
235−
236−readWord64be :: Int -> S -> Word64
237−readWord64be n s@(S bs o)
238− -- 8 or fewer bits, use readWord8
239− | n <= 8 = fromIntegral (readWord8 n s)
240−
241− -- 16 or fewer bits, use readWord16be
242− | n <= 16 = fromIntegral (readWord16be n s)
243−
244− | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
245−
246− | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
247−
248− | otherwise = error "readWord64be: tried to read more than 64 bits"
249−
250331------------------------------------------------------------------------
251−
332+-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'
333+-- for how to run it.
252334newtype BitGet a = B { runState :: S -> Get (S,a) }
253335
254336instance Monad BitGet where
@@ -264,6 +346,8 @@ instance Applicative BitGet where
264346 pure x = return x
265347 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
266348
349+-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
350+-- been partially consumed it will be discarded once 'runBitGet' is finished.
267351runBitGet :: BitGet a -> Get a
268352runBitGet bg = do
269353 (_,a) <- runState bg (S B.empty 0)
@@ -281,47 +365,59 @@ modifyState f = B $ \s -> return (f s)
281365-- | Make sure there are at least @n@ bits.
282366ensureBits :: Int -> BitGet ()
283367ensureBits n = do
284− s@(S bs o) <- getState
368+ (S bs o) <- getState
285369 if n <= (B.length bs * 8 - o)
286370 then return ()
287371 else do let currentBits = B.length bs * 8 - o
288372 let byteCount = (n - currentBits + 7) `div` 8
289− B $ \s -> do bs' <- B.getByteString byteCount
373+ B $ \_ -> do bs' <- B.getByteString byteCount
290374 return (S (bs`append`bs') o, ())
291375
376+-- | Get 1 bit as a 'Bool'.
292377getBool :: BitGet Bool
293378getBool = block bool
294379
380+-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
295381getWord8 :: Int -> BitGet Word8
296382getWord8 n = block (word8 n)
297383
384+-- | Get @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
298385getWord16be :: Int -> BitGet Word16
299386getWord16be n = block (word16be n)
300387
388+-- | Get @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
301389getWord32be :: Int -> BitGet Word32
302390getWord32be n = block (word32be n)
303391
392+-- | Get @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
304393getWord64be :: Int -> BitGet Word64
305394getWord64be n = block (word64be n)
306395
396+-- | Get @n@ bytes as a 'ByteString'.
307397getByteString :: Int -> BitGet ByteString
308398getByteString n = block (byteString n)
309399
400+-- | Read a 1 bit 'Bool'.
310401bool :: Block Bool
311402bool = Block 1 readBool
312403
404+-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
313405word8 :: Int -> Block Word8
314406word8 n = Block n (readWord8 n)
315407
408+-- | Read @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
316409word16be :: Int -> Block Word16
317410word16be n = Block n (readWord16be n)
318411
412+-- | Read @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
319413word32be :: Int -> Block Word32
320414word32be n = Block n (readWord32be n)
321415
416+-- | Read @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
322417word64be :: Int -> Block Word64
323418word64be n = Block n (readWord64be n)
324419
420+-- | Read @n@ bytes as a 'ByteString'.
325421byteString :: Int -> Block ByteString
326422byteString n = Block (n*8) (readByteString n)
327423