import Data.Binary.BitPut (putBit, putNBits, runBitPut)
import Data.Binary.Get
import Data.Binary.Put
-import qualified Data.Binary.Strict.BitGet as BG
import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
+import qualified Data.Binary.Strict.BitGet as BG
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Strict as S
, blockMetadata = subs
}
-getSubBlocks ∷ Word32 → Get [SubBlock]
-getSubBlocks 0 = return []
+-- Be aware; the Get monad is like a strict State monad so the entire
+-- sub-blocks are parsed at once. This might not be what you want
+-- (like me).
+getSubBlocks ∷ Integral n ⇒ n → Get [SubBlock]
+getSubBlocks 0 = return $! []
getSubBlocks !blockSize
= do before ← bytesRead
meta ← get
rest ← getSubBlocks $ blockSize - fromIntegral (after - before)
return (meta : rest)
+-- The lazy version.
+getSubBlocksLazily ∷ Integral n
+ ⇒ L.ByteString
+ → n
+ → (# [SubBlock], L.ByteString #)
+getSubBlocksLazily src 0 = (# [], src #)
+getSubBlocksLazily src !blockSize
+ = let (sub, src', consumed)
+ = runGetState get src 0
+ (# subs, src'' #)
+ = getSubBlocksLazily src' $
+ blockSize - fromIntegral consumed
+ in
+ (# sub : subs, src'' #)
+
-- | The preamble to every block in both the .wv and .wvc files.
data BlockHeader
= BlockHeader {
-- header we can accept.
→ case runGet get header of
bh → if isGoodHeader bh then
- case runGetState (getSubBlocks $ bhSize bh) rest 0 of
- (subs, rest', _)
+ case getSubBlocksLazily rest $ bhSize bh of
+ (# subs, rest' #)
→ let !blk = Block {
blockHeader = bh
, blockMetadata = subs