-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Sound/File/Sndfile/Interface.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}
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)



{-# LINE 14 "./Sound/File/Sndfile/Interface.chs" #-}

-- ====================================================================
-- Utilities

-- | Convert a C enumeration to Haskell.
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum  = toEnum . fromIntegral

-- | Convert a Haskell enumeration to C.
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum  = fromIntegral . fromEnum

-- ====================================================================
-- Basic types

-- | Type for expressing sample counts.
type Count = Int

-- | Type for expressing sample indices.
type Index = Int

-- ====================================================================
-- Format

-- | Header format.
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)

{-# LINE 41 "./Sound/File/Sndfile/Interface.chs" #-}
-- | Sample format.
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)

{-# LINE 76 "./Sound/File/Sndfile/Interface.chs" #-}
-- | Endianness.
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)

{-# LINE 117 "./Sound/File/Sndfile/Interface.chs" #-}
-- only used internally
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)

{-# LINE 129 "./Sound/File/Sndfile/Interface.chs" #-}
-- | Stream format specification, consisting of header, sample and endianness formats.
--
-- Not all combinations of header, sample and endianness formats are valid;
-- valid combinations can be checked with the 'checkFormat' function.
data Format = Format {
    headerFormat :: HeaderFormat,
    sampleFormat :: SampleFormat,
    endianFormat :: EndianFormat
} deriving (Eq, Show)

-- | Default \'empty\' format, useful when opening files for reading with 'ReadMode'.
defaultFormat :: Format
defaultFormat = Format HeaderFormatNone SampleFormatNone EndianFile

-- Convert CInt to Format
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
       }

-- Convert Format to CInt
cFormat :: Format -> CInt
cFormat (Format hf sf ef) = (cFromEnum hf) .|. (cFromEnum sf) .|. (cFromEnum ef)

-- ====================================================================
-- Info

-- | The 'Info' structure is for passing data between the calling function and
--   the library when opening a stream for reading or writing.
data Info = Info {
    frames :: Count,    -- ^Number of frames in file
    samplerate :: Int,  -- ^Audio sample rate
    channels :: Int,    -- ^Number of channels
    format :: Format,   -- ^Header and sample format
    sections :: Int,    -- ^Number of sections
    seekable :: Bool    -- ^'True' when stream is seekable (e.g. local files)
} deriving (Eq, Show)

-- | Return soundfile duration in seconds computed via the 'Info' fields
--   'frames' and 'samplerate'.
duration :: Info -> Double
duration info = (fromIntegral $ frames info) / (fromIntegral $ samplerate info)

-- |Default \'empty\' info, useful when opening files for reading with 'ReadMode'.
defaultInfo :: Info
defaultInfo   = Info 0 0 0 defaultFormat 0 False

-- | This function allows the caller to check if a set of parameters in the
--   'Info' struct is valid before calling 'openFile' ('WriteMode').
--
--   'checkFormat' returns 'True' if the parameters are valid and 'False'
--   otherwise.
{-# NOINLINE checkFormat #-}
checkFormat :: Info -> Bool
checkFormat info =
    unsafePerformIO (with info (liftM toBool . sf_format_check . castPtr))

-- Storable instance for Info
instance Storable (Info) where
    sizeOf _ = 28
{-# LINE 204 "./Sound/File/Sndfile/Interface.chs" #-}
    alignment _ = 4
{-# LINE 205 "./Sound/File/Sndfile/Interface.chs" #-}
    -- Unmarshall Info from C representation
    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
        }
    -- Marshall Info to C representation
    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

-- ====================================================================
-- Exceptions

checkHandle :: HandlePtr -> IO ()
checkHandle handle = do
    code <- liftM fromIntegral $ sf_error handle
    when (code /= 0) $
        peekCString (sf_strerror handle) >>= E.throw . E.fromErrorCode code

-- ====================================================================
-- Handle operations

-- | Abstract file handle.
data Handle = Handle {
    hInfo :: Info,      -- ^Return the stream 'Info' associated with the 'Handle'.
    hPtr :: HandlePtr
}
type HandlePtr = Ptr ()

-- | I\/O mode.
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)

{-# LINE 253 "./Sound/File/Sndfile/Interface.chs" #-}
-- | When opening a file for read ('ReadMode'), the format field should be set
--   to 'defaultFormat' before calling 'openFile'. The only exception to this
--   is the case of RAW files, where the caller has to set the samplerate,
--   channels and format fields to valid values. All other fields of the
--   structure are filled in by the library.
--
--   When opening a file for write ('WriteMode'), the caller must fill in the
--   structure members samplerate, channels, and format.
--
--   Every call to 'openFile' should be matched with a call to 'hClose' to
--   free up memory allocated during the call to 'openFile'.
--
--   On success, the 'openFile' function returns a 'Handle' which should be
--   passed as the first parameter to all subsequent libsndfile calls dealing
--   with that audio stream. On fail, the 'openFile' function signals an
--   'Exception'.
openFile :: FilePath -> IOMode -> Info -> IO Handle
openFile filePath ioMode info =
    withCString filePath (\cFilePath ->
        with info (\cInfo -> do
            cHandle <- sf_open
{-# LINE 282 "./Sound/File/Sndfile/Interface.chs" #-}
                            cFilePath (cFromEnum ioMode) (castPtr cInfo)
            checkHandle cHandle
            newInfo <- peek cInfo
            return $ Handle newInfo cHandle))

-- | The 'hClose' function closes the stream, deallocates its internal buffers
--   and returns () on success or signals an 'Exception' otherwise.
hClose :: Handle -> IO ()
hClose handle = do
    _ <- sf_close $ hPtr handle
    checkHandle nullPtr
    return ()

-- | If the stream is opened with 'WriteMode' or 'ReadWriteMode', call the
--   operating system\'s function to force the writing of all file cache
--   buffers to disk. If the file is opened with 'ReadMode' no action is
--   taken.
hFlush :: Handle -> IO ()
hFlush (Handle _ handle) = sf_write_sync handle

-- | Get header format information associated with file.
getFileInfo :: FilePath -> IO Info
getFileInfo filePath = do
    h <- openFile filePath ReadMode defaultInfo
    let info = hInfo h
    hClose h
    return info

-- ====================================================================
-- seeking

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)

{-# LINE 318 "./Sound/File/Sndfile/Interface.chs" #-}
-- Helper function for seeking, modifying either the read pointer, the write pointer, or both.
{-# INLINE hSeek' #-}
hSeek' :: Maybe IOMode -> Handle -> SeekMode -> Count -> IO Count
hSeek' ioMode (Handle _ handle) seekMode frames = do
    n <- liftM fromIntegral $
            sf_seek
{-# LINE 332 "./Sound/File/Sndfile/Interface.chs" #-}
                handle
                (fromIntegral frames)
                ((cFromEnum seekMode) .|. (case ioMode of
                                                Nothing -> 0
                                                Just m -> cFromEnum m))
    checkHandle handle
    return n

-- | The file seek functions work much like 'System.IO.hseek' with the
--   exception that the non-audio data is ignored and the seek only moves
--   within the audio data section of the file. In addition, seeks are defined
--   in number of (multichannel) frames. Therefore, a seek in a stereo file
--   from the current position forward with an offset of 1 would skip forward
--   by one sample of both channels.
--
--   like lseek(), the whence parameter can be any one of the following three values:
--
--   * 'AbsoluteSeek' - The offset is set to the start of the audio data plus offset (multichannel) frames.
--
--   * 'RelativeSeek' - The offset is set to its current location plus offset (multichannel) frames.
--
--   * 'SeekFromEnd' - The offset is set to the end of the data plus offset (multichannel) frames.
--
--   Internally, libsndfile keeps track of the read and write locations using
--   separate read and write pointers. If a file has been opened with a mode
--   of 'ReadWriteMode', calling either 'hSeekRead' or 'hSeekWrite' allows the
--   read and write pointers to be modified separately. 'hSeek' modifies both
--   the read and the write pointer.
--
--   Note that the frames offset can be negative and in fact should be when
--   SeekFromEnd is used for the whence parameter.
--
--   'hSeek' will return the offset in (multichannel) frames from the start of
--   the audio data, or signal an error when an attempt is made to seek
--   beyond the start or end of the file.
hSeek :: Handle -> SeekMode -> Count -> IO Count
hSeek = hSeek' Nothing

--hSeek (Handle _ handle) seekMode frames = do
--    n <- liftM fromIntegral $ {#call unsafe sf_seek#} handle (cIntConv frames) (cFromEnum seekMode)
--    checkHandle handle
--    return n

-- | Like 'hSeek', but only the read pointer is modified.
hSeekRead :: Handle -> SeekMode -> Count -> IO Count
hSeekRead = hSeek' (Just ReadMode)

-- | Like 'hSeek', but only the write pointer is modified.
hSeekWrite :: Handle -> SeekMode -> Count -> IO Count
hSeekWrite = hSeek' (Just WriteMode)

-- ====================================================================
-- string access

-- | Header string field types.
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)

{-# LINE 389 "./Sound/File/Sndfile/Interface.chs" #-}
-- | The 'getString' function returns the specified string from the stream header in the 'Maybe' monad if it exists and 'Nothing' otherwise.
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)


-- | The 'setString' function sets the string data associated with the respective 'StringType'.
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))))