, BlockHeader(..)
, BlockFlags(..)
- , findNextBlock
+ , readBlocks
)
where
import Codec.Audio.WavPack.Metadata
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 {
decodeSamplingRate 0x0E = S.Just 192000
decodeSamplingRate _ = S.Nothing
--- | Find a WavPack block in a given stream. Returns 'S.Nothing' if no
--- blocks are found.
-findNextBlock ∷ L.ByteString -- ^ the input
- → (# S.Maybe Block, L.ByteString #) -- ^ the rest of input
+-- | Read WavPack blocks in a given stream lazily.
+readBlocks ∷ L.ByteString → [Block]
+readBlocks src
+ = case findNextBlock src of
+ (# S.Just block, src' #)
+ → block : readBlocks src'
+ (# S.Nothing, _ #)
+ → []
+
+findNextBlock ∷ L.ByteString
+ → (# S.Maybe Block, L.ByteString #)
findNextBlock src
= case L.uncons src of
Nothing
-- 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