git.iko.soy/binary-bits
on master help sign in
Implement joinGet and joinPut
4d12f0bLennart Kolmodin
BitsGet.hs+14
compare with master
unifiedsplit
@@ -5,6 +5,8 @@ module BitsGet
5 , runBitGet
5 , runBitGet
6 , runBitGetSimple
6 , runBitGetSimple
7 , BitGet
7 , BitGet
8+ , joinGet
9+
8 , getBool
10 , getBool
9 , getWord8
11 , getWord8
10 , getWord16be
12 , getWord16be
@@ -65,6 +67,18 @@ incS (S bs n) o =
65 let (d,n') = divMod (n+o) 8
67 let (d,n') = divMod (n+o) 8
66 in S (unsafeDrop d bs) n'
68 in S (unsafeDrop d bs) n'
67
69
70+joinGet :: Get a -> BitGet a
71+joinGet m = C $ \s@(S bs o) kf ks -> do
72+ -- put back the rest of the current chunk
73+ case o of
74+ 0 -> putS bs
75+ _ -> putS (unsafeTail bs)
76+ -- run the get function
77+ a <- m
78+ -- whatever is left, get it and us it as our state
79+ bs' <- getS
80+ let s' = S bs' 0
81+ ks s' a
68
82
69readByteString :: S -> Int -> T ByteString S
83readByteString :: S -> Int -> T ByteString S
70readByteString s@(S bs o) n
84readByteString s@(S bs o) n
BitsPut.hs+16−3
@@ -1,6 +1,7 @@
1module BitsPut
1module BitsPut
2 ( BitPut
2 ( BitPut
3 , runBitPut
3 , runBitPut
4+ , joinPut
4
5
5 , putBool
6 , putBool
6 , putWord8
7 , putWord8
@@ -12,6 +13,8 @@ module BitsPut
12import qualified Data.Binary.Builder as B
13import qualified Data.Binary.Builder as B
13import Data.Binary.Builder ( Builder )
14import Data.Binary.Builder ( Builder )
14import qualified Data.Binary.Put as Put
15import qualified Data.Binary.Put as Put
16+import Data.Binary.Put ( Put )
17+
15import Data.ByteString
18import Data.ByteString
16
19
17import Data.Bits
20import Data.Bits
@@ -74,18 +77,28 @@ putWord64be :: Int -> Word64 -> BitPut ()
74putWord64be n w
77putWord64be n w
75 | n <= 16 = putWord16be n (fromIntegral w)
78 | n <= 16 = putWord16be n (fromIntegral w)
76
79
80+joinPut :: Put -> BitPut ()
81+joinPut m = BitPut $ \s0 -> PairS () $
82+ let (S b0 _ _) = flushIncomplete s0
83+ b = Put.execPut m
84+ in (S (b0`mappend`b) 0 0)
85+
77flush :: S -> S
86flush :: S -> S
78flush s@(S b w o)
87flush s@(S b w o)
79 | o > 8 = error "flush: offset > 8"
88 | o > 8 = error "flush: offset > 8"
80 | o == 8 = S (b `mappend` B.singleton w) 0 0
89 | o == 8 = S (b `mappend` B.singleton w) 0 0
81 | otherwise = s
90 | otherwise = s
82
91
92+flushIncomplete :: S -> S
93+flushIncomplete s@(S b w o)
94+ | o == 0 = s
95+ | otherwise = (S (b `mappend` B.singleton w) 0 0)
96+
83runBitPut :: BitPut () -> Put.Put
97runBitPut :: BitPut () -> Put.Put
84runBitPut m = Put.putBuilder b'
98runBitPut m = Put.putBuilder b'
85 where
99 where
86− PairS _ (S b t o) = run m (S mempty 0 0)
100+ PairS _ s@(S b t o) = run m (S mempty 0 0)
87− b' | o == 0 = b
101+ (S b' _ _) = flushIncomplete s
88− | otherwise = b `mappend` B.singleton t
89
102
90instance Monad BitPut where
103instance Monad BitPut where
91 m >>= k = BitPut $ \s ->
104 m >>= k = BitPut $ \s ->