From: PHO <pho@cielonegro.org>
Date: Mon, 10 Jan 2011 18:13:03 +0000 (+0900)
Subject: readBlocks
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=commitdiff_plain;h=98a1dd78c7bb73c5d66f4773b63bbc5b94e7e618

readBlocks
---

diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
index aff1da3..4ecdb7d 100644
--- a/Codec/Audio/WavPack/Block.hs
+++ b/Codec/Audio/WavPack/Block.hs
@@ -9,7 +9,7 @@ module Codec.Audio.WavPack.Block
     , BlockHeader(..)
     , BlockFlags(..)
 
-    , findNextBlock
+    , readBlocks
     )
     where
 import Codec.Audio.WavPack.Metadata
@@ -286,10 +286,17 @@ decodeSamplingRate 0x0D = S.Just  96000
 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
diff --git a/examples/WvInfo.hs b/examples/WvInfo.hs
index 75c13ab..6631c7b 100644
--- a/examples/WvInfo.hs
+++ b/examples/WvInfo.hs
@@ -1,12 +1,10 @@
 {-# LANGUAGE
-    UnboxedTuples
-  , UnicodeSyntax
+    UnicodeSyntax
   #-}
 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
@@ -16,19 +14,13 @@ main ∷ IO ()
 main = do [wvFile] ← getArgs
           wvData   ← L.readFile wvFile
           hSetBuffering stdout NoBuffering
-          showWvInfo wvData
-
-showWvInfo ∷ L.ByteString → IO ()
-showWvInfo stream
-    = case findNextBlock stream of
-        (# S.Just block, _ #)
-            → printBlock block
-        (# S.Nothing   , _ #)
-            → fail "Can't find any WavPack block headers."
+          mapM_ printBlock $ readBlocks wvData
+          putStrLn "* End of WavPack blocks"
 
 printBlock ∷ Block → IO ()
 printBlock b
-    = do putStrLn "- Block header:"
+    = do putStrLn "* WavPack Block"
+         putStrLn "- Block header:"
          print $ blockHeader b
          putStrLn "- Block metadata sub-blocks:"
          mapM_ printSub $ blockMetadata b
@@ -42,3 +34,18 @@ printBlock b
                          )
           | otherwise
               = print sub
+
+{- % du -sh 01.wv
+   15716
+
+   When compiled with -O0:
+   % time ./dist/build/hs-wvinfo/hs-wvinfo 01.wv > /dev/null
+   1.49s user 2.12s system 98% cpu 3.664 total
+
+   When compiled with -O2:
+   % time ./dist/build/hs-wvinfo/hs-wvinfo 01.wv > /dev/null
+   1.35s user 2.09s system 97% cpu 3.520 total
+
+   Hmm... quite disappointing...  The stringification is the
+   bottleneck? If so, I can live with that.
+-}