module Sound.SoxLib ( with, formatWith, openRead, withRead, readStorableVector, readStorableVectorLazy, openWrite, withWrite, writeStorableVector, writeStorableVectorLazy, storableVectorLazyFromByteString, 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.ForeignPtr (ForeignPtr, FinalizerPtr, newForeignPtr, withForeignPtr, ) import Foreign.Ptr (Ptr, nullFunPtr, nullPtr, castPtr, ) 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 Data.ByteString as B 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 qualified Data.Traversable as Trav import Data.Maybe.HT (toMaybe, ) import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, ) import Data.Int (Int32, ) {- DEPRECATED with "I found no documentation for it and thus think that it is deprecated. Use formatWith instead." -} -- ToDo: on the other hand, example5.c uses it, but not formatInit 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 -> (FFI.FormatPtr 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 (FFI.FormatPtr 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 -> (FFI.FormatPtr 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 (FFI.FormatPtr 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 => FFI.FormatPtr mode -> IO () close = void . FFI.close {- | Multi-channel data is interleaved. @size@ must be divisible by the number of channels. -} readStorableVector :: FFI.FormatPtr 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. Caution: Writing large chunks (e.g. more than 8192 samples) may crash the FLAC backend. -} writeStorableVector :: FFI.FormatPtr 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 readChunks :: IO (SV.Vector Int32) -> Int -> IO [SV.Vector Int32] -> IO [SV.Vector Int32] readChunks readChunk size go = do chunk <- readChunk if SV.length chunk >= size then fmap (chunk:) go else return $ if SV.length chunk == 0 then [] else [chunk] {- | Read complete file lazily into chunky storable vector. The chunkSize must be divisible by the number of channels. -} readStorableVectorLazy :: FFI.FormatPtr FFI.ReadMode -> SVL.ChunkSize -> IO (SVL.Vector Int32) readStorableVectorLazy fmt (SVL.ChunkSize size) = let go = unsafeInterleaveIO $ readChunks (readStorableVector fmt size) size go in fmap SVL.fromChunks go {- | The chunkSize must be divisible by the number of channels. -} writeStorableVectorLazy :: FFI.FormatPtr FFI.WriteMode -> SVL.Vector Int32 -> IO () writeStorableVectorLazy fmt = mapM_ (writeStorableVector fmt) . SVL.chunks seek :: (FFI.Mode mode) => FFI.FormatPtr 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 maybeNewForeignPtr :: FinalizerPtr a -> Ptr a -> IO (Maybe (ForeignPtr a)) maybeNewForeignPtr finalizer ptr = Trav.sequence $ toMaybe (ptr/=nullPtr) $ newForeignPtr finalizer ptr {- | It reads lazily to lazy storable vector. That is, the whole 'ByteString' is kept as long as we process the lazy storable vector. -} -- ToDo: return (Either String) containing error message from Format.soxErrStr storableVectorLazyFromByteString :: ReaderInfo -> B.ByteString -> SVL.ChunkSize -> Maybe (SVL.Vector Int32) storableVectorLazyFromByteString info bytes (SVL.ChunkSize size) = unsafePerformIO $ 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 (src, len) <- MC.ContT $ B.useAsCStringLen bytes MT.lift $ do maybeFmt <- maybeNewForeignPtr FFI.closeFun =<< FFI.openMemRead (castPtr src) (fromIntegral len) si enc cft Trav.for maybeFmt $ \fmtForeign -> do let readChunk = withForeignPtr fmtForeign $ \fmt -> readStorableVector fmt size let go = unsafeInterleaveIO $ readChunks readChunk size go fmap SVL.fromChunks go