RIFFHeader and RIFFTrailer

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

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index 77901f445aedf505ab7e4ce117ae026ebdd147c7..bc1d07c3bd2059f940546b9fc2ad4bb18a65f00a 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -9,6 +9,8 @@ module Codec.Audio.WavPack.Metadata
     , SubBlock
 
     , Dummy(..)
+    , RIFFHeader(..)
+    , RIFFTrailer(..)
     , Unknown(..)
     )
     where
@@ -86,6 +88,8 @@ instance Binary SubBlock where
         where
           getSubBlock ∷ Word8 → Get SubBlock
           getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy)
+          getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader)
+          getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer)
           getSubBlock unknownID
               = if unknownID .&. 0x20 ≡ 0 then
                     fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
@@ -117,6 +121,34 @@ instance Binary Dummy where
     put = putLazyByteString ∘ flip L.replicate 0x00 ∘ fromIntegral ∘ dumSize
     get = fmap (Dummy ∘ fromIntegral) remaining
 
+-- | RIFF header for .wav files (before audio)
+data RIFFHeader
+    = RIFFHeader {
+        riffHeader ∷ L.ByteString
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata RIFFHeader where
+    metaID _ = 0x21
+
+instance Binary RIFFHeader where
+    put = putLazyByteString ∘ riffHeader
+    get = fmap RIFFHeader getRemainingLazyByteString
+
+-- | RIFF trailer for .wav files (after audio)
+data RIFFTrailer
+    = RIFFTrailer {
+        riffTrailer ∷ L.ByteString
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata RIFFTrailer where
+    metaID _ = 0x22
+
+instance Binary RIFFTrailer where
+    put = putLazyByteString ∘ riffTrailer
+    get = fmap RIFFTrailer getRemainingLazyByteString
+
 -- | Unknown but optional metadata found in the WavPack block.
 data Unknown
     = Unknown {
@@ -130,7 +162,6 @@ data Unknown
 
 instance Metadata Unknown where
     metaID   = unkID
-    metaSize = fromIntegral ∘ L.length ∘ unkData
 
 instance Binary Unknown where
     put = putLazyByteString ∘ unkData