-- GENERATED by C->Haskell Compiler, version 0.25.2 Snowboundest, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}
{- |
A binding to the <http://www.mega-nerd.com/SRC/api_full.html full API> of @libsamplerate@.
Errors are turned into Haskell exceptions of type 'SRCError'.
The @SRC_DATA@ struct is split into two Haskell types
for the input ('DataIn') and output ('DataOut') parts.
-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
module Data.Conduit.Audio.SampleRate.Binding
( new, delete, process, reset, setRatio
, State, DataIn(..), DataOut(..), ConverterType(..), SRCError(..)
) where

import Foreign hiding (new)
import Foreign.C
import Control.Monad (when)
import Data.Typeable (Typeable)
import Control.Exception (Exception, throwIO)



inThisModule :: String -> String
inThisModule = ("Data.Conduit.Audio.SampleRate.Binding." ++)

newtype State = State (Ptr (State))
{-# LINE 28 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}

newtype Data = Data (Ptr (Data))
{-# LINE 29 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}



{-# LINE 31 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


-- SRC_STATE* src_new (int converter_type, int channels, int *error) ;
newRaw :: (ConverterType) -> (Int) -> (Ptr CInt) -> IO ((State))
newRaw a1 a2 a3 =
  let {a1' = convTypeToC a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = id a3} in 
  newRaw'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 38 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


-- SRC_STATE* src_delete (SRC_STATE *state) ;
deleteRaw :: (State) -> IO ((State))
deleteRaw a1 =
  let {a1' = id a1} in 
  deleteRaw'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 43 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


-- int src_process (SRC_STATE *state, SRC_DATA *data) ;
processRaw :: (State) -> (Data) -> IO ((Int))
processRaw a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  processRaw'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 49 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


-- int src_reset (SRC_STATE *state) ;
resetRaw :: (State) -> IO ((Int))
resetRaw a1 =
  let {a1' = id a1} in 
  resetRaw'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 54 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


-- int src_set_ratio (SRC_STATE *state, double new_ratio) ;
setRatioRaw :: (State) -> (Double) -> IO ((Int))
setRatioRaw a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  setRatioRaw'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 60 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


data ConverterType = SincBestQuality
                   | SincMediumQuality
                   | SincFastest
                   | ZeroOrderHold
                   | Linear
  deriving (Eq,Ord,Show,Read,Bounded)
instance Enum ConverterType where
  succ SincBestQuality = SincMediumQuality
  succ SincMediumQuality = SincFastest
  succ SincFastest = ZeroOrderHold
  succ ZeroOrderHold = Linear
  succ Linear = error "ConverterType.succ: Linear has no successor"

  pred SincMediumQuality = SincBestQuality
  pred SincFastest = SincMediumQuality
  pred ZeroOrderHold = SincFastest
  pred Linear = ZeroOrderHold
  pred SincBestQuality = error "ConverterType.pred: SincBestQuality has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Linear

  fromEnum SincBestQuality = 0
  fromEnum SincMediumQuality = 1
  fromEnum SincFastest = 2
  fromEnum ZeroOrderHold = 3
  fromEnum Linear = 4

  toEnum 0 = SincBestQuality
  toEnum 1 = SincMediumQuality
  toEnum 2 = SincFastest
  toEnum 3 = ZeroOrderHold
  toEnum 4 = Linear
  toEnum unmatched = error ("ConverterType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 68 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


convTypeToC :: ConverterType -> CInt
convTypeToC = fromIntegral . fromEnum

-- const char* src_strerror (int error) ;
strerror :: (CInt) -> IO ((CString))
strerror a1 =
  let {a1' = id a1} in 
  strerror'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 76 "src/Data/Conduit/Audio/SampleRate/Binding.chs" #-}


sampleRateError :: (Integral i) => String -> i -> IO ()
sampleRateError _  0 = return ()
sampleRateError fn i = do
  ps <- strerror $ fromIntegral i
  s <- if ps == nullPtr
    then return "strerror returned NULL"
    else peekCString ps
  throwIO $ SRCError (inThisModule fn) (fromIntegral i) s

-- | @libsamplerate@ functions may throw this as an exception.
-- Contains the function that caused the error, the numeric error code,
-- and a human-readable message.
data SRCError = SRCError String Int String
  deriving (Eq, Ord, Show, Read, Typeable)

instance Exception SRCError

new
  :: ConverterType
  -> Int -- ^ channels
  -> IO State
new ctype chans = alloca $ \perr -> do
  state@(State pstate) <- newRaw ctype chans perr
  when (pstate == nullPtr) $ peek perr >>= sampleRateError "new"
  return state

{-
typedef struct
{   float  *data_in, *data_out ;

    long   input_frames, output_frames ;
    long   input_frames_used, output_frames_gen ;

    int    end_of_input ;

    double src_ratio ;
} SRC_DATA ;
-}

data DataIn = DataIn
  { data_in       :: Ptr CFloat
  , data_out      :: Ptr CFloat
  , input_frames  :: Integer
  , output_frames :: Integer
  , src_ratio     :: Double
  , end_of_input  :: Bool
  } deriving (Eq, Ord, Show)

data DataOut = DataOut
  { input_frames_used :: Integer
  , output_frames_gen :: Integer
  } deriving (Eq, Ord, Show)

process :: State -> DataIn -> IO DataOut
process state input = allocaBytes 64 $ \pdata -> do
  let sdata = Data pdata
  (\(Data ptr) val -> do {pokeByteOff ptr 0 (val :: (Ptr CFloat))}) sdata $ data_in                      input
  (\(Data ptr) val -> do {pokeByteOff ptr 8 (val :: (Ptr CFloat))}) sdata $ data_out                     input
  (\(Data ptr) val -> do {pokeByteOff ptr 16 (val :: CLong)}) sdata $ fromIntegral $ input_frames  input
  (\(Data ptr) val -> do {pokeByteOff ptr 24 (val :: CLong)}) sdata $ fromIntegral $ output_frames input
  (\(Data ptr) val -> do {pokeByteOff ptr 56 (val :: CDouble)}) sdata $ realToFrac   $ src_ratio     input
  (\(Data ptr) val -> do {pokeByteOff ptr 48 (val :: CInt)}) sdata $ fromBool     $ end_of_input  input
  processRaw state sdata >>= sampleRateError "process"
  DataOut
    <$> fmap fromIntegral ((\(Data ptr) -> do {peekByteOff ptr 32 :: IO CLong}) sdata)
    <*> fmap fromIntegral ((\(Data ptr) -> do {peekByteOff ptr 40 :: IO CLong}) sdata)

delete :: State -> IO ()
delete state = do
  State p <- deleteRaw state
  when (p /= nullPtr) $ throwIO $
    SRCError (inThisModule "delete") 0 "delete returned non-null pointer"

reset :: State -> IO ()
reset state = resetRaw state >>= sampleRateError "reset"

setRatio :: State -> Double -> IO ()
setRatio state r = setRatioRaw state r >>= sampleRateError "setRatio"

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_new"
  newRaw'_ :: (CInt -> (CInt -> ((Ptr CInt) -> (IO (State)))))

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_delete"
  deleteRaw'_ :: ((State) -> (IO (State)))

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_process"
  processRaw'_ :: ((State) -> ((Data) -> (IO CInt)))

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_reset"
  resetRaw'_ :: ((State) -> (IO CInt))

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_set_ratio"
  setRatioRaw'_ :: ((State) -> (CDouble -> (IO CInt)))

foreign import ccall safe "Data/Conduit/Audio/SampleRate/Binding.chs.h src_strerror"
  strerror'_ :: (CInt -> (IO (Ptr CChar)))