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, )
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 ->
(FFI.FormatPtr FFI.ReadMode -> IO a) -> IO a
withRead info path =
bracket (openRead info path) close
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
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
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)
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]
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
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
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