Merge branch 'master' of ssh://github.com/kolmodin/binary-bits

BitsQC.hs

@@ -38,6 +38,20 @@ tests =
   , testGroup "getByteString"
       [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
 
+  , testGroup "getLazyByteString"
+      [ testProperty "getLazyByteString == getByteString"
+                     prop_getLazyByteString_equal_to_ByteString
+      , testProperty "getLazyByteString == getByteString (with shift)"
+                     prop_getLazyByteString_equal_to_ByteString2
+      ]
+
+  , testGroup "isEmpty"
+      [ testProperty "prop_isEmptyOfEmptyEmpty" prop_isEmptyOfEmptyEmpty
+      , testProperty "prop_isEmptyOfNonEmptyEmpty" prop_isEmptyOfNonEmptyEmpty
+      , testProperty "prop_isEmptyOfConsumedEmpty" prop_isEmptyOfConsumedEmpty
+      , testProperty "prop_isEmptyOfNotConsumedNotEmpty" prop_isEmptyOfNotConsumedNotEmpty
+      ]
+
   , testGroup "Fail"
       [ testProperty "monadic fail" prop_fail ]
 
@@ -105,6 +119,35 @@ tests =
       ]
   ]
 
+prop_isEmptyOfEmptyEmpty :: Bool
+prop_isEmptyOfEmptyEmpty = runGet (runBitGet isEmpty) L.empty
+
+prop_isEmptyOfNonEmptyEmpty :: L.ByteString -> Property
+prop_isEmptyOfNonEmptyEmpty bs =
+  not (L.null bs) ==> not (runGet (runBitGet isEmpty) bs)
+
+prop_isEmptyOfConsumedEmpty :: L.ByteString -> Property
+prop_isEmptyOfConsumedEmpty bs =
+  not (L.null bs) ==>
+    runGet (runBitGet (getByteString n >> isEmpty)) bs
+    where n = fromIntegral $ L.length bs
+
+prop_isEmptyOfNotConsumedNotEmpty :: L.ByteString -> Int -> Property
+prop_isEmptyOfNotConsumedNotEmpty bs n =
+  (fromIntegral n) < L.length bs && not (L.null bs) ==>
+    not (runGet (runBitGet (getByteString n >> isEmpty)) bs)
+
+prop_getLazyByteString_equal_to_ByteString :: L.ByteString -> Int -> Property
+prop_getLazyByteString_equal_to_ByteString bs n =
+  (fromIntegral n) <= L.length bs ==>
+    runGet (runBitGet (getLazyByteString (fromIntegral n))) bs ==
+            (L.fromChunks . (:[]) $ runGet (runBitGet (getByteString n)) bs)
+
+prop_getLazyByteString_equal_to_ByteString2 :: L.ByteString -> Int -> Property
+prop_getLazyByteString_equal_to_ByteString2 bs n =
+  (L.length bs > 1) && (fromIntegral n) < L.length bs ==>
+    runGet (runBitGet (getWord8 2 >> getLazyByteString (fromIntegral n))) bs ==
+            (L.fromChunks . (:[]) $ runGet (runBitGet (getWord8 2 >> getByteString n)) bs)
 
 prop_getByteString_negative :: Int -> Property
 prop_getByteString_negative n =

Data/Binary/Bits/Get.hs

@@ -79,10 +79,11 @@ module Data.Binary.Bits.Get
             , byteString
             , Data.Binary.Bits.Get.getByteString
             , Data.Binary.Bits.Get.getLazyByteString
+            , Data.Binary.Bits.Get.isEmpty
 
             ) where
 
-import Data.Binary.Get as B ( runGet, Get, getByteString, getLazyByteString )
+import Data.Binary.Get as B ( runGet, Get, getByteString, getLazyByteString, isEmpty )
 import Data.Binary.Get.Internal as B ( get, put, ensureN )
 
 import Data.ByteString as B
@@ -91,7 +92,6 @@ import Data.ByteString.Unsafe
 
 import Data.Bits
 import Data.Word
-
 import Control.Applicative
 
 import Prelude as P
@@ -416,11 +416,23 @@ getWord64be n = block (word64be n)
 getByteString :: Int -> BitGet ByteString
 getByteString n = block (byteString n)
 
+-- | Get @n@ bytes as a lazy ByteString.
 getLazyByteString :: Int -> BitGet L.ByteString
-getLazyByteString m = B $ \ (S n bs) -> do
-  putBackState n bs
-  lbs <- B.getLazyByteString (fromIntegral m)
-  return (S B.empty 0, lbs)
+getLazyByteString n = do
+  (S _ o) <- getState
+  case o of
+    0 -> B $ \ (S bs o') -> do
+            putBackState bs o'
+            lbs <- B.getLazyByteString (fromIntegral n)
+            return (S B.empty 0, lbs)
+    _ -> L.fromChunks . (:[]) <$> Data.Binary.Bits.Get.getByteString n
+
+-- | Test whether all input has been consumed, i.e. there are no remaining
+-- undecoded bytes.
+isEmpty :: BitGet Bool
+isEmpty = B $ \ (S bs o) -> if B.null bs
+                               then B.isEmpty >>= \e -> return (S bs o, e)
+                               else return (S bs o, False)
 
 -- | Read a 1 bit 'Bool'.
 bool :: Block Bool