From fda0a74785ab6da03f98be513de5cd3bada1359d Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Sun, 9 Jan 2011 14:40:09 +0900
Subject: [PATCH] WVBitstream

---
 Codec/Audio/WavPack/Metadata.hs | 25 ++++++++++++++++++++++---
 examples/WvInfo.hs              | 26 +++++++++++++++++++++++---
 2 files changed, 45 insertions(+), 6 deletions(-)

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index 09bceb8..def1cb3 100644
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -13,6 +13,7 @@ module Codec.Audio.WavPack.Metadata
     , DecorrWeights(..)
     , DecorrSamples(..)
     , EntropyVars(..)
+    , WVBitstream(..)
     , RIFFHeader(..)
     , RIFFTrailer(..)
     , ConfigInfo(..)
@@ -105,6 +106,7 @@ instance Binary SubBlock where
           getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights)
           getSubBlock 0x04 = fmap SubBlock (get ∷ Get DecorrSamples)
           getSubBlock 0x05 = fmap SubBlock (get ∷ Get EntropyVars  )
+          getSubBlock 0x0A = fmap SubBlock (get ∷ Get WVBitstream  )
           getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader   )
           getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer  )
           getSubBlock 0x25 = fmap SubBlock (get ∷ Get ConfigInfo   )
@@ -127,7 +129,7 @@ data Dummy
     = Dummy {
         -- | Must be less than 2^25 bytes long due to the limitation
         -- of WavPack specification.
-        dumSize ∷ Word32
+        dumSize ∷ !Word32
       }
     deriving (Eq, Show, Typeable)
 
@@ -269,15 +271,31 @@ instance Binary EntropyVars where
                    med2 ← fmap exp2 getWord16le
                    return (med0, med1, med2)
 
+-- | WV Bitstream
+data WVBitstream
+    = WVBitstream {
+        wvStream ∷ !L.ByteString
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata WVBitstream where
+    metaID _ = 0x0A
+    metaSize = fromIntegral ∘ L.length ∘ wvStream
+
+instance Binary WVBitstream where
+    put = putLazyByteString ∘ wvStream
+    get = fmap WVBitstream getRemainingLazyByteString
+
 -- | RIFF header for .wav files (before audio)
 data RIFFHeader
     = RIFFHeader {
-        riffHeader ∷ L.ByteString
+        riffHeader ∷ !L.ByteString
       }
     deriving (Eq, Show, Typeable)
 
 instance Metadata RIFFHeader where
     metaID _ = 0x21
+    metaSize = fromIntegral ∘ L.length ∘ riffHeader
 
 instance Binary RIFFHeader where
     put = putLazyByteString ∘ riffHeader
@@ -286,12 +304,13 @@ instance Binary RIFFHeader where
 -- | RIFF trailer for .wav files (after audio)
 data RIFFTrailer
     = RIFFTrailer {
-        riffTrailer ∷ L.ByteString
+        riffTrailer ∷ !L.ByteString
       }
     deriving (Eq, Show, Typeable)
 
 instance Metadata RIFFTrailer where
     metaID _ = 0x22
+    metaSize = fromIntegral ∘ L.length ∘ riffTrailer
 
 instance Binary RIFFTrailer where
     put = putLazyByteString ∘ riffTrailer
diff --git a/examples/WvInfo.hs b/examples/WvInfo.hs
index 5e0b86f..75c13ab 100644
--- a/examples/WvInfo.hs
+++ b/examples/WvInfo.hs
@@ -4,21 +4,41 @@
   #-}
 module Main where
 import Codec.Audio.WavPack.Block
+import Codec.Audio.WavPack.Metadata
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Strict as S
+import Data.Maybe
+import Prelude.Unicode
 import System.Environment
 import System.IO
 
 main ∷ IO ()
 main = do [wvFile] ← getArgs
-          wvStream ← L.readFile wvFile
+          wvData   ← L.readFile wvFile
           hSetBuffering stdout NoBuffering
-          showWvInfo wvStream
+          showWvInfo wvData
 
 showWvInfo ∷ L.ByteString → IO ()
 showWvInfo stream
     = case findNextBlock stream of
         (# S.Just block, _ #)
-            → print block
+            → printBlock block
         (# S.Nothing   , _ #)
             → fail "Can't find any WavPack block headers."
+
+printBlock ∷ Block → IO ()
+printBlock b
+    = do putStrLn "- Block header:"
+         print $ blockHeader b
+         putStrLn "- Block metadata sub-blocks:"
+         mapM_ printSub $ blockMetadata b
+    where
+      printSub ∷ SubBlock → IO ()
+      printSub sub
+          | isJust (fromSubBlock sub ∷ Maybe WVBitstream)
+              = putStrLn ( "(WV Bitstream omitted: " ⧺
+                           show (metaSize sub) ⧺
+                           " bytes)"
+                         )
+          | otherwise
+              = print sub
-- 
2.40.0