module Sound.File.Sndfile.Interface where
import qualified Control.Exception as E
import Control.Monad (liftM, when)
import Foreign hiding (unsafePerformIO)
import Foreign.C
import qualified Sound.File.Sndfile.Exception as E
import System.IO.Unsafe (unsafePerformIO)
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum = toEnum . fromIntegral
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum = fromIntegral . fromEnum
type Count = Int
type Index = Int
data HeaderFormat = HeaderFormatNone
| HeaderFormatWav
| HeaderFormatAiff
| HeaderFormatAu
| HeaderFormatRaw
| HeaderFormatPaf
| HeaderFormatSvx
| HeaderFormatNist
| HeaderFormatVoc
| HeaderFormatIrcam
| HeaderFormatW64
| HeaderFormatMat4
| HeaderFormatMat5
| HeaderFormatPvf
| HeaderFormatXi
| HeaderFormatHtk
| HeaderFormatSds
| HeaderFormatAvr
| HeaderFormatWavex
| HeaderFormatSd2
| HeaderFormatFlac
| HeaderFormatCaf
| HeaderFormatWve
| HeaderFormatOgg
| HeaderFormatMpc2k
| HeaderFormatRf64
deriving (Eq,Show)
instance Enum HeaderFormat where
fromEnum HeaderFormatNone = 0
fromEnum HeaderFormatWav = 65536
fromEnum HeaderFormatAiff = 131072
fromEnum HeaderFormatAu = 196608
fromEnum HeaderFormatRaw = 262144
fromEnum HeaderFormatPaf = 327680
fromEnum HeaderFormatSvx = 393216
fromEnum HeaderFormatNist = 458752
fromEnum HeaderFormatVoc = 524288
fromEnum HeaderFormatIrcam = 655360
fromEnum HeaderFormatW64 = 720896
fromEnum HeaderFormatMat4 = 786432
fromEnum HeaderFormatMat5 = 851968
fromEnum HeaderFormatPvf = 917504
fromEnum HeaderFormatXi = 983040
fromEnum HeaderFormatHtk = 1048576
fromEnum HeaderFormatSds = 1114112
fromEnum HeaderFormatAvr = 1179648
fromEnum HeaderFormatWavex = 1245184
fromEnum HeaderFormatSd2 = 1441792
fromEnum HeaderFormatFlac = 1507328
fromEnum HeaderFormatCaf = 1572864
fromEnum HeaderFormatWve = 1638400
fromEnum HeaderFormatOgg = 2097152
fromEnum HeaderFormatMpc2k = 2162688
fromEnum HeaderFormatRf64 = 2228224
toEnum 0 = HeaderFormatNone
toEnum 65536 = HeaderFormatWav
toEnum 131072 = HeaderFormatAiff
toEnum 196608 = HeaderFormatAu
toEnum 262144 = HeaderFormatRaw
toEnum 327680 = HeaderFormatPaf
toEnum 393216 = HeaderFormatSvx
toEnum 458752 = HeaderFormatNist
toEnum 524288 = HeaderFormatVoc
toEnum 655360 = HeaderFormatIrcam
toEnum 720896 = HeaderFormatW64
toEnum 786432 = HeaderFormatMat4
toEnum 851968 = HeaderFormatMat5
toEnum 917504 = HeaderFormatPvf
toEnum 983040 = HeaderFormatXi
toEnum 1048576 = HeaderFormatHtk
toEnum 1114112 = HeaderFormatSds
toEnum 1179648 = HeaderFormatAvr
toEnum 1245184 = HeaderFormatWavex
toEnum 1441792 = HeaderFormatSd2
toEnum 1507328 = HeaderFormatFlac
toEnum 1572864 = HeaderFormatCaf
toEnum 1638400 = HeaderFormatWve
toEnum 2097152 = HeaderFormatOgg
toEnum 2162688 = HeaderFormatMpc2k
toEnum 2228224 = HeaderFormatRf64
toEnum unmatched = error ("HeaderFormat.toEnum: Cannot match " ++ show unmatched)
data SampleFormat = SampleFormatNone
| SampleFormatPcmS8
| SampleFormatPcm16
| SampleFormatPcm24
| SampleFormatPcm32
| SampleFormatPcmU8
| SampleFormatFloat
| SampleFormatDouble
| SampleFormatUlaw
| SampleFormatAlaw
| SampleFormatImaAdpcm
| SampleFormatMsAdpcm
| SampleFormatGsm610
| SampleFormatVoxAdpcm
| SampleFormatG72132
| SampleFormatG72324
| SampleFormatG72340
| SampleFormatDwvw12
| SampleFormatDwvw16
| SampleFormatDwvw24
| SampleFormatDwvwN
| SampleFormatFormatDpcm8
| SampleFormatFormatDpcm16
| SampleFormatVorbis
deriving (Eq,Show)
instance Enum SampleFormat where
fromEnum SampleFormatNone = 0
fromEnum SampleFormatPcmS8 = 1
fromEnum SampleFormatPcm16 = 2
fromEnum SampleFormatPcm24 = 3
fromEnum SampleFormatPcm32 = 4
fromEnum SampleFormatPcmU8 = 5
fromEnum SampleFormatFloat = 6
fromEnum SampleFormatDouble = 7
fromEnum SampleFormatUlaw = 16
fromEnum SampleFormatAlaw = 17
fromEnum SampleFormatImaAdpcm = 18
fromEnum SampleFormatMsAdpcm = 19
fromEnum SampleFormatGsm610 = 32
fromEnum SampleFormatVoxAdpcm = 33
fromEnum SampleFormatG72132 = 48
fromEnum SampleFormatG72324 = 49
fromEnum SampleFormatG72340 = 50
fromEnum SampleFormatDwvw12 = 64
fromEnum SampleFormatDwvw16 = 65
fromEnum SampleFormatDwvw24 = 66
fromEnum SampleFormatDwvwN = 67
fromEnum SampleFormatFormatDpcm8 = 80
fromEnum SampleFormatFormatDpcm16 = 81
fromEnum SampleFormatVorbis = 96
toEnum 0 = SampleFormatNone
toEnum 1 = SampleFormatPcmS8
toEnum 2 = SampleFormatPcm16
toEnum 3 = SampleFormatPcm24
toEnum 4 = SampleFormatPcm32
toEnum 5 = SampleFormatPcmU8
toEnum 6 = SampleFormatFloat
toEnum 7 = SampleFormatDouble
toEnum 16 = SampleFormatUlaw
toEnum 17 = SampleFormatAlaw
toEnum 18 = SampleFormatImaAdpcm
toEnum 19 = SampleFormatMsAdpcm
toEnum 32 = SampleFormatGsm610
toEnum 33 = SampleFormatVoxAdpcm
toEnum 48 = SampleFormatG72132
toEnum 49 = SampleFormatG72324
toEnum 50 = SampleFormatG72340
toEnum 64 = SampleFormatDwvw12
toEnum 65 = SampleFormatDwvw16
toEnum 66 = SampleFormatDwvw24
toEnum 67 = SampleFormatDwvwN
toEnum 80 = SampleFormatFormatDpcm8
toEnum 81 = SampleFormatFormatDpcm16
toEnum 96 = SampleFormatVorbis
toEnum unmatched = error ("SampleFormat.toEnum: Cannot match " ++ show unmatched)
data EndianFormat = EndianFile
| EndianLittle
| EndianBig
| EndianCpu
deriving (Eq,Show)
instance Enum EndianFormat where
fromEnum EndianFile = 0
fromEnum EndianLittle = 268435456
fromEnum EndianBig = 536870912
fromEnum EndianCpu = 805306368
toEnum 0 = EndianFile
toEnum 268435456 = EndianLittle
toEnum 536870912 = EndianBig
toEnum 805306368 = EndianCpu
toEnum unmatched = error ("EndianFormat.toEnum: Cannot match " ++ show unmatched)
data FormatMask = FormatSubMask
| FormatTypeMask
| FormatEndMask
deriving (Eq)
instance Enum FormatMask where
fromEnum FormatSubMask = 65535
fromEnum FormatTypeMask = 268369920
fromEnum FormatEndMask = 805306368
toEnum 65535 = FormatSubMask
toEnum 268369920 = FormatTypeMask
toEnum 805306368 = FormatEndMask
toEnum unmatched = error ("FormatMask.toEnum: Cannot match " ++ show unmatched)
data Format = Format {
headerFormat :: HeaderFormat,
sampleFormat :: SampleFormat,
endianFormat :: EndianFormat
} deriving (Eq, Show)
defaultFormat :: Format
defaultFormat = Format HeaderFormatNone SampleFormatNone EndianFile
hsFormat :: CInt -> Format
hsFormat i =
let hf = cToEnum (i .&. (cFromEnum FormatTypeMask) .&. complement (cFromEnum FormatEndMask))
sf = cToEnum (i .&. (cFromEnum FormatSubMask))
ef = cToEnum (i .&. (cFromEnum FormatEndMask))
in
Format {
headerFormat = hf,
sampleFormat = sf,
endianFormat = ef
}
cFormat :: Format -> CInt
cFormat (Format hf sf ef) = (cFromEnum hf) .|. (cFromEnum sf) .|. (cFromEnum ef)
data Info = Info {
frames :: Count,
samplerate :: Int,
channels :: Int,
format :: Format,
sections :: Int,
seekable :: Bool
} deriving (Eq, Show)
duration :: Info -> Double
duration info = (fromIntegral $ frames info) / (fromIntegral $ samplerate info)
defaultInfo :: Info
defaultInfo = Info 0 0 0 defaultFormat 0 False
checkFormat :: Info -> Bool
checkFormat info =
unsafePerformIO (with info (liftM toBool . sf_format_check . castPtr))
instance Storable (Info) where
sizeOf _ = 28
alignment _ = 4
peek ptr = do
frames <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 0 ::IO CLLong}) ptr
samplerate <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 8 ::IO CInt}) ptr
channels <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 12 ::IO CInt}) ptr
format <- liftM hsFormat $ (\ptr -> do {peekByteOff ptr 16 ::IO CInt}) ptr
sections <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 20 ::IO CInt}) ptr
seekable <- liftM toBool $ (\ptr -> do {peekByteOff ptr 24 ::IO CInt}) ptr
return $ Info {
frames = frames,
samplerate = samplerate,
channels = channels,
format = format,
sections = sections,
seekable = seekable
}
poke ptr info =
do
(\ptr val -> do {pokeByteOff ptr 0 (val::CLLong)}) ptr $ fromIntegral $ frames info
(\ptr val -> do {pokeByteOff ptr 8 (val::CInt)}) ptr $ fromIntegral $ samplerate info
(\ptr val -> do {pokeByteOff ptr 12 (val::CInt)}) ptr $ fromIntegral $ channels info
(\ptr val -> do {pokeByteOff ptr 16 (val::CInt)}) ptr $ cFormat $ format info
(\ptr val -> do {pokeByteOff ptr 20 (val::CInt)}) ptr $ fromIntegral $ sections info
(\ptr val -> do {pokeByteOff ptr 24 (val::CInt)}) ptr $ fromBool $ seekable info
checkHandle :: HandlePtr -> IO ()
checkHandle handle = do
code <- liftM fromIntegral $ sf_error handle
when (code /= 0) $
peekCString (sf_strerror handle) >>= E.throw . E.fromErrorCode code
data Handle = Handle {
hInfo :: Info,
hPtr :: HandlePtr
}
type HandlePtr = Ptr ()
data IOMode = ReadMode
| WriteMode
| ReadWriteMode
deriving (Eq,Show)
instance Enum IOMode where
fromEnum ReadMode = 16
fromEnum WriteMode = 32
fromEnum ReadWriteMode = 48
toEnum 16 = ReadMode
toEnum 32 = WriteMode
toEnum 48 = ReadWriteMode
toEnum unmatched = error ("IOMode.toEnum: Cannot match " ++ show unmatched)
openFile :: FilePath -> IOMode -> Info -> IO Handle
openFile filePath ioMode info =
withCString filePath (\cFilePath ->
with info (\cInfo -> do
cHandle <- sf_open
cFilePath (cFromEnum ioMode) (castPtr cInfo)
checkHandle cHandle
newInfo <- peek cInfo
return $ Handle newInfo cHandle))
hClose :: Handle -> IO ()
hClose handle = do
_ <- sf_close $ hPtr handle
checkHandle nullPtr
return ()
hFlush :: Handle -> IO ()
hFlush (Handle _ handle) = sf_write_sync handle
getFileInfo :: FilePath -> IO Info
getFileInfo filePath = do
h <- openFile filePath ReadMode defaultInfo
let info = hInfo h
hClose h
return info
hIsSeekable :: Handle -> IO Bool
hIsSeekable = return . seekable . hInfo
data SeekMode = AbsoluteSeek
| RelativeSeek
| SeekFromEnd
deriving (Eq,Show)
instance Enum SeekMode where
fromEnum AbsoluteSeek = 0
fromEnum RelativeSeek = 1
fromEnum SeekFromEnd = 2
toEnum 0 = AbsoluteSeek
toEnum 1 = RelativeSeek
toEnum 2 = SeekFromEnd
toEnum unmatched = error ("SeekMode.toEnum: Cannot match " ++ show unmatched)
hSeek' :: Maybe IOMode -> Handle -> SeekMode -> Count -> IO Count
hSeek' ioMode (Handle _ handle) seekMode frames = do
n <- liftM fromIntegral $
sf_seek
handle
(fromIntegral frames)
((cFromEnum seekMode) .|. (case ioMode of
Nothing -> 0
Just m -> cFromEnum m))
checkHandle handle
return n
hSeek :: Handle -> SeekMode -> Count -> IO Count
hSeek = hSeek' Nothing
hSeekRead :: Handle -> SeekMode -> Count -> IO Count
hSeekRead = hSeek' (Just ReadMode)
hSeekWrite :: Handle -> SeekMode -> Count -> IO Count
hSeekWrite = hSeek' (Just WriteMode)
data StringType = StrTitle
| StrCopyright
| StrSoftware
| StrArtist
| StrComment
| StrDate
deriving (Eq,Show)
instance Enum StringType where
fromEnum StrTitle = 1
fromEnum StrCopyright = 2
fromEnum StrSoftware = 3
fromEnum StrArtist = 4
fromEnum StrComment = 5
fromEnum StrDate = 6
toEnum 1 = StrTitle
toEnum 2 = StrCopyright
toEnum 3 = StrSoftware
toEnum 4 = StrArtist
toEnum 5 = StrComment
toEnum 6 = StrDate
toEnum unmatched = error ("StringType.toEnum: Cannot match " ++ show unmatched)
getString :: Handle -> StringType -> IO (Maybe String)
getString (Handle _ handle) t = do
ptr <- sf_get_string handle (cFromEnum t)
if ptr == (nullPtr :: Ptr CChar)
then return Nothing
else liftM Just $ peekCString =<< (return ptr)
setString :: Handle -> StringType -> String -> IO ()
setString (Handle _ handle) t s =
withCString s (\cs -> do
_ <- sf_set_string handle (cFromEnum t) cs
checkHandle handle
return ())
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_format_check"
sf_format_check :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_error"
sf_error :: ((Ptr ()) -> (IO CInt))
foreign import ccall safe "Sound/File/Sndfile/Interface.chs.h sf_strerror"
sf_strerror :: ((Ptr ()) -> (Ptr CChar))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_open"
sf_open :: ((Ptr CChar) -> (CInt -> ((Ptr ()) -> (IO (Ptr ())))))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_close"
sf_close :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_write_sync"
sf_write_sync :: ((Ptr ()) -> (IO ()))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_seek"
sf_seek :: ((Ptr ()) -> (CLLong -> (CInt -> (IO CLLong))))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_get_string"
sf_get_string :: ((Ptr ()) -> (CInt -> (IO (Ptr CChar))))
foreign import ccall unsafe "Sound/File/Sndfile/Interface.chs.h sf_set_string"
sf_set_string :: ((Ptr ()) -> (CInt -> ((Ptr CChar) -> (IO CInt))))