RIFFHeader and RIFFTrailer

[wavpack.git] / Codec / Audio / WavPack / Block.hs

diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
index 8b532ade781c83743856b3425ae1acf35e874451..7879cf1147f584164061b747d69ce9770a0d93f7 100644 (file)
--- a/Codec/Audio/WavPack/Block.hs
+++ b/Codec/Audio/WavPack/Block.hs
@@ -44,8 +44,11 @@ instance Binary Block where
                         , 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
@@ -53,6 +56,21 @@ getSubBlocks !blockSize
          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 {
@@ -296,8 +314,8 @@ tryGetBlock src
                               -- 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