{-# LINE 1 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.PCM.Core.SwParams where

import Sound.ALSA.PCM.Core.Handle (Handle, Size, )
import qualified Sound.ALSA.PCM.Core.Handle as H -- expose Handle constructor to FFI
import qualified Sound.ALSA.PCM.Core.Convert as Conv

import Sound.ALSA.Exception (checkResult_, )

import Control.Applicative (Applicative(pure, (<*>)))

import Control.Exception (bracket, )

import qualified Foreign.Storable.Newtype as Store

import qualified Foreign.C.Types as C
import Foreign.Ptr (Ptr, )
import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )
import Foreign.Marshal.Alloc (alloca, )

import Data.Word (Word, )




newtype T i y a = Cons (H.Handle i y -> Ptr Params -> IO a)

data Params = Params


{-
T is a Reader monad.
-}
instance Functor (T i y) where
   fmap f (Cons act) = Cons $ \h p -> fmap f $ act h p

instance Applicative (T i y) where
   pure a = Cons $ \ _h _p -> pure a
   Cons f <*> Cons x = Cons $ \h p -> f h p <*> x h p

instance Monad (T i y) where
   return a = Cons $ \ _h _p -> return a
   Cons x >>= k =
      Cons $ \h p -> x h p >>= \a -> case k a of Cons y -> y h p



withIO :: Handle i y -> (Ptr Params -> IO a) -> IO a
withIO h f =
   bracket malloc free $ \p -> do
      current h p
      x <- f p
      set h p
      return x
--   bracket_ (current h p) (set h p) (f p)


foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_malloc"
   malloc_ :: Ptr (Ptr Params) -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_free"
   free :: Ptr Params -> IO ()

malloc :: IO (Ptr Params)
malloc =
   alloca $ \pp ->
   malloc_ pp >>=
   checkResult_ "SwParams.malloc" >>
   peek pp



foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params"
   set_ :: Handle i y -> Ptr Params -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_current"
   current_ :: Handle i y -> Ptr Params -> IO C.CInt

set :: Handle i y -> Ptr Params -> IO ()
set h p =
   set_ h p >>= checkResult_ "SwParams.set"

current :: Handle i y -> Ptr Params -> IO ()
current h p =
   current_ h p >>= checkResult_ "SwParams.current"



newtype TimestampMode = TimestampMode {fromTimestampMode :: C.CInt}
   deriving (Eq, Ord)

instance Enum TimestampMode where
   toEnum n = TimestampMode $ fromIntegral n
   fromEnum (TimestampMode n) = fromIntegral n

instance Storable TimestampMode where
   sizeOf = Store.sizeOf fromTimestampMode
   alignment = Store.alignment fromTimestampMode
   peek = Store.peek TimestampMode
   poke = Store.poke fromTimestampMode

timestampNone  :: TimestampMode
timestampNone  = TimestampMode 0
timestampMmap  :: TimestampMode
timestampMmap  = TimestampMode 1

{-# LINE 105 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}






foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_tstamp_mode"
   setTimestampMode_ :: Handle i y -> Ptr Params -> TimestampMode -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_tstamp_mode"
   getTimestampMode_ :: Ptr Params -> Ptr TimestampMode -> IO C.CInt

setTimestampMode :: TimestampMode -> T i y ()
setTimestampMode x =
   Cons $ \h p ->
   setTimestampMode_ h p (Conv.fromHaskell Conv.id x) >>=
   checkResult_ "SwParams.setTimestampMode"

getTimestampMode :: T i y TimestampMode
getTimestampMode =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getTimestampMode_ p ptr >>=
   checkResult_ "SwParams.getTimestampMode" >>
   Conv.peek Conv.id ptr

{-# LINE 132 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_sleep_min"
   setSleepMin_ :: Handle i y -> Ptr Params -> C.CUInt -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_sleep_min"
   getSleepMin_ :: Ptr Params -> Ptr C.CUInt -> IO C.CInt

setSleepMin :: Word -> T i y ()
setSleepMin x =
   Cons $ \h p ->
   setSleepMin_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setSleepMin"

getSleepMin :: T i y Word
getSleepMin =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getSleepMin_ p ptr >>=
   checkResult_ "SwParams.getSleepMin" >>
   Conv.peek Conv.int ptr

{-# LINE 133 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_avail_min"
   setAvailMin_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_avail_min"
   getAvailMin_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setAvailMin :: Size -> T i y ()
setAvailMin x =
   Cons $ \h p ->
   setAvailMin_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setAvailMin"

getAvailMin :: T i y Size
getAvailMin =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getAvailMin_ p ptr >>=
   checkResult_ "SwParams.getAvailMin" >>
   Conv.peek Conv.int ptr

{-# LINE 134 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_xfer_align"
   setXferAlign_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_xfer_align"
   getXferAlign_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setXferAlign :: Size -> T i y ()
setXferAlign x =
   Cons $ \h p ->
   setXferAlign_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setXferAlign"

getXferAlign :: T i y Size
getXferAlign =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getXferAlign_ p ptr >>=
   checkResult_ "SwParams.getXferAlign" >>
   Conv.peek Conv.int ptr

{-# LINE 135 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_start_threshold"
   setStartThreshold_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_start_threshold"
   getStartThreshold_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setStartThreshold :: Size -> T i y ()
setStartThreshold x =
   Cons $ \h p ->
   setStartThreshold_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setStartThreshold"

getStartThreshold :: T i y Size
getStartThreshold =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getStartThreshold_ p ptr >>=
   checkResult_ "SwParams.getStartThreshold" >>
   Conv.peek Conv.int ptr

{-# LINE 136 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_stop_threshold"
   setStopThreshold_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_stop_threshold"
   getStopThreshold_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setStopThreshold :: Size -> T i y ()
setStopThreshold x =
   Cons $ \h p ->
   setStopThreshold_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setStopThreshold"

getStopThreshold :: T i y Size
getStopThreshold =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getStopThreshold_ p ptr >>=
   checkResult_ "SwParams.getStopThreshold" >>
   Conv.peek Conv.int ptr

{-# LINE 137 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_silence_threshold"
   setSilenceThreshold_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_silence_threshold"
   getSilenceThreshold_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setSilenceThreshold :: Size -> T i y ()
setSilenceThreshold x =
   Cons $ \h p ->
   setSilenceThreshold_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setSilenceThreshold"

getSilenceThreshold :: T i y Size
getSilenceThreshold =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getSilenceThreshold_ p ptr >>=
   checkResult_ "SwParams.getSilenceThreshold" >>
   Conv.peek Conv.int ptr

{-# LINE 138 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}
foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_set_silence_size"
   setSilenceSize_ :: Handle i y -> Ptr Params -> C.CULong -> IO C.CInt

foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_get_silence_size"
   getSilenceSize_ :: Ptr Params -> Ptr C.CULong -> IO C.CInt

setSilenceSize :: Size -> T i y ()
setSilenceSize x =
   Cons $ \h p ->
   setSilenceSize_ h p (Conv.fromHaskell Conv.int x) >>=
   checkResult_ "SwParams.setSilenceSize"

getSilenceSize :: T i y Size
getSilenceSize =
   Cons $ \_ p ->
   alloca $ \ptr ->
   getSilenceSize_ p ptr >>=
   checkResult_ "SwParams.getSilenceSize" >>
   Conv.peek Conv.int ptr

{-# LINE 139 "src/Sound/ALSA/PCM/Core/SwParams.hsc" #-}