From c819d2f4e89624b68af565e150a73e31149ab4a4 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Tue, 4 Jan 2011 23:37:46 +0900
Subject: [PATCH] WvInfo.hs

---
 Codec/Audio/WavPack/Block.hs | 41 ++++++++++++++++++++++++++++++++----
 GNUmakefile                  |  2 +-
 examples/WvInfo.hs           | 19 +++++++++++++++++
 wavpack.cabal                | 18 ++++++++++++++++
 4 files changed, 75 insertions(+), 5 deletions(-)
 create mode 100644 examples/WvInfo.hs

diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
index e3732ee..8e46be8 100644
--- a/Codec/Audio/WavPack/Block.hs
+++ b/Codec/Audio/WavPack/Block.hs
@@ -5,6 +5,8 @@
 module Codec.Audio.WavPack.Block
     ( BlockHeader(..)
     , BlockFlags(..)
+
+    , findNextHeader 
     )
     where
 import Data.Binary
@@ -15,11 +17,12 @@ import qualified Data.Binary.Strict.BitGet as BG
 import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
+import Prelude.Unicode
 
 -- | The preamble to every block in both the .wv and .wvc files.
 data BlockHeader
     = BlockHeader {
-      -- | size of entire block (minus 8, of course)
+      -- | size of entire block (excluding the header)
         bhSize         ∷ !Word32
       -- | 0x402 to 0x410 are currently valid for decode
       , bhVersion      ∷ !Word16
@@ -37,7 +40,7 @@ data BlockHeader
       -- | number of samples in this block (0 = no audio)
       , bhBlockSamples ∷ !Word32
       -- | various flags for id and decoding
-      , bhFlags        ∷ !BlockHeader
+      , bhFlags        ∷ !BlockFlags
       -- | crc for actual decoded data
       , bhCRC          ∷ !Word32
       }
@@ -49,7 +52,7 @@ instance Binary BlockHeader where
              putWord8 118 -- 'v'
              putWord8 112 -- 'p'
              putWord8 107 -- 'k'
-             putWord32le $ bhSize         bh
+             putWord32le $ bhSize         bh + 32 - 8
              putWord16le $ bhVersion      bh
              putWord8    $ bhTrackNo      bh
              putWord8    $ bhIndexNo      bh
@@ -70,7 +73,7 @@ instance Binary BlockHeader where
              flags        ← get
              crc          ← getWord32le
              return BlockHeader {
-                              bhSize         = size
+                              bhSize         = size + 8 - 32
                             , bhVersion      = version
                             , bhTrackNo      = trackNo
                             , bhIndexNo      = indexNo
@@ -194,3 +197,33 @@ instance Binary BlockFlags where
                                      , bfFalseStereo    = falseStereo
                                      }
              return bf
+
+findNextHeader ∷ L.ByteString → (Maybe BlockHeader, L.ByteString)
+findNextHeader src
+    = case L.uncons src of
+        Nothing
+            → (Nothing, L.empty)
+
+        Just (119, src') -- 'w'
+            → let (header, rest) = L.splitAt 32 src
+               in
+                 case L.length header ≡ 32 of
+                   False
+                       → (Nothing, L.empty)
+
+                   True
+                       → let Just (magicW, header'  ) = L.uncons header
+                             Just (magicV, header'' ) = L.uncons header'
+                             Just (magicP, header''') = L.uncons header''
+                             magicK = L.head header'''
+                         in
+                           if magicW ≡ 119 ∧ magicV ≡ 118 ∧ magicP ≡ 112 ∧ magicK ≡ 107 then
+                               -- Found the magic 'wvpk'.
+                               let bh = runGet get header
+                               in
+                                 (Just bh, rest)
+                           else
+                               findNextHeader src'
+
+        Just (_, src')
+            → findNextHeader src'
diff --git a/GNUmakefile b/GNUmakefile
index a245964..8ec5f1e 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,4 +1,4 @@
-RUN_COMMAND = ./dist/build/hs-esd-player-example/hs-esd-player-example
+RUN_COMMAND = ./dist/build/hs-wvinfo/hs-wvinfo 01.wv
 
 CONFIGURE_ARGS = -O -fbuild-examples
 
diff --git a/examples/WvInfo.hs b/examples/WvInfo.hs
new file mode 100644
index 0000000..78588ab
--- /dev/null
+++ b/examples/WvInfo.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
+module Main where
+import Codec.Audio.WavPack.Block
+import qualified Data.ByteString.Lazy as L
+import System.Environment
+
+main ∷ IO ()
+main = do [wvFile] ← getArgs
+          wvStream ← L.readFile wvFile
+          showWvInfo wvStream
+
+showWvInfo ∷ L.ByteString → IO ()
+showWvInfo stream
+    = case findNextHeader stream of
+        (Just bh, _)
+            → print bh
+        _   → fail "Can't find any WavPack block headers."
diff --git a/wavpack.cabal b/wavpack.cabal
index f17306b..11100bc 100644
--- a/wavpack.cabal
+++ b/wavpack.cabal
@@ -20,6 +20,10 @@ Source-Repository head
     Type: git
     Location: git://git.cielonegro.org/wavpack.git
 
+Flag build-examples
+    Description: Build example programs.
+    Default: False
+
 Library
     Build-Depends:
         base                 == 4.*,
@@ -34,3 +38,17 @@ Library
 
     GHC-Options:
         -Wall
+
+Executable hs-wvinfo
+    if flag(build-examples)
+       Buildable: True
+   else
+       Buildable: False
+
+   HS-Source-Dirs:
+        ., examples
+
+   Main-Is: WvInfo.hs
+
+   GHC-Options:
+        -Wall
-- 
2.40.0