SoxLib.hs

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

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

   FFI.IOType,
   FFI.ioFile,
   FFI.ioPipe,
   FFI.ioURL,


   FFI.Option,
   FFI.optionNo,
   FFI.optionYes,
   FFI.optionDefault,

   FFI.Encoding,
   FFI.encodingUnknown,
   FFI.encodingSign2,
   FFI.encodingUnsigned,
   FFI.encodingFloat,
   FFI.encodingFloatText,
   FFI.encodingFlac,
   FFI.encodingHcom,
   FFI.encodingWavpack,
   FFI.encodingWavpackf,
   FFI.encodingUlaw,
   FFI.encodingAlaw,
   FFI.encodingG721,
   FFI.encodingG723,
   FFI.encodingClADPCM,
   FFI.encodingClADPCM16,
   FFI.encodingMsADPCM,
   FFI.encodingImaADPCM,
   FFI.encodingOkiADPCM,
   FFI.encodingDPCM,
   FFI.encodingDWVW,
   FFI.encodingDWVWN,
   FFI.encodingGSM,
   FFI.encodingMP3,
   FFI.encodingVorbis,
   FFI.encodingAmrWB,
   FFI.encodingAmrNB,
   FFI.encodingCVSD,
   FFI.encodingLPC10,
   ) 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 qualified Control.Monad.Trans.Class as MT
import Control.Functor.HT (void, )
import Control.Monad (when, )

import System.IO.Unsafe (unsafeInterleaveIO, )

import Data.Int (Int32, )


{-# DEPRECATED with "I found no documentation for it and thus think that it is deprecated. Use formatWith instead." #-}
with :: IO a -> IO a
with = bracket_ FFI.init FFI.quit

{- |
All SoxLib operations must be enclosed in 'formatWith'.
You must only call it once per program.
-}
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 =
   bracket (openRead info path) close

{- |
This function will never return a 'nullPtr'.
Instead it throws a user exception if the file cannot be opened.
-}
openRead ::
   ReaderInfo -> FilePath ->
   IO (Ptr (FFI.Format FFI.ReadMode))
openRead info path =
   flip MC.runContT return $ 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
      MT.lift $
         checkHandle "SoxLib.openRead" path =<<
         FFI.openRead cpath si enc cft


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 =
   bracket (openWrite info path) close

{- |
This function will never return a 'nullPtr'.
Instead it throws a user exception if the file cannot be opened.
-}
openWrite ::
   WriterInfo -> FilePath ->
   IO (Ptr (FFI.Format FFI.WriteMode))
openWrite info path =
   flip MC.runContT return $ 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
      MT.lift $
         checkHandle "SoxLib.openWrite" path =<<
         FFI.openWrite cpath si enc cft nullPtr nullFunPtr


checkHandle :: String -> FilePath -> Ptr a -> IO (Ptr a)
checkHandle name path fmt =
   if fmt==nullPtr
     then throwDoesNotExist name path
     else return fmt

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



close :: FFI.Mode mode => Ptr (FFI.Format mode) -> IO ()
close = void . FFI.close


{- |
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