SoxLib.hs

module Sound.SoxLib (
   with, formatWith,
   withRead,  readStorableVector,  readStorableVectorLazy,
   withWrite, writeStorableVector, writeStorableVectorLazy,
   seek,
   FFI.Mode(..), FFI.ReadMode, FFI.WriteMode,
   ReaderInfo(..), defaultReaderInfo,
   WriterInfo(..), defaultWriterInfo,

   FFI.Rate,
   FFI.FileType(..),
   FFI.Format(..),
   FFI.SignalInfo(..),
   FFI.EncodingInfo(..),
   FFI.defaultSignalInfo,
   ) where

import qualified Sound.SoxLib.FFI as FFI

import qualified Foreign.Marshal.Utils as U
import qualified Foreign.C.String as CStr
import Foreign.Storable (Storable, peek, )
import Foreign.Ptr (Ptr, nullFunPtr, nullPtr, )

import Control.Exception (bracket_, bracket, )
import System.IO.Error (mkIOError, doesNotExistErrorType, )

import qualified Data.StorableVector.Base as SVB
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV

import qualified Control.Monad.Trans.Cont as MC
import Control.Monad (when, )

import System.IO.Unsafe (unsafeInterleaveIO, )

import Data.Int (Int32, )


with :: IO a -> IO a
with = bracket_ FFI.init FFI.quit

formatWith :: IO a -> IO a
formatWith = bracket_ FFI.formatInit FFI.formatQuit


withMaybe ::
   Storable b =>
   (a -> (Ptr b -> IO c) -> IO c) ->
   Maybe a -> MC.ContT c IO (Ptr b)
withMaybe _ Nothing = return nullPtr
withMaybe f (Just a) = MC.ContT $ f a


data ReaderInfo =
   ReaderInfo {
      readerSignalInfo :: Maybe FFI.SignalInfo,
      readerEncodingInfo :: Maybe FFI.EncodingInfo,
      readerFileType :: Maybe FFI.FileType
   }

defaultReaderInfo :: ReaderInfo
defaultReaderInfo = ReaderInfo Nothing Nothing Nothing

withRead ::
   ReaderInfo -> FilePath ->
   (Ptr (FFI.Format FFI.ReadMode) -> IO a) -> IO a
withRead info path =
   MC.runContT $ do
      si  <- withMaybe U.with $ readerSignalInfo info
      enc <- withMaybe U.with $ readerEncodingInfo info
      cft <- withMaybe CStr.withCString $
                 fmap FFI.unFileType $ readerFileType info
      cpath <- MC.ContT $ CStr.withCString path
      MC.ContT $
         bracket
            (do fmt <- FFI.openRead cpath si enc cft
                if fmt==nullPtr
                  then throwDoesNotExist "SoxLib.withRead" path
                  else return fmt)
            FFI.close


data WriterInfo =
   WriterInfo {
      writerSignalInfo :: Maybe FFI.SignalInfo,
      writerEncodingInfo :: Maybe FFI.EncodingInfo,
      writerFileType :: Maybe FFI.FileType
   }

defaultWriterInfo :: WriterInfo
defaultWriterInfo = WriterInfo Nothing Nothing Nothing

withWrite ::
   WriterInfo -> FilePath ->
   (Ptr (FFI.Format FFI.WriteMode) -> IO a) -> IO a
withWrite info path =
   MC.runContT $ do
      si  <- withMaybe U.with $ writerSignalInfo info
      enc <- withMaybe U.with $ writerEncodingInfo info
      cft <- withMaybe CStr.withCString $
                 fmap FFI.unFileType $ writerFileType info
      cpath <- MC.ContT $ CStr.withCString path
      MC.ContT $
         bracket
            (do fmt <- FFI.openWrite cpath si enc cft nullPtr nullFunPtr
                if fmt==nullPtr
                  then throwDoesNotExist "SoxLib.withWrite" path
                  else return fmt)
            FFI.close


throwDoesNotExist :: String -> FilePath -> IO a
throwDoesNotExist name path =
   ioError $
      mkIOError doesNotExistErrorType
         name Nothing (Just path)

{- |
Multi-channel data is interleaved.
@size@ must be divisible by the number of channels.
-}
readStorableVector ::
   Ptr (FFI.Format FFI.ReadMode) -> Int -> IO (SV.Vector Int32)
readStorableVector fmt size =
   SVB.createAndTrim size $ \ptr ->
   fmap fromIntegral $ FFI.read fmt ptr (fromIntegral size)

{- |
Multi-channel data is interleaved.
@size@ must be divisible by the number of channels.
-}
writeStorableVector ::
   Ptr (FFI.Format FFI.WriteMode) -> SV.Vector Int32 -> IO ()
writeStorableVector fmt chunk =
   SVB.withStartPtr chunk $ \ptr len -> do
      written <- FFI.write fmt ptr (fromIntegral len)
      when (written < fromIntegral len) $ do
         f <- peek fmt
         ioError $ userError $ FFI.soxErrStr f


{- |
Read complete file lazily into chunky storable vector.
The chunkSize must be divisible by the number of channels.
-}
readStorableVectorLazy ::
   Ptr (FFI.Format FFI.ReadMode) -> SVL.ChunkSize -> IO (SVL.Vector Int32)
readStorableVectorLazy fmt (SVL.ChunkSize size) =
   let go =
          unsafeInterleaveIO $ do
             chunk <- readStorableVector fmt size
             if SV.length chunk >= size
               then fmap (chunk:) go
               else if SV.length chunk == 0
                      then return []
                      else return [chunk]
   in  fmap SVL.fromChunks go

{- |
The chunkSize must be divisible by the number of channels.
-}
writeStorableVectorLazy ::
   Ptr (FFI.Format FFI.WriteMode) -> SVL.Vector Int32 -> IO ()
writeStorableVectorLazy fmt =
   mapM_ (writeStorableVector fmt) . SVL.chunks


seek :: (FFI.Mode mode) => Ptr (FFI.Format mode) -> Int -> IO ()
seek fmt pos = do
   res <- FFI.seek fmt (fromIntegral pos) 0
   when (res /= 0) $ do
      f <- peek fmt
      ioError $ userError $ FFI.soxErrStr f