git.iko.soy/binary-bits
on master help sign in
BitOrder selection for Put
af483e8Sylvain Henry
Data/Binary/Bits/BitOrder.hs+18
compare with master
unifiedsplit
@@ -11,6 +11,7 @@
11
11
12module Data.Binary.Bits.BitOrder
12module Data.Binary.Bits.BitOrder
13 ( BitOrder(..)
13 ( BitOrder(..)
14+ , BitOrderable(..)
14 )
15 )
15where
16where
16
17
@@ -27,3 +28,20 @@ data BitOrder
27 | BL -- ^ Big-endian bytes, little-endian bits
28 | BL -- ^ Big-endian bytes, little-endian bits
28 | LL -- ^ Little-endian bytes and bits
29 | LL -- ^ Little-endian bytes and bits
29 deriving (Show)
30 deriving (Show)
31+
32+
33+class Monad m => BitOrderable m where
34+ -- | Set the current bit-order
35+ setBitOrder :: BitOrder -> m ()
36+
37+ -- | Retrieve the current bit-order
38+ getBitOrder :: m BitOrder
39+
40+ -- | Perform the given action with the given bit-order
41+ withBitOrder :: BitOrder -> m a -> m a
42+ withBitOrder bo act = do
43+ bo' <- getBitOrder
44+ setBitOrder bo
45+ r <- act
46+ setBitOrder bo'
47+ return r
Data/Binary/Bits/Get.hs+9−27
@@ -57,9 +57,6 @@ module Data.Binary.Bits.Get
57
57
58 BitGet
58 BitGet
59 , runBitGet
59 , runBitGet
60− , getBitOrder
61− , selectBitOrder
62− , withBitOrder
63
60
64 -- ** Get bytes
61 -- ** Get bytes
65 , getBool
62 , getBool
@@ -176,10 +173,6 @@ incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
176 !d = byte_offset o'
173 !d = byte_offset o'
177 !n' = bit_offset o'
174 !n' = bit_offset o'
178
175
179−-- | Select the bit ordering
180−selectBitOrderS :: BitOrder -> S -> S
181−selectBitOrderS bo (S bs o _) = S bs o bo
182−
183-- | Read a single bit
176-- | Read a single bit
184readBool :: S -> Bool
177readBool :: S -> Bool
185readBool (S bs o bo) = case bo of
178readBool (S bs o bo) = case bo of
@@ -288,6 +281,15 @@ instance Applicative BitGet where
288 pure x = return x
281 pure x = return x
289 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
282 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
290
283
284+instance BitOrderable BitGet where
285+ setBitOrder bo = do
286+ (S bs o _) <- getState
287+ putState (S bs o bo)
288+
289+ getBitOrder = do
290+ (S _ _ bo) <- getState
291+ return bo
292+
291-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
293-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
292-- been partially consumed it will be discarded once 'runBitGet' is finished.
294-- been partially consumed it will be discarded once 'runBitGet' is finished.
293runBitGet :: BitGet a -> Get a
295runBitGet :: BitGet a -> Get a
@@ -322,13 +324,6 @@ withState f = do
322 s <- getState
324 s <- getState
323 putState $! f s
325 putState $! f s
324
326
325−-- | Get the bit ordering
326−getBitOrder :: BitGet BitOrder
327−getBitOrder = do
328− (S _ _ bo) <- getState
329− return bo
330−
331−
332-- | Make sure there are at least @n@ bits.
327-- | Make sure there are at least @n@ bits.
333ensureBits :: Int -> BitGet ()
328ensureBits :: Int -> BitGet ()
334ensureBits n = do
329ensureBits n = do
@@ -355,19 +350,6 @@ alignByte = do
355 when (o /= 0) $
350 when (o /= 0) $
356 skipBits (8-o)
351 skipBits (8-o)
357
352
358−-- | Select the bit ordering
359−selectBitOrder :: BitOrder -> BitGet ()
360−selectBitOrder = withState . selectBitOrderS
361−
362−withBitOrder :: BitOrder -> BitGet a -> BitGet a
363−withBitOrder bo f = do
364− bo' <- getBitOrder
365− selectBitOrder bo
366− r <- f
367− selectBitOrder bo'
368− return r
369−
370−
371
353
372-- | Test whether all input has been consumed, i.e. there are no remaining
354-- | Test whether all input has been consumed, i.e. there are no remaining
373-- undecoded bytes.
355-- undecoded bytes.
Data/Binary/Bits/Put.hs+5
@@ -189,3 +189,8 @@ instance Monad BitPut where
189 PairS b s'' = run (k a) s'
189 PairS b s'' = run (k a) s'
190 in PairS b s''
190 in PairS b s''
191 return x = BitPut $ \s -> PairS x s
191 return x = BitPut $ \s -> PairS x s
192+
193+instance BitOrderable BitPut where
194+ setBitOrder bo = BitPut $ \(S bu b o _) -> PairS () (S bu b o bo)
195+
196+ getBitOrder = BitPut $ \s@(S _ _ _ bo) -> PairS bo s