WVBitstream

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index 09bceb873927fdc0c8da3fd7a34cd45d41f2792e..def1cb3c422b14d085af14ed9568d5797117df74 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -13,6 +13,7 @@ module Codec.Audio.WavPack.Metadata
     , DecorrWeights(..)
     , DecorrSamples(..)
     , EntropyVars(..)
     , DecorrWeights(..)
     , DecorrSamples(..)
     , EntropyVars(..)

+    , WVBitstream(..)

     , RIFFHeader(..)
     , RIFFTrailer(..)
     , ConfigInfo(..)
     , 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 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   )
           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.
     = Dummy {
         -- | Must be less than 2^25 bytes long due to the limitation
         -- of WavPack specification.

-        dumSize ∷ Word32
+        dumSize ∷ !Word32

       }
     deriving (Eq, Show, Typeable)
 
       }
     deriving (Eq, Show, Typeable)
 


@@ -269,15 +271,31 @@ instance Binary EntropyVars where
                    med2 ← fmap exp2 getWord16le
                    return (med0, med1, med2)
 
                    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 {
 -- | 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
       }
     deriving (Eq, Show, Typeable)
 
 instance Metadata RIFFHeader where
     metaID _ = 0x21

+    metaSize = fromIntegral ∘ L.length ∘ riffHeader

 
 instance Binary RIFFHeader where
     put = putLazyByteString ∘ 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 {
 -- | 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
       }
     deriving (Eq, Show, Typeable)
 
 instance Metadata RIFFTrailer where
     metaID _ = 0x22

+    metaSize = fromIntegral ∘ L.length ∘ riffTrailer

 
 instance Binary RIFFTrailer where
     put = putLazyByteString ∘ riffTrailer
 
 instance Binary RIFFTrailer where
     put = putLazyByteString ∘ riffTrailer

diff --git a/examples/WvInfo.hs b/examples/WvInfo.hs
index 5e0b86fbe62bdbd020e6dc76bbbbcf78752808a3..75c13ab3076510fefdb241e96c152d6fb3be79ab 100644 (file)
--- a/examples/WvInfo.hs
+++ b/examples/WvInfo.hs
@@ -4,21 +4,41 @@
   #-}
 module Main where
 import Codec.Audio.WavPack.Block
   #-}
 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 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
 import System.Environment
 import System.IO
 
 main ∷ IO ()
 main = do [wvFile] ← getArgs

-          wvStream ← L.readFile wvFile
+          wvData   ← L.readFile wvFile

           hSetBuffering stdout NoBuffering
           hSetBuffering stdout NoBuffering

-          showWvInfo wvStream
+          showWvInfo wvData

 
 showWvInfo ∷ L.ByteString → IO ()
 showWvInfo stream
     = case findNextBlock stream of
         (# S.Just block, _ #)
 
 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."
         (# 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