git.iko.soy/binary-bits
on master help sign in
BitOrder selection for Put
commitaf483e8026de5dda7a4a4e05a826e1d0c0ef0c9c authorSylvain Henry <hsyl20@gmail.com> dateFri 6 Mar 2015, 14:49 (12 years ago) parenta64cb3b
3 files changed+32−27
compare with master
unifiedsplit
Data/Binary/Bits/BitOrder.hs+18 Data/Binary/Bits/Get.hs+9−27 Data/Binary/Bits/Put.hs+5
Data/Binary/Bits/BitOrder.hs+18
@@ -11,6 +11,7 @@
1111
1212module Data.Binary.Bits.BitOrder
1313 ( BitOrder(..)
14+ , BitOrderable(..)
1415 )
1516where
1617
@@ -27,3 +28,20 @@ data BitOrder
2728 | BL -- ^ Big-endian bytes, little-endian bits
2829 | LL -- ^ Little-endian bytes and bits
2930 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
5757
5858 BitGet
5959 , runBitGet
60− , getBitOrder
61− , selectBitOrder
62− , withBitOrder
6360
6461 -- ** Get bytes
6562 , getBool
@@ -176,10 +173,6 @@ incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
176173 !d = byte_offset o'
177174 !n' = bit_offset o'
178175
179−-- | Select the bit ordering
180−selectBitOrderS :: BitOrder -> S -> S
181−selectBitOrderS bo (S bs o _) = S bs o bo
182−
183176-- | Read a single bit
184177readBool :: S -> Bool
185178readBool (S bs o bo) = case bo of
@@ -288,6 +281,15 @@ instance Applicative BitGet where
288281 pure x = return x
289282 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
290283
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+
291293-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
292294-- been partially consumed it will be discarded once 'runBitGet' is finished.
293295runBitGet :: BitGet a -> Get a
@@ -322,13 +324,6 @@ withState f = do
322324 s <- getState
323325 putState $! f s
324326
325−-- | Get the bit ordering
326−getBitOrder :: BitGet BitOrder
327−getBitOrder = do
328− (S _ _ bo) <- getState
329− return bo
330−
331−
332327-- | Make sure there are at least @n@ bits.
333328ensureBits :: Int -> BitGet ()
334329ensureBits n = do
@@ -355,19 +350,6 @@ alignByte = do
355350 when (o /= 0) $
356351 skipBits (8-o)
357352
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−
371353
372354-- | Test whether all input has been consumed, i.e. there are no remaining
373355-- undecoded bytes.
Data/Binary/Bits/Put.hs+5
@@ -189,3 +189,8 @@ instance Monad BitPut where
189189 PairS b s'' = run (k a) s'
190190 in PairS b s''
191191 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