git.iko.soy/binary-bits
on master help sign in
Remove error handling continuation.
8449c3dLennart Kolmodin
Data/Binary/Bits/Get.hs+15−43
compare with master
unifiedsplit
@@ -5,7 +5,6 @@ module Data.Binary.Bits.Get
5 , runBitGet
5 , runBitGet
6 , runBitGetSimple
6 , runBitGetSimple
7 , BitGet
7 , BitGet
8− -- , joinGet
9
8
10 , getBool
9 , getBool
11 , getWord8
10 , getWord8
@@ -36,7 +35,7 @@ import Data.List as List ( reverse )
36import Control.Applicative
35import Control.Applicative
37
36
38#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
37#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
39−import GHC.Base hiding ( (:*:) )
38+import GHC.Base
40import GHC.Word
39import GHC.Word
41import GHC.Int
40import GHC.Int
42#endif
41#endif
@@ -70,21 +69,6 @@ incS (S bs n) o =
70 let (d,n') = divMod (n+o) 8
69 let (d,n') = divMod (n+o) 8
71 in S (unsafeDrop d bs) n'
70 in S (unsafeDrop d bs) n'
72
71
73−{-
74−joinGet :: Get a -> BitGet a
75−joinGet m = C $ \s@(S bs o) kf ks -> do
76− -- put back the rest of the current chunk
77− case o of
78− 0 -> putS bs
79− _ -> putS (unsafeTail bs)
80− -- run the get function
81− a <- m
82− -- whatever is left, get it and us it as our state
83− bs' <- getS
84− let s' = S bs' 0
85− ks s' a
86−-}
87−
88readByteString :: S -> Int -> T ByteString S
72readByteString :: S -> Int -> T ByteString S
89readByteString s@(S bs o) n
73readByteString s@(S bs o) n
90 | o == 0 = unsafeTake n bs :*: (S (unsafeDrop n bs) 0)
74 | o == 0 = unsafeTake n bs :*: (S (unsafeDrop n bs) 0)
@@ -228,17 +212,15 @@ readWord64be s@(S bs o) n
228-- unrolled codensity/state monad
212-- unrolled codensity/state monad
229newtype BitGet a = C { runCont :: forall r.
213newtype BitGet a = C { runCont :: forall r.
230 S ->
214 S ->
231− Failure r ->
232 Success a r ->
215 Success a r ->
233− Get (Either String r) }
216+ Get r }
234
217
235−type Failure r = String -> Get (Either String r)
236−type Success a r = S -> a -> Get (Either String r)
218+type Success a r = S -> a -> Get r
237
219
238instance Monad BitGet where
220instance Monad BitGet where
239− return x = C $ \s kf ks -> ks s x
221+ return x = C $ \s ks -> ks s x
240− fail str = C $ \s kf ks -> kf str
222+ fail str = C $ \s ks -> fail str
241− (C c) >>= f = C $ \s kf ks -> c s kf (\s' a -> runCont (f a) s' kf ks)
223+ (C c) >>= f = C $ \s ks -> c s (\s' a -> runCont (f a) s' ks)
242
224
243instance Functor BitGet where
225instance Functor BitGet where
244 fmap f m = m >>= \a -> return (f a)
226 fmap f m = m >>= \a -> return (f a)
@@ -248,24 +230,14 @@ instance Applicative BitGet where
248 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
230 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
249
231
250runBitGetSimple :: BitGet a -> Get a
232runBitGetSimple :: BitGet a -> Get a
251−runBitGetSimple bg = do
233+runBitGetSimple bg = runBitGet bg
252− v <- runBitGet bg
234+
253− case v of
254− Left err -> fail err
255− Right v -> return v
256−
257−runBitGet :: BitGet a -> Get (Either String a)
235+runBitGet :: BitGet a -> Get a
258−runBitGet bg = do
236+runBitGet bg = runCont bg (S B.empty 0) (\_s a -> return a)
259− let bs = B.empty -- initial state
260− v <- runCont bg (S bs 0) (\str -> return (Left str)) (\s a -> return (Right (s, a)))
261− case v of
262− Left err -> return (Left err)
263− Right ((S _bs' _n), x) -> do
264− return (Right x)
265
237
266-- | Make sure there are at lest @n@ bits.
238-- | Make sure there are at lest @n@ bits.
267ensureBits :: Int -> BitGet ()
239ensureBits :: Int -> BitGet ()
268−ensureBits n = C $ \s kf ks ->
240+ensureBits n = C $ \s ks ->
269 let loop (S bs o) | n <= (B.length bs * 8 - o) = ks (S bs o) ()
241 let loop (S bs o) | n <= (B.length bs * 8 - o) = ks (S bs o) ()
270 | otherwise = do
242 | otherwise = do
271 let currentBits = B.length bs * 8 - o
243 let currentBits = B.length bs * 8 - o
@@ -302,14 +274,14 @@ getByteString n = do
302 in B.take n bs' :*: S (B.drop n bs') 0
274 in B.take n bs' :*: S (B.drop n bs') 0
303
275
304getState :: BitGet S
276getState :: BitGet S
305−getState = C $ \s kf ks -> ks s s
277+getState = C $ \s ks -> ks s s
306
278
307putState :: S -> BitGet ()
279putState :: S -> BitGet ()
308−putState s = C $ \_ kf ks -> ks s ()
280+putState s = C $ \_ ks -> ks s ()
309
281
310modifyState :: (S -> (T a S)) -> BitGet a
282modifyState :: (S -> (T a S)) -> BitGet a
311−modifyState f = C $ \s kf ks -> case f s of
283+modifyState f = C $ \s ks -> case f s of
312− w :*: s' -> ks s' w
284+ w :*: s' -> ks s' w
313
285
314------------------------------------------------------------------------
286------------------------------------------------------------------------
315-- Unchecked shifts, from the package binary
287-- Unchecked shifts, from the package binary