sndfile-enumerators 0.8.0 → 0.9.0

raw patch · 13 files changed

+373/−239 lines, 13 filesdep +filepathdep +listlike-instancesdep +vectordep −mutable-iterdep ~iterateePVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, listlike-instances, vector

Dependencies removed: mutable-iter

Dependency ranges changed: iteratee

API changes (from Hackage documentation)

Files

• examples/wave_reader.hs +13/−45
• examples/wave_writer.hs +8/−8
• examples/writer2.hs +7/−7
• sndfile-enumerators.cabal +13/−9
• src/Sound/Iteratee.hs +3/−1
• src/Sound/Iteratee/Base.hs +87/−5
• src/Sound/Iteratee/Codecs.hs +3/−3
• src/Sound/Iteratee/Codecs/Common.hs +52/−55
• src/Sound/Iteratee/Codecs/Raw.hs +5/−12
• src/Sound/Iteratee/Codecs/Wave.hs +58/−63
• src/Sound/Iteratee/Codecs/WaveWriter.hs +19/−23
• src/Sound/Iteratee/File.hs +86/−0
• src/Sound/Iteratee/Writer.hs +19/−8

@@ -1,59 +1,27 @@ -- Read a wave file and return some information about it.+{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE BangPatterns #-} module Main where  import Prelude as P -import Sound.Iteratee.Codecs.Wave-import Data.MutableIter-import Data.MutableIter.IOBuffer (IOBuffer)-import qualified Data.MutableIter.IOBuffer as IB-import qualified Data.IntMap as IM-import qualified Data.Iteratee as I-import Data.Word (Word8)-import Control.Monad.CatchIO-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import System+import           Sound.Iteratee+import qualified Data.Vector.Storable as V+import           Data.Iteratee as I+import           Control.Monad.CatchIO+import           System  main :: IO () main = do   args <- getArgs   case args of     [] -> putStrLn "Usage: wave_reader FileName"-    fname:xs -> do+    fname:_ -> do       putStrLn $ "Reading file: " ++ fname-      fileDriverRandom (2^14) (waveReader >>= test) fname-      return ()---- Use the collection of [WAVEDE] returned from waveReader to--- do further processing.  The IntMap has an entry for each type of chunk--- in the wave file.  Read the first format chunk and disply the --- format information, then use the dictProcessData function--- to enumerate over the max_iter iteratee to find the maximum value--- (peak amplitude) in the file.-test :: Maybe (IM.IntMap [WAVEDE])-  -> MIteratee (IOBuffer r Word8) IO ()-test Nothing = liftIO $ putStrLn "No dictionary"-test (Just dict) = do-  fmtm <- dictReadFirstFormat dict-  liftIO . putStrLn $ show fmtm-  maxm <- dictProcessData_ 0 dict max_iter-  liftIO . putStrLn $ show maxm-  return ()---- | As of now (ghc-7.1, mutable-iter-0.6, sndfile-enumerators-0.7)---  ,this version is as fast as max_iter-max_iter2 :: MonadCatchIO m => MIteratee (IOBuffer r Double) m Double-max_iter2 = foldl' (flip (max . abs)) 0+      e <- runAudioIteratee fname maxIter+      print e --- |This version is faster, but lower-level-max_iter :: MIteratee (IOBuffer r Double) IO Double-max_iter = m' 0-  where-    m' !acc = liftI (step acc)-    step acc (I.Chunk buf) = guardNull buf (m' acc) $ do-      val <- lift $ IB.foldl' (flip (max . abs)) acc buf-      m' val-    step acc str = idone acc str+-- | As of now (ghc-7.0.2, mutable-iter-0.6, sndfile-enumerators-0.7)+--  ,this version is as fast as a low-level implementation+maxIter :: MonadCatchIO m => Iteratee (V.Vector Double) m Double+maxIter = foldl' (flip (max . abs)) 0

@@ -5,14 +5,14 @@  module Main where -import Data.MutableIter-import qualified Data.MutableIter.IOBuffer as IB-import Sound.Iteratee.Codecs.Wave-import Sound.Iteratee+import           Data.Iteratee+import qualified Data.Vector.Storable as V+import           Sound.Iteratee.Codecs.Wave+import           Sound.Iteratee import qualified Data.IntMap as IM-import Data.Word (Word8)-import Control.Monad.Trans-import System+import           Data.Word (Word8)+import           Control.Monad.Trans+import           System  main :: IO () main = do@@ -27,7 +27,7 @@ -- Use the collection of [WAVEDE] returned from waveReader to -- do further processing.  In this case, write out a new file with the -- same format.-writer :: FilePath -> Maybe (IM.IntMap [WAVEDE]) -> MIteratee (IB.IOBuffer r Word8) AudioMonad ()+writer :: FilePath -> Maybe (IM.IntMap [WAVEDE]) -> Iteratee (V.Vector Word8) AudioMonad () writer _ Nothing = liftIO $ putStrLn "No dictionary" writer fp (Just dict) = do   fmtm <- dictReadFirstFormat dict

@@ -3,12 +3,12 @@ {-# LANGUAGE BangPatterns, RankNTypes #-} module Main where -import Data.MutableIter-import qualified Data.MutableIter.IOBuffer as IB import Sound.Iteratee.Codecs.Wave import Sound.Iteratee-import qualified Data.Iteratee as I+import           Data.Iteratee as I+import           Data.Iteratee.IO.Handle import qualified Data.IntMap as IM+import qualified Data.Vector.Storable as V import Data.Word (Word8) import Foreign.Storable (Storable) import Control.Monad.Trans@@ -20,14 +20,14 @@  file2Driver :: (MonadCatchIO m, Functor m) =>   (forall r. Maybe (IM.IntMap [WAVEDE])-    -> MIteratee (IB.IOBuffer r Word8) m (MIteratee (IB.IOBuffer r Double) m a))+    -> Iteratee (V.Vector Word8) m (Iteratee (V.Vector Double) m a))   -> FilePath   -> FilePath   -> m a file2Driver i f1 f2 = CIO.bracket   (liftIO $ (openBinaryFile f1 ReadMode >>= \h1 -> openBinaryFile f2 ReadMode >>= \h2 -> return (h1,h2)))   (liftIO . (\(h1, h2) -> hClose h1 >> hClose h2))-  (\(h1,h2) -> (I.run . unwrap) =<< (I.run . unwrap) =<<+  (\(h1,h2) -> (I.run) =<< (I.run) =<<     ( enumHandleRandom defaultChunkLength h1 (waveReader >>= i) >>= \i2 -> enumHandleRandom defaultChunkLength h2 (waveReader >>= \mdict -> i2 >>= embedProc mdict)))  main :: IO ()@@ -42,7 +42,7 @@     _ -> putStrLn "Usage: wave_writer ReadFile1 ReadFile2 WriteFile"  -embedProc :: (MonadCatchIO m, Functor m) => Maybe (IM.IntMap [WAVEDE]) -> MIteratee (IB.IOBuffer r Double) m a -> MIteratee (IB.IOBuffer r Word8) m (MIteratee (IB.IOBuffer r Double) m a)+embedProc :: (MonadCatchIO m, Functor m) => Maybe (IM.IntMap [WAVEDE]) -> Iteratee (V.Vector Double) m a -> Iteratee (V.Vector Word8) m (Iteratee (V.Vector Double) m a) embedProc Nothing i = error "No dictionary" embedProc (Just dict) i = dictProcessData 0 dict i @@ -52,7 +52,7 @@ -- format information, then use the dictProcessData function -- to enumerate over the max_iter iteratee to find the maximum value -- (peak amplitude) in the file.-writer :: FilePath -> Maybe (IM.IntMap [WAVEDE]) -> MIteratee (IB.IOBuffer r Word8) AudioMonad (MIteratee (IB.IOBuffer r Double) AudioMonad ())+writer :: FilePath -> Maybe (IM.IntMap [WAVEDE]) -> Iteratee (V.Vector Word8) AudioMonad (Iteratee (V.Vector Double) AudioMonad ()) writer _ Nothing = error "No Dictionary" writer fp (Just dict) = do   fmtm <- dictReadFirstFormat dict

@@ -1,5 +1,5 @@ Name:		sndfile-enumerators-Version:        0.8.0+Version:        0.9.0 Cabal-Version:  >= 1.2 Description:	encode and decode soundfiles using Iteratees.                 Audio files may be read or written, with classes and @@ -31,22 +31,26 @@  ghc-options:    -Wall    -fexcess-precision+   -O2  build-depends:-   base                      >= 3   && < 5,-   binary                    >= 0.5 && < 0.6,-   containers                >= 0.2 && < 0.5,-   transformers              >= 0.2 && < 0.3,-   iteratee                  >= 0.4 && < 0.9,+   base                      >= 3     && < 5,+   binary                    >= 0.5   && < 0.6,    bytestring                >= 0.9.1 && < 0.10,-   word24                    >= 0.1 && < 0.2,-   mutable-iter              >= 0.1 && < 0.7,-   MonadCatchIO-transformers >= 0.2 && < 0.3+   containers                >= 0.2   && < 0.5,+   iteratee                  >= 0.8.4 && < 0.9,+   filepath                  >= 1.0   && < 2.0,+   listlike-instances        >= 0.1,+   MonadCatchIO-transformers >= 0.2   && < 0.3,+   transformers              >= 0.2   && < 0.3,+   vector                    >= 0.6   && < 0.8,+   word24                    >= 0.1 && < 0.2  exposed-modules:    Sound.Iteratee    Sound.Iteratee.Base    Sound.Iteratee.Codecs    Sound.Iteratee.Codecs.Wave    Sound.Iteratee.Codecs.Raw+   Sound.Iteratee.File    Sound.Iteratee.Writer  other-modules:    Sound.Iteratee.Codecs.WaveWriter

@@ -1,12 +1,14 @@ module Sound.Iteratee (   module Sound.Iteratee.Base,   module Sound.Iteratee.Writer,-  module Sound.Iteratee.Codecs+  module Sound.Iteratee.Codecs,+  module Sound.Iteratee.File )  where  import Sound.Iteratee.Base import Sound.Iteratee.Codecs+import Sound.Iteratee.File import Sound.Iteratee.Writer 

@@ -1,3 +1,8 @@+{-# LANGUAGE ScopedTypeVariables+            ,FlexibleInstances+            ,MultiParamTypeClasses+            ,DeriveDataTypeable #-}+ module Sound.Iteratee.Base (   -- * Types   -- ** Internal types@@ -15,16 +20,36 @@   BitDepth,   FrameCount,   -- ** File Format Types-  SupportedFileFormat (..)+  SupportedFileFormat (..),+  -- ** Exceptions+  UnknownFileTypeException (..),+  CorruptFileException (..),+  MissingFormatException (..),+  -- * Audio iteratees+  getChannel )  where  import Prelude as P -import Control.Monad.Trans.State-import System.IO+import           Control.Exception+import           Control.Monad.Trans.State+import           Control.Monad.IO.Class+import           System.IO+import           Data.Data+import           Data.Nullable+import           Data.NullPoint+import           Data.Iteratee as I+import           Data.Iteratee.Base.ReadableChunk+import           Data.Iteratee.Exception ()+import           Data.ListLike.Vector.Storable ()+import qualified Data.Vector.Storable as V+import           Data.Word +import           Foreign.Marshal.Utils+import           Foreign.ForeignPtr+ -- |Information about the AudioStream data AudioStreamState =   WaveState !(Maybe Handle) !(Maybe AudioFormat) !Integer !Integer !Integer -- ^ Handle, format, Total bytes written, data bytes written, data chunklen offset@@ -34,7 +59,7 @@ -- | An enumeration of all file types supported for reading and writing. data SupportedFileFormat = Raw                            | Wave-                           deriving (Show, Enum, Bounded, Eq)+                           deriving (Show, Enum, Bounded, Eq, Data, Typeable)  -- | Common functions for writing audio data class WritableAudio a where@@ -51,7 +76,7 @@   numberOfChannels :: NumChannels, -- ^Number of channels in the audio data   sampleRate :: SampleRate, -- ^Sample rate of the audio data   bitDepth :: BitDepth -- ^Bit depth of the audio data-  } deriving (Show, Eq)+  } deriving (Show, Eq, Data, Typeable)  type NumChannels = Integer type SampleRate  = Integer@@ -62,3 +87,60 @@  defaultChunkLength :: Int defaultChunkLength = 8190++instance V.Storable a => Nullable (V.Vector a) where+  nullC = V.null++instance V.Storable a => NullPoint (V.Vector a) where+  empty = V.empty++instance ReadableChunk (V.Vector Word8) Word8 where+  readFromPtr src blen = liftIO $ do+    fp <- mallocForeignPtrBytes blen+    withForeignPtr fp $ \dest -> copyBytes dest src blen+    return $ V.unsafeFromForeignPtr fp 0 blen++-- | Operate on a single channel of an audio stream.+getChannel ::+  Monad m+  => Int     -- ^ number of channels+  -> Int     -- ^ channel index (1-based)+  -> Enumeratee (V.Vector Double) (V.Vector Double) m a+getChannel 1        m   = \i -> I.drop m >> convStream getChunk i+getChannel numChans chn = unfoldConvStream mkIter chn+ where+  mkIter drp = do+    I.drop drp+    buf <- getChunk+    let tlen = V.length buf+        (nlen,rest) = quotRem tlen numChans+        newbuf = V.generate nlen (\i -> V.unsafeIndex buf (i*numChans))+    return (rest, newbuf)++-- Audio Exceptions++data UnknownFileTypeException =+  UnknownFileTypeException deriving (Eq, Show, Typeable)++instance Exception UnknownFileTypeException where+  toException = iterExceptionToException+  fromException = iterExceptionFromException++instance IException UnknownFileTypeException where++data CorruptFileException = CorruptFileException deriving (Eq, Show, Typeable)++instance Exception CorruptFileException where+  toException = iterExceptionToException+  fromException = iterExceptionFromException++instance IException CorruptFileException where++data MissingFormatException =+  MissingFormatException deriving (Eq, Show, Typeable)++instance Exception MissingFormatException where+  toException = iterExceptionToException+  fromException = iterExceptionFromException++instance IException MissingFormatException where

@@ -12,16 +12,16 @@ import Sound.Iteratee.Base import Sound.Iteratee.Codecs.Wave import Sound.Iteratee.Codecs.Raw+import Data.Iteratee -import Data.MutableIter-import qualified Data.MutableIter.IOBuffer as IB+import qualified Data.Vector.Storable as V  -- |Get a writer iteratee for a SupportedFileFormat getWriter ::   SupportedFileFormat   -> FilePath   -> AudioFormat-  -> MIteratee (IB.IOBuffer r Double) AudioMonad ()+  -> Iteratee (V.Vector Double) AudioMonad () getWriter Wave = writeWave getWriter Raw  = error "No writer defined for Raw format" 

@@ -9,35 +9,33 @@ where  import Sound.Iteratee.Base-import qualified Data.Iteratee as I-import Data.MutableIter as Iter-import qualified Data.MutableIter.IOBuffer as IB+import           Data.Iteratee as I+import qualified Data.Vector.Storable as V import Foreign import Control.Monad (replicateM, liftM) import Control.Monad.CatchIO-import Control.Monad.IO.Class import Data.Char (chr) import Data.Int.Int24 import Data.Word.Word24+import Data.ListLike.Vector.Storable ()  -- ===================================================== -- useful type synonyms -type IOB m el = IOBuffer m el- -- determine host endian-ness be :: IO Bool be = fmap (==1) $ with (1 :: Word16) (\p -> peekByteOff p 1 :: IO Word8)  -- convenience function to read a 4-byte ASCII string-stringRead4 :: MonadCatchIO m => MIteratee (IOB r Word8) m String-stringRead4 = (liftM . map) (chr . fromIntegral) $ replicateM 4 Iter.head+stringRead4 :: MonadCatchIO m => Iteratee (V.Vector Word8) m String+stringRead4 = (liftM . map) (chr . fromIntegral) $ replicateM 4 I.head -unroll8 :: (MonadCatchIO m) => MIteratee (IOB r Word8) m (Maybe (IOB r Word8))+unroll8 :: (MonadCatchIO m) => Iteratee (V.Vector Word8) m (Maybe (V.Vector Word8)) unroll8 = liftI step   where-  step (I.Chunk buf) = guardNull buf (liftI step) $-                         idone (Just buf) (I.Chunk IB.empty)+  step (I.Chunk buf)+    | V.null buf = liftI step+    | otherwise  = idone (Just buf) (I.Chunk V.empty)   step stream        = idone Nothing stream  -- When unrolling to a Word8, use the specialized unroll8 function@@ -45,37 +43,42 @@ {-# RULES "unroll8" forall n. unroller n = unroll8 #-} unroller :: (Storable a, MonadCatchIO m) =>   Int-  -> MIteratee (IOB r Word8) m (Maybe (IOB r a))+  -> Iteratee (V.Vector Word8) m (Maybe (V.Vector a)) unroller wSize = liftI step   where-  step (I.Chunk buf) = guardNull buf (liftI step) $ do-    len <- liftIO $ IB.length buf-    if len < wSize then liftIO (IB.copyBuffer buf) >>= liftI . step'+  step (I.Chunk buf)+   | V.null buf = liftI step+   | otherwise = do+    let len = V.length buf+    if len < wSize+      then liftI $ step' buf       else if len `rem` wSize == 0               then do-                buf' <- liftIO $ convert_vec buf-                idone (Just buf') (I.Chunk IB.empty)+                let buf' = convert_vec buf+                idone (Just buf') (I.Chunk V.empty)               else let newLen = (len `div` wSize) * wSize+                       h      = convert_vec $ V.take newLen buf+                       t      = V.drop newLen buf                    in do-                      (h, t) <- liftIO $ IB.splitAt buf newLen-                      h' <- liftIO $ convert_vec h-                      idone (Just h') (I.Chunk t)+                      idone (Just h) (I.Chunk t)   step stream = idone Nothing stream-  step' i (I.Chunk buf) = guardNull buf (liftI (step' i)) $ do-    l <- liftIO $ IB.length buf-    iLen <- liftIO $ IB.length i-    newbuf <- liftIO $ IB.append i buf+  step' i (I.Chunk buf)+   | V.null buf = liftI (step' i)+   | otherwise = do+    let l    = V.length buf+        iLen = V.length i+        newbuf = i V.++ buf     if l+iLen < wSize then liftI (step' newbuf)        else do-         newLen <- liftIO $ IB.length newbuf-         let newLen' = (newLen `div` wSize) * wSize-         (h,t) <- liftIO $ IB.splitAt newbuf newLen'-         h' <- liftIO $ convert_vec h-         idone (Just h') (I.Chunk t)+         let newLen  = V.length newbuf+             newLen' = (newLen `div` wSize) * wSize+             h       = convert_vec $ V.take newLen' newbuf+             t       = V.drop newLen' newbuf+         idone (Just h) (I.Chunk t)   step' _i stream  = idone Nothing stream-  convert_vec vec  = IB.castBuffer vec >>= hostToLE+  convert_vec = hostToLE -hostToLE :: (Monad m, Storable a) => IOB r a -> m (IOB r a)+hostToLE :: forall a. Storable a => V.Vector Word8 -> V.Vector a hostToLE vec = let be' = unsafePerformIO be in if be'     then error "wrong endian-ness.  Ask the maintainer to implement hostToLE" {-@@ -84,14 +87,10 @@             in             loop wSize fp len off -}-    else return vec-{--    where-      loop _wSize _fp 0 _off = return vec-      loop wSize fp len off  = do-        FFP.withForeignPtr fp (swapBytes wSize . flip FP.plusPtr off)-        loop wSize fp (len - 1) (off + 1)--}+    else let (ptr, offset,len) = V.unsafeToForeignPtr vec+         in V.unsafeFromForeignPtr (castForeignPtr ptr)+                                 offset+                                 (len `quot` sizeOf (undefined :: a))  {- swapBytes :: Int -> ForeignPtr a -> IO ()@@ -131,26 +130,24 @@ -- |Convert Word8s to Doubles convFunc :: (MonadCatchIO m) =>   AudioFormat-  -> ForeignPtr Int-  -> ForeignPtr Double-  -> MIteratee (IOBuffer r Word8) m (IOBuffer r Double)-convFunc (AudioFormat _nc _sr 8) offp bufp = do+  -> Iteratee (V.Vector Word8) m (V.Vector Double)+convFunc (AudioFormat _nc _sr 8) = do   mbuf <- unroll8-  liftIO $ maybe (error "error in convFunc") (IB.mapBuffer-    (normalize 8 . (fromIntegral :: Word8 -> Int8)) offp bufp) mbuf-convFunc (AudioFormat _nc _sr 16) offp bufp = do+  return $ maybe (error "error in convFunc") (V.map+    (normalize 8 . (fromIntegral :: Word8 -> Int8))) mbuf+convFunc (AudioFormat _nc _sr 16) = do   mbuf <- unroller (sizeOf w16)-  liftIO $ maybe (error "error in convFunc") (IB.mapBuffer-    (normalize 16 . (fromIntegral :: Word16 -> Int16)) offp bufp) mbuf-convFunc (AudioFormat _nc _sr 24) offp bufp = do+  return $ maybe (error "error in convFunc") (V.map+    (normalize 16 . (fromIntegral :: Word16 -> Int16))) mbuf+convFunc (AudioFormat _nc _sr 24) = do   mbuf <- unroller (sizeOf w24)-  liftIO $ maybe (error "error in convFunc") (IB.mapBuffer-    (normalize 24 . (fromIntegral :: Word24 -> Int24)) offp bufp) mbuf-convFunc (AudioFormat _nc _sr 32) offp bufp = do+  return $ maybe (error "error in convFunc") (V.map+    (normalize 24 . (fromIntegral :: Word24 -> Int24))) mbuf+convFunc (AudioFormat _nc _sr 32) = do   mbuf <- unroller (sizeOf w32)-  liftIO $ maybe (error "error in convFunc") (IB.mapBuffer-    (normalize 32 . (fromIntegral :: Word32 -> Int32)) offp bufp) mbuf-convFunc _ _ _ = MIteratee $ I.throwErr (I.iterStrExc "Invalid wave bit depth")+  return $ maybe (error "error in convFunc") (V.map+    (normalize 32 . (fromIntegral :: Word32 -> Int32))) mbuf+convFunc _ = I.throwErr (I.iterStrExc "Invalid wave bit depth")   -- ---------------------

@@ -7,17 +7,12 @@  import Sound.Iteratee.Base import Sound.Iteratee.Codecs.Common-import Data.MutableIter-import qualified Data.MutableIter.IOBuffer as IB+import           Data.Iteratee as I+import qualified Data.Vector.Storable as V  import Data.Word import Control.Monad.CatchIO-import Control.Monad.IO.Class -import Foreign.ForeignPtr--type IOB = IB.IOBuffer- data RawCodec = RawCodec  instance WritableAudio RawCodec where@@ -29,10 +24,8 @@ readRaw ::  (MonadCatchIO m, Functor m) =>   AudioFormat-  -> MIteratee (IOB r Double) m a-  -> MIteratee (IOB r Word8) m a+  -> Iteratee (V.Vector Double) m a+  -> Iteratee (V.Vector Word8) m a readRaw fmt iter_dub = do-  offp <- liftIO $ newFp 0-  bufp <- liftIO $ mallocForeignPtrArray defaultChunkLength-  joinIob . convStream (convFunc fmt offp bufp) $ iter_dub+  joinI . convStream (convFunc fmt) $ iter_dub 

@@ -3,6 +3,7 @@   -- * Types   -- ** Internal types   WaveCodec (..),+  WAVEDict,   WAVEDE (..),   WAVEDEENUM (..),   -- ** WAVE CHUNK types@@ -42,27 +43,21 @@ import Sound.Iteratee.Base import Sound.Iteratee.Codecs.Common -import qualified Data.MutableIter.IOBuffer as IB-import Data.MutableIter as MI-import Data.MutableIter.Binary+import qualified Data.Vector.Storable as V -import qualified Data.Iteratee as Itr-import Data.Iteratee (throwErr, iterStrExc)+import           Data.Iteratee as I  import qualified Data.IntMap as IM import Data.Word import Data.Char (ord) +import Control.Monad import Control.Monad.CatchIO-import Control.Monad.IO.Class--import Foreign.ForeignPtr+import Control.Monad.IO.Class ()  -- ===================================================== -- WAVE libary code -type IOB = IB.IOBuffer- -- |A WAVE directory is a list associating WAVE chunks with -- a record WAVEDE type WAVEDict = IM.IntMap [WAVEDE]@@ -77,15 +72,15 @@   show a = "Type: " ++ show (wavedeType a) ++ " :: Length: " ++             show (wavedeCount a) -type MEnumeratorM sfrom sto m a = MIteratee sto m a -> MIteratee sfrom m a-type MEnumeratorM2 sfrom sto m a = MIteratee sto m a-                                   -> MIteratee sfrom m (MIteratee sto m a)+type MEnumeratorM sfrom sto m a = Iteratee sto m a -> Iteratee sfrom m a+type MEnumeratorM2 sfrom sto m a = Iteratee sto m a+                                   -> Iteratee sfrom m (Iteratee sto m a)  data WAVEDEENUM =-  WENBYTE  (forall a m r. (MonadCatchIO m, Functor m) =>-              MEnumeratorM (IOB r Word8) (IOB r Word8) m a)-  | WENDUB (forall a m r. (MonadCatchIO m, Functor m) =>-              MEnumeratorM2 (IOB r Word8) (IOB r Double) m a)+  WENBYTE  (forall a m. (MonadCatchIO m, Functor m) =>+              MEnumeratorM (V.Vector Word8) (V.Vector Word8) m a)+  | WENDUB (forall a m. (MonadCatchIO m, Functor m) =>+              MEnumeratorM2 (V.Vector Word8) (V.Vector Double) m a)  -- |Standard WAVE Chunks data WAVECHUNK = WAVEFMT -- ^Format@@ -123,62 +118,65 @@ -- |The library function to read the WAVE dictionary waveReader ::  (MonadCatchIO m, Functor m) =>-   MIteratee (IOB r Word8) m (Maybe WAVEDict)+   Iteratee (V.Vector Word8) m (Maybe WAVEDict) waveReader = do-  readRiff+  isRiff <- readRiff+  when (not isRiff) $ throwErr . iterStrExc $ "Bad RIFF header: "   tot_size <- endianRead4 LSB-  readRiffWave+  isWave <- readRiffWave+  when (not isWave) $ throwErr . iterStrExc $ "Bad WAVE header: "   chunks_m <- findChunks $ fromIntegral tot_size   loadDict $ joinMaybe chunks_m --- |Read the RIFF header of a file.-readRiff :: MonadCatchIO m => MIteratee (IOB r Word8) m ()+-- |Read the RIFF header of a file.  Returns True if the file is a valid RIFF.+readRiff :: MonadCatchIO m => Iteratee (V.Vector Word8) m Bool readRiff = do-  cnt <- heads $ fmap (fromIntegral . ord) "RIFF"+  cnt <- heads . V.fromList $ fmap (fromIntegral . ord) "RIFF"   case cnt of-    4 -> return ()-    _ -> MIteratee . throwErr . iterStrExc $ "Bad RIFF header: "+    4 -> return True+    _ -> return False --- | Read the WAVE part of the RIFF header.-readRiffWave :: MonadCatchIO m => MIteratee (IOB r Word8) m ()+-- | Read the WAVE part of the RIFF header.  Returns True if the file is+--   a valid WAVE, otherwise False.+readRiffWave :: MonadCatchIO m => Iteratee (V.Vector Word8) m Bool readRiffWave = do-  cnt <- heads $ fmap (fromIntegral . ord) "WAVE"+  cnt <- heads . V.fromList $ fmap (fromIntegral . ord) "WAVE"   case cnt of-    4 -> return ()-    _ -> MIteratee . throwErr . iterStrExc $ "Bad RIFF/WAVE header: "+    4 -> return True+    _ -> return False  -- | An internal function to find all the chunks.  It assumes that the -- stream is positioned to read the first chunk. findChunks ::  MonadCatchIO m =>   Int-  -> MIteratee (IOB r Word8) m (Maybe [(Int, WAVECHUNK, Int)])+  -> Iteratee (V.Vector Word8) m (Maybe [(Int, WAVECHUNK, Int)]) findChunks n = findChunks' 12 []   where   findChunks' offset acc = do-    mpad <- MI.peek+    mpad <- I.peek     if (offset `rem` 2 == 1) && (mpad == Just 0)-      then MI.drop 1 >> findChunks'2 offset acc+      then I.drop 1 >> findChunks'2 offset acc       else findChunks'2 offset acc   findChunks'2 offset acc = do     typ <- stringRead4     count <- endianRead4 LSB     case waveChunk typ of-      Nothing -> (MIteratee . throwErr . iterStrExc $+      Nothing -> (throwErr . iterStrExc $         "Bad subchunk descriptor: " ++ show typ)       Just chk -> let newpos = offset + 8 + count in         if newpos >= fromIntegral n           then return . Just . reverse $                (fromIntegral offset, chk, fromIntegral count) : acc           else do-            MIteratee . Itr.seek $ fromIntegral newpos+            I.seek $ fromIntegral newpos             findChunks' newpos $              (fromIntegral offset, chk, fromIntegral count) : acc  loadDict ::  (MonadCatchIO m, Functor m) =>   [(Int, WAVECHUNK, Int)]-  -> MIteratee (IOB r Word8) m (Maybe WAVEDict)+  -> Iteratee (V.Vector Word8) m (Maybe WAVEDict) loadDict = P.foldl read_entry (return (Just IM.empty))   where   read_entry dictM (offset, typ, count) = dictM >>=@@ -201,8 +199,8 @@   -> Int -- ^ Offset   -> WAVECHUNK -- ^ Chunk type   -> Int -- ^ Count-  -> MIteratee (IOB r Word8) m (Maybe WAVEDEENUM)-readValue _dict offset _ 0 = MIteratee . throwErr . iterStrExc $+  -> Iteratee (V.Vector Word8) m (Maybe WAVEDEENUM)+readValue _dict offset _ 0 = throwErr . iterStrExc $   "Zero count in the entry of chunk at: " ++ show offset  readValue dict offset WAVEDATA count = do@@ -210,36 +208,33 @@   case fmt_m of     Just fmt ->       fmt `seq` (return . Just $ WENDUB (\iter_dub -> do-        MIteratee $ Itr.seek (8 + fromIntegral offset)-        offp <- liftIO $ newFp 0-        bufp <- liftIO $ mallocForeignPtrArray defaultChunkLength-        let iter = convStream (convFunc fmt offp bufp) iter_dub-        joinIob . takeUpTo count $ iter)+        I.seek (8 + fromIntegral offset)+        let iter = convStream (convFunc fmt) iter_dub+        joinI . takeUpTo count $ iter)       )-    Nothing ->-      MIteratee . throwErr . iterStrExc $-        "No valid format for data chunk at: " ++ show offset+    Nothing -> throwErr . iterStrExc $+      "No valid format for data chunk at: " ++ show offset  -- return the WaveFormat iteratee readValue _dict offset WAVEFMT count =   return . Just $ WENBYTE $ \iter -> do-    MIteratee $ Itr.seek (8 + fromIntegral offset)-    joinIob $ MI.takeUpTo count iter+    I.seek (8 + fromIntegral offset)+    joinI $ I.takeUpTo count iter  -- for WAVEOTHER, return Word8s and maybe the user can parse them readValue _dict offset (WAVEOTHER _str) count =   return . Just $ WENBYTE $ \iter -> do-    MIteratee $ Itr.seek (8 + fromIntegral offset)-    joinIob $ MI.takeUpTo count iter+    I.seek (8 + fromIntegral offset)+    joinI $ I.takeUpTo count iter  -- |An Iteratee to read a wave format chunk sWaveFormat :: MonadCatchIO m =>-  MIteratee (IOB r Word8) m (Maybe AudioFormat)+  Iteratee (V.Vector Word8) m (Maybe AudioFormat) sWaveFormat = do   f' <- endianRead2 LSB   nc <- endianRead2 LSB   sr <- endianRead4 LSB-  MI.drop 6+  I.drop 6   bd <- endianRead2 LSB   if f' == 1     then return . Just $ AudioFormat (fromIntegral nc)@@ -254,7 +249,7 @@ dictReadFirstFormat ::  (MonadCatchIO m, Functor m) =>   WAVEDict-  -> MIteratee (IOB r Word8) m (Maybe AudioFormat)+  -> Iteratee (V.Vector Word8) m (Maybe AudioFormat) dictReadFirstFormat dict = case IM.lookup (fromEnum WAVEFMT) dict of   Just [] -> return Nothing   Just (WAVEDE _ WAVEFMT (WENBYTE enum) : _xs) -> enum sWaveFormat@@ -265,10 +260,10 @@ dictReadLastFormat ::  (MonadCatchIO m, Functor m) =>   WAVEDict-  -> MIteratee (IOB r Word8) m (Maybe AudioFormat)+  -> Iteratee (V.Vector Word8) m (Maybe AudioFormat) dictReadLastFormat dict = case IM.lookup (fromEnum WAVEFMT) dict of   Just [] -> return Nothing-  Just xs -> let (WAVEDE _ WAVEFMT (WENBYTE enum)) = last xs+  Just xs -> let (WAVEDE _ WAVEFMT (WENBYTE enum)) = P.last xs              in enum sWaveFormat   _ -> return Nothing @@ -277,20 +272,20 @@  (MonadCatchIO m, Functor m) =>   Int -- ^ Index in the format chunk list to read   -> WAVEDict -- ^ Dictionary-  -> MIteratee (IOB r Word8) m (Maybe AudioFormat)+  -> Iteratee (V.Vector Word8) m (Maybe AudioFormat) dictReadFormat ix dict = case IM.lookup (fromEnum WAVEFMT) dict of   Just xs -> let (WAVEDE _ WAVEFMT (WENBYTE enum)) = xs !! ix              in enum sWaveFormat   _ -> return Nothing  -- |Read the specified data chunk from the dictionary, applying the--- data to the specified MIteratee.+-- data to the specified Iteratee. dictProcessData ::  (MonadCatchIO m, Functor m) =>   Int -- ^ Index in the data chunk list to read   -> WAVEDict -- ^ Dictionary-  -> MIteratee (IOB r Double) m a-  -> MIteratee (IOB r Word8) m (MIteratee (IOB r Double) m a)+  -> Iteratee (V.Vector Double) m a+  -> Iteratee (V.Vector Word8) m (Iteratee (V.Vector Double) m a) dictProcessData ix dict iter = case IM.lookup (fromEnum WAVEDATA) dict of   Just xs -> let (WAVEDE _ WAVEDATA (WENDUB enum)) = (!!) xs ix              in (enum iter)@@ -300,11 +295,11 @@  (MonadCatchIO m, Functor m) =>   Int -- ^ Index in the data chunk list to read   -> WAVEDict -- ^ Dictionary-  -> MIteratee (IOB r Double) m a-  -> MIteratee (IOB r Word8) m (Maybe a)+  -> Iteratee (V.Vector Double) m a+  -> Iteratee (V.Vector Word8) m (Maybe a) dictProcessData_ ix dict iter = case IM.lookup (fromEnum WAVEDATA) dict of   Just xs -> let (WAVEDE _ WAVEDATA (WENDUB enum)) = (!!) xs ix-             in fmap Just . joinIob . enum $ iter+             in fmap Just . joinI . enum $ iter   _ -> return Nothing  -- | Get the length of data in a dictionary chunk, in bytes.@@ -332,7 +327,7 @@ dictSoundInfo ::  (MonadCatchIO m, Functor m) =>   WAVEDict-  -> MIteratee (IOB r Word8) m+  -> Iteratee (V.Vector Word8) m       (Maybe (AudioFormat, Integer)) dictSoundInfo dict = do   fmtm <- dictReadFirstFormat dict

@@ -17,15 +17,13 @@ where  import Sound.Iteratee.Base-import Data.MutableIter-import qualified Data.MutableIter.IOBuffer as IB-import Data.MutableIter.IOBuffer (hPut, mapBuffer)+import Data.Iteratee+import qualified Data.Vector.Storable as V import qualified Data.Iteratee as I import Data.Int.Int24 import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Char8 as BC import qualified Data.Binary.Put as P-import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Foreign@@ -53,18 +51,19 @@ writeWave ::   FilePath   -> AudioFormat-  -> MIteratee (IOBuffer r Double) AudioMonad ()+  -> Iteratee (V.Vector Double) AudioMonad () writeWave fp af = do   lift $ openWave fp   lift $ writeFormat af   lift writeDataHeader-  loop+  liftI step   lift closeWave   lift $ put NoState   where-    loop = liftI step-    step (I.Chunk buf) = guardNull buf loop $ lift (writeDataChunk buf) >> loop-    step stream        = idone () stream+    step (I.Chunk buf)+      | V.null buf = liftI step+      | otherwise  = lift (writeDataChunk buf) >> liftI step+    step stream    = idone () stream  -- |Open a wave file for writing openWave :: FilePath -> AudioMonad ()@@ -99,12 +98,12 @@     _                                 -> error "Can't write: not a WAVE file"  -- |Write a data chunk.-writeDataChunk :: IOBuffer r Double -> AudioMonad ()+writeDataChunk :: V.Vector Double -> AudioMonad () writeDataChunk buf = do   as <- get   case as of     WaveState (Just h) (Just af) i i' off -> do-      len <- liftIO . liftM fromIntegral $ getLength af+      let len = fromIntegral $ getLength af       liftIO $ putVec af h buf       put $ WaveState (Just h) (Just af) (i + len) (i' + len) off     WaveState Nothing  _       _ _ _  -> error "Can't write: no file opened"@@ -112,12 +111,13 @@     _                                 -> error "Can't write: not a WAVE file"   where     putVec af h buf' = case bitDepth af of-      8  -> convertVector i8  af buf' >>= hPut h-      16 -> convertVector i16 af buf' >>= hPut h-      24 -> convertVector i24 af buf' >>= hPut h-      32 -> convertVector i32 af buf' >>= hPut h+      8  -> hPut h $ convertVector i8  af buf'+      16 -> hPut h $ convertVector i16 af buf'+      24 -> hPut h $ convertVector i24 af buf'+      32 -> hPut h $ convertVector i32 af buf'       x  -> error $ "Cannot write wave file: unsupported bit depth " ++ show x-    getLength af = liftM (fromIntegral (bitDepth af `div` 8) *) (IB.length buf)+    hPut h v = V.unsafeWith v (\p -> hPutBuf h p (V.length v))+    getLength af = fromIntegral (bitDepth af `div` 8) * V.length buf  i8 :: Int8 i8 = 0@@ -177,13 +177,9 @@   (Integral a, Storable a, Bounded a) =>   a   -> AudioFormat-  -> IOBuffer r Double-  -> IO (IOBuffer r a)-convertVector _ (AudioFormat _nc _sr bd) buf = do-  offp <- newFp 0-  l <- IB.length buf-  obuf <- mallocForeignPtrBytes (l * sizeOf (0::Double))-  mapBuffer (unNormalize bd) offp obuf buf+  -> V.Vector Double+  -> V.Vector a+convertVector _ (AudioFormat _nc _sr bd) = V.map (unNormalize bd)  -- 8 bits are handled separately because (at least in wave) they aren't 2's -- complement negatives.

@@ -0,0 +1,86 @@+{-# LANGUAGE RankNTypes #-}++module Sound.Iteratee.File (+  getFormat+ ,getAudioInfo+ ,runAudioIteratee+ ,tryRunAudioIteratee+ ,enumAudioIteratee+ ,enumAudioIterateeWithFormat+ ,defaultBufSize+)++where++import           Sound.Iteratee.Base+import           Sound.Iteratee.Codecs+import           Sound.Iteratee.Codecs.Wave ()+import           Sound.Iteratee.Writer+import           Data.Iteratee+import qualified Data.Vector.Storable as V++import           Control.Exception+import           Control.Monad.CatchIO+import           System.FilePath+import           Data.Char++-- | Default buffer size.  The value from Data.Iteratee.IO is generally too+-- small for good performance.+defaultBufSize :: Int+defaultBufSize = 2 ^ (15 :: Int)++-- | get the format from a file name+getFormat :: FilePath -> Maybe SupportedFileFormat+getFormat fp = case ext of+ "wav"  -> Just Wave+ "wave" -> Just Wave+ _      -> Nothing+ where+  ext = map toLower . tail $ takeExtension fp -- drop the initial "."++-- | get audio format information from a file+getAudioInfo :: FilePath -> IO (Maybe AudioFormat)+getAudioInfo fp = case getFormat fp of+  Just Wave -> fileDriverAudio (waveReader >>=+             maybe (return Nothing) dictReadFirstFormat) fp+  Just Raw  -> return Nothing+  _         -> return Nothing -- could try everything and see what matches...+{-# INLINE getAudioInfo #-}++enumAudioIterateeWithFormat ::+  (MonadCatchIO m, Functor m)+  => FilePath+  -> (AudioFormat -> Iteratee (V.Vector Double) m a)+  -> m (Iteratee (V.Vector Double) m a)+enumAudioIterateeWithFormat fp fi = case getFormat fp of+  Just Wave -> run =<< enumAudioFile defaultBufSize fp (waveReader >>= wFn)+  Just Raw  -> return . throwErr $ iterStrExc "Raw format not yet implemented"+  _         -> return . throwErr $ iterStrExc "Raw format not yet implemented"+ where+  wFn = maybe (throwErr $ toException CorruptFileException)+              (\d -> do+                mFmt <- dictReadFirstFormat d+                maybe (throwErr $ toException MissingFormatException)+                      (dictProcessData 0 d . fi) mFmt )+{-# INLINE enumAudioIterateeWithFormat #-}++enumAudioIteratee ::+  (MonadCatchIO m, Functor m)+  => FilePath+  -> Iteratee (V.Vector Double) m a+  -> m (Iteratee (V.Vector Double) m a)+enumAudioIteratee fp i = enumAudioIterateeWithFormat fp (const i)+{-# INLINE enumAudioIteratee #-}++runAudioIteratee ::+  FilePath+  -> Iteratee (V.Vector Double) AudioMonad a+  -> IO a+runAudioIteratee fp i = runAudioMonad $ enumAudioIteratee fp i >>= run+{-# INLINE runAudioIteratee #-}++tryRunAudioIteratee :: Exception e+  => FilePath+  -> Iteratee (V.Vector Double) AudioMonad a+  -> IO (Either e a)+tryRunAudioIteratee fp i = runAudioMonad $ enumAudioIteratee fp i >>= tryRun

@@ -5,8 +5,9 @@  module Sound.Iteratee.Writer (   -- * Audio writing functions-  fileDriverAudio,-  runAudioMonad+  fileDriverAudio+  ,runAudioMonad+  ,enumAudioFile )  where@@ -14,9 +15,11 @@ import Sound.Iteratee.Base import Sound.Iteratee.Codecs -import Data.MutableIter--import Foreign.Storable (Storable)+import Data.Iteratee+import Data.Iteratee.IO+import qualified Data.Vector.Storable as V+import Data.Word (Word8)+import Control.Monad.CatchIO  runAudioMonad :: AudioMonad a -> IO a runAudioMonad am = do@@ -25,10 +28,18 @@     NoState     -> return a     WaveState{} -> runWaveAM (put s >> return a) -fileDriverAudio :: (Storable el) =>-  (forall r.  MIteratee (IOBuffer r el) AudioMonad a)+-- | A simplified interface to running an audio iteratee+fileDriverAudio ::+  Iteratee (V.Vector Word8) AudioMonad a   -> FilePath   -> IO a-fileDriverAudio i fp = runAM (fileDriverRandom defaultChunkLength i fp)+fileDriverAudio i fp = runAM (fileDriverRandom i fp)   where     runAM = runAudioMonad++enumAudioFile ::+  MonadCatchIO m+  => Int+  -> FilePath+  -> Enumerator (V.Vector Word8) m a+enumAudioFile = enumFileRandom