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


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

import Sound.ALSA.PCM.C2HS (cIntConv, peekIntConv, withIntConv, cFromEnum, )
import Sound.ALSA.Exception (checkResult, checkResult_, )

import Foreign.C.Types (CUInt, CULong, CInt, CLong, CChar, )
import Foreign.C.String (withCString, )
import Foreign.Ptr (Ptr, castPtr, )
import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )
import Foreign.Marshal.Utils (with, )
import Foreign.Marshal.Alloc (alloca, )



-- HACK for 32-bit machines.
-- This is only used to be able to parse alsa/pcm.h,
-- since snd_pcm_format_silence_64 use u_int64_t which is not
-- defined on 32-bit machines, AFAICT



{-# LINE 26 "src/Sound/ALSA/PCM/Core.chs" #-}

newtype Pcm = Pcm (Ptr (Pcm))
{-# LINE 28 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable Pcm where
    sizeOf (Pcm r) = sizeOf r
    alignment (Pcm r) = alignment r
    peek p = fmap Pcm (peek (castPtr p))
    poke p (Pcm r) = poke (castPtr p) r

newtype HwParams = HwParams (Ptr (HwParams))
{-# LINE 36 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable HwParams where
    sizeOf (HwParams r) = sizeOf r
    alignment (HwParams r) = alignment r
    peek p = fmap HwParams (peek (castPtr p))
    poke p (HwParams r) = poke (castPtr p) r

newtype SwParams = SwParams (Ptr (SwParams))
{-# LINE 44 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable SwParams where
    sizeOf (SwParams r) = sizeOf r
    alignment (SwParams r) = alignment r
    peek p = fmap SwParams (peek (castPtr p))
    poke p (SwParams r) = poke (castPtr p) r

data Stream = StreamPlayback
            | StreamCapture
            | StreamLast
            deriving (Eq,Show)
instance Enum Stream where
  fromEnum StreamPlayback = 0
  fromEnum StreamCapture = 1
  fromEnum StreamLast = 1

  toEnum 0 = StreamPlayback
  toEnum 1 = StreamCapture
  toEnum 1 = StreamLast
  toEnum unmatched = error ("Stream.toEnum: Cannot match " ++ show unmatched)

{-# LINE 52 "src/Sound/ALSA/PCM/Core.chs" #-}

data Access = AccessMmapInterleaved
            | AccessMmapNoninterleaved
            | AccessMmapComplex
            | AccessRwInterleaved
            | AccessRwNoninterleaved
            | AccessLast
            deriving (Eq,Show)
instance Enum Access where
  fromEnum AccessMmapInterleaved = 0
  fromEnum AccessMmapNoninterleaved = 1
  fromEnum AccessMmapComplex = 2
  fromEnum AccessRwInterleaved = 3
  fromEnum AccessRwNoninterleaved = 4
  fromEnum AccessLast = 4

  toEnum 0 = AccessMmapInterleaved
  toEnum 1 = AccessMmapNoninterleaved
  toEnum 2 = AccessMmapComplex
  toEnum 3 = AccessRwInterleaved
  toEnum 4 = AccessRwNoninterleaved
  toEnum 4 = AccessLast
  toEnum unmatched = error ("Access.toEnum: Cannot match " ++ show unmatched)

{-# LINE 54 "src/Sound/ALSA/PCM/Core.chs" #-}

data Format = FormatUnknown
            | FormatS8
            | FormatU8
            | FormatS16Le
            | FormatS16Be
            | FormatU16Le
            | FormatU16Be
            | FormatS24Le
            | FormatS24Be
            | FormatU24Le
            | FormatU24Be
            | FormatS32Le
            | FormatS32Be
            | FormatU32Le
            | FormatU32Be
            | FormatFloatLe
            | FormatFloatBe
            | FormatFloat64Le
            | FormatFloat64Be
            | FormatIec958SubframeLe
            | FormatIec958SubframeBe
            | FormatMuLaw
            | FormatALaw
            | FormatImaAdpcm
            | FormatMpeg
            | FormatGsm
            | FormatSpecial
            | FormatS243le
            | FormatS243be
            | FormatU243le
            | FormatU243be
            | FormatS203le
            | FormatS203be
            | FormatU203le
            | FormatU203be
            | FormatS183le
            | FormatS183be
            | FormatU183le
            | FormatU183be
            | FormatLast
            | FormatS16
            | FormatU16
            | FormatS24
            | FormatU24
            | FormatS32
            | FormatU32
            | FormatFloat
            | FormatFloat64
            | FormatIec958Subframe
            deriving (Eq,Show)
instance Enum Format where
  fromEnum FormatUnknown = (-1)
  fromEnum FormatS8 = 0
  fromEnum FormatU8 = 1
  fromEnum FormatS16Le = 2
  fromEnum FormatS16Be = 3
  fromEnum FormatU16Le = 4
  fromEnum FormatU16Be = 5
  fromEnum FormatS24Le = 6
  fromEnum FormatS24Be = 7
  fromEnum FormatU24Le = 8
  fromEnum FormatU24Be = 9
  fromEnum FormatS32Le = 10
  fromEnum FormatS32Be = 11
  fromEnum FormatU32Le = 12
  fromEnum FormatU32Be = 13
  fromEnum FormatFloatLe = 14
  fromEnum FormatFloatBe = 15
  fromEnum FormatFloat64Le = 16
  fromEnum FormatFloat64Be = 17
  fromEnum FormatIec958SubframeLe = 18
  fromEnum FormatIec958SubframeBe = 19
  fromEnum FormatMuLaw = 20
  fromEnum FormatALaw = 21
  fromEnum FormatImaAdpcm = 22
  fromEnum FormatMpeg = 23
  fromEnum FormatGsm = 24
  fromEnum FormatSpecial = 31
  fromEnum FormatS243le = 32
  fromEnum FormatS243be = 33
  fromEnum FormatU243le = 34
  fromEnum FormatU243be = 35
  fromEnum FormatS203le = 36
  fromEnum FormatS203be = 37
  fromEnum FormatU203le = 38
  fromEnum FormatU203be = 39
  fromEnum FormatS183le = 40
  fromEnum FormatS183be = 41
  fromEnum FormatU183le = 42
  fromEnum FormatU183be = 43
  fromEnum FormatLast = 43
  fromEnum FormatS16 = 2
  fromEnum FormatU16 = 4
  fromEnum FormatS24 = 6
  fromEnum FormatU24 = 8
  fromEnum FormatS32 = 10
  fromEnum FormatU32 = 12
  fromEnum FormatFloat = 14
  fromEnum FormatFloat64 = 16
  fromEnum FormatIec958Subframe = 18

  toEnum (-1) = FormatUnknown
  toEnum 0 = FormatS8
  toEnum 1 = FormatU8
  toEnum 2 = FormatS16Le
  toEnum 3 = FormatS16Be
  toEnum 4 = FormatU16Le
  toEnum 5 = FormatU16Be
  toEnum 6 = FormatS24Le
  toEnum 7 = FormatS24Be
  toEnum 8 = FormatU24Le
  toEnum 9 = FormatU24Be
  toEnum 10 = FormatS32Le
  toEnum 11 = FormatS32Be
  toEnum 12 = FormatU32Le
  toEnum 13 = FormatU32Be
  toEnum 14 = FormatFloatLe
  toEnum 15 = FormatFloatBe
  toEnum 16 = FormatFloat64Le
  toEnum 17 = FormatFloat64Be
  toEnum 18 = FormatIec958SubframeLe
  toEnum 19 = FormatIec958SubframeBe
  toEnum 20 = FormatMuLaw
  toEnum 21 = FormatALaw
  toEnum 22 = FormatImaAdpcm
  toEnum 23 = FormatMpeg
  toEnum 24 = FormatGsm
  toEnum 31 = FormatSpecial
  toEnum 32 = FormatS243le
  toEnum 33 = FormatS243be
  toEnum 34 = FormatU243le
  toEnum 35 = FormatU243be
  toEnum 36 = FormatS203le
  toEnum 37 = FormatS203be
  toEnum 38 = FormatU203le
  toEnum 39 = FormatU203be
  toEnum 40 = FormatS183le
  toEnum 41 = FormatS183be
  toEnum 42 = FormatU183le
  toEnum 43 = FormatU183be
  toEnum 43 = FormatLast
  toEnum 2 = FormatS16
  toEnum 4 = FormatU16
  toEnum 6 = FormatS24
  toEnum 8 = FormatU24
  toEnum 10 = FormatS32
  toEnum 12 = FormatU32
  toEnum 14 = FormatFloat
  toEnum 16 = FormatFloat64
  toEnum 18 = FormatIec958Subframe
  toEnum unmatched = error ("Format.toEnum: Cannot match " ++ show unmatched)

{-# LINE 56 "src/Sound/ALSA/PCM/Core.chs" #-}

open :: String -> Stream -> Int -> IO (Pcm)
open a2 a3 a4 =
  alloca $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = cFromEnum a3} in 
  let {a4' = fromIntegral a4} in 
  open'_ a1' a2' a3' a4' >>= \res ->
  peek  a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 63 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.open"

close :: Pcm -> IO ()
close a1 =
  let {a1' = id a1} in 
  close'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 68 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.close"

prepare :: Pcm -> IO ()
prepare a1 =
  let {a1' = id a1} in 
  prepare'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 73 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.prepare"

start :: Pcm -> IO ()
start a1 =
  let {a1' = id a1} in 
  start'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 78 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.start"

drop :: Pcm -> IO ()
drop a1 =
  let {a1' = id a1} in 
  drop'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 83 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.drop"

drain :: Pcm -> IO ()
drain a1 =
  let {a1' = id a1} in 
  drain'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 88 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.drain"

{-
-- Only available in 1.0.11rc3 and later
{#fun set_params
  { id `Pcm',
    cFromEnum `PcmFormat',
    cFromEnum `PcmAccess',
    `Int',
    `Int',
    `Bool',
    `Int' }
 -> `()' result*- #}
  where result = checkResult_ "PCM.set_params"
-}

hw_params :: Pcm -> HwParams -> IO ()
hw_params a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  hw_params'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 108 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params"

hw_params_any :: Pcm -> HwParams -> IO ()
hw_params_any a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  hw_params_any'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 114 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_any"

hw_params_set_access :: Pcm -> HwParams -> Access -> IO ()
hw_params_set_access a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cFromEnum a3} in 
  hw_params_set_access'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 122 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_access"

hw_params_set_format :: Pcm -> HwParams -> Format -> IO ()
hw_params_set_format a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cFromEnum a3} in 
  hw_params_set_format'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 130 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_format"

hw_params_set_rate :: Pcm -> HwParams -> Int -> Ordering -> IO ()
hw_params_set_rate a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = orderingToInt a4} in 
  hw_params_set_rate'_ a1' a2' a3' a4' >>= \res ->
  result res >> 
  return ()
{-# LINE 139 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_rate"

{-
-- Available in 1.0.9rc2 and later
{#fun hw_params_set_rate_resample
  { id `Pcm',
    id `HwParams',
    `Bool'
 }
 -> `()' result*- #}
  where result = checkResult_ "PCM.hw_params_set_rate_resample"
-}

hw_params_set_channels :: Pcm -> HwParams -> Int -> IO ()
hw_params_set_channels a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  hw_params_set_channels'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 158 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_channels"

hw_params_set_buffer_size :: Pcm -> HwParams -> Int -> IO ()
hw_params_set_buffer_size a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  hw_params_set_buffer_size'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 166 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_buffer_size"

hw_params_get_buffer_size :: HwParams -> IO (Int)
hw_params_get_buffer_size a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  hw_params_get_buffer_size'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  result res >> 
  return (a2'')
{-# LINE 173 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_get_buffer_size"

hw_params_get_period_size :: HwParams -> IO (Int, Ordering)
hw_params_get_period_size a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  hw_params_get_period_size'_ a1' a2' a3' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  peekOrdering  a3'>>= \a3'' -> 
  result res >> 
  return (a2'', a3'')
{-# LINE 181 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_get_period_size"

hw_params_set_period_time_near :: Pcm -> HwParams -> Int -> Ordering -> IO (Int, Ordering)
hw_params_set_period_time_near a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntConv a3 $ \a3' -> 
  withOrdering a4 $ \a4' -> 
  hw_params_set_period_time_near'_ a1' a2' a3' a4' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  peekOrdering  a4'>>= \a4'' -> 
  result res >> 
  return (a3'', a4'')
{-# LINE 190 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_period_time_near"

hw_params_set_periods :: Pcm -> HwParams -> Int -> Ordering -> IO ()
hw_params_set_periods a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = orderingToInt a4} in 
  hw_params_set_periods'_ a1' a2' a3' a4' >>= \res ->
  result res >> 
  return ()
{-# LINE 199 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_periods"

hw_params_set_buffer_time_near :: Pcm -> HwParams -> Int -> Ordering -> IO (Int, Ordering)
hw_params_set_buffer_time_near a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntConv a3 $ \a3' -> 
  withOrdering a4 $ \a4' -> 
  hw_params_set_buffer_time_near'_ a1' a2' a3' a4' >>= \res ->
  peekIntConv  a3'>>= \a3'' -> 
  peekOrdering  a4'>>= \a4'' -> 
  result res >> 
  return (a3'', a4'')
{-# LINE 208 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_set_buffer_time_near"

hw_params_get_buffer_time :: HwParams -> IO (Int, Ordering)
hw_params_get_buffer_time a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  hw_params_get_buffer_time'_ a1' a2' a3' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  peekOrdering  a3'>>= \a3'' -> 
  result res >> 
  return (a2'', a3'')
{-# LINE 216 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_get_buffer_time"

sw_params_set_start_threshold :: Pcm -> SwParams -> Int -> IO ()
sw_params_set_start_threshold a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  sw_params_set_start_threshold'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 224 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_set_start_threshold"

sw_params_set_avail_min :: Pcm -> SwParams -> Int -> IO ()
sw_params_set_avail_min a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  sw_params_set_avail_min'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 232 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_set_avail_min"

sw_params_set_xfer_align :: Pcm -> SwParams -> Int -> IO ()
sw_params_set_xfer_align a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  sw_params_set_xfer_align'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 239 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_set_xfer_align"

sw_params_set_silence_threshold :: Pcm -> SwParams -> Int -> IO ()
sw_params_set_silence_threshold a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  sw_params_set_silence_threshold'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 246 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_set_silence_threshold"

sw_params_set_silence_size :: Pcm -> SwParams -> Int -> IO ()
sw_params_set_silence_size a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  sw_params_set_silence_size'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 253 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_set_silence_size"

readi :: Pcm -> Ptr a -> Int -> IO (Int)
readi a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = castPtr a2} in 
  let {a3' = fromIntegral a3} in 
  readi'_ a1' a2' a3' >>= \res ->
  result res >>= \res' ->
  return (res')
{-# LINE 261 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = fmap fromIntegral . checkResult "PCM.readi"

writei :: Pcm -> Ptr a -> Int -> IO (Int)
writei a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = castPtr a2} in 
  let {a3' = fromIntegral a3} in 
  writei'_ a1' a2' a3' >>= \res ->
  result res >>= \res' ->
  return (res')
{-# LINE 269 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = fmap fromIntegral . checkResult "PCM.writei"

hw_params_malloc :: IO (HwParams)
hw_params_malloc =
  alloca $ \a1' -> 
  hw_params_malloc'_ a1' >>= \res ->
  peek  a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 274 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.hw_params_malloc"

hw_params_free :: HwParams -> IO ()
hw_params_free a1 =
  let {a1' = id a1} in 
  hw_params_free'_ a1' >>= \res ->
  return ()
{-# LINE 279 "src/Sound/ALSA/PCM/Core.chs" #-}

sw_params_malloc :: IO (SwParams)
sw_params_malloc =
  alloca $ \a1' -> 
  sw_params_malloc'_ a1' >>= \res ->
  peek  a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 283 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_malloc"

sw_params_free :: SwParams -> IO ()
sw_params_free a1 =
  let {a1' = id a1} in 
  sw_params_free'_ a1' >>= \res ->
  return ()
{-# LINE 288 "src/Sound/ALSA/PCM/Core.chs" #-}

sw_params :: Pcm -> SwParams -> IO ()
sw_params a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  sw_params'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 293 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params"

sw_params_current :: Pcm -> SwParams -> IO ()
sw_params_current a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  sw_params_current'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 299 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "PCM.sw_params_current"

--
-- * Marshalling utilities
--

orderingToInt :: Ordering -> CInt
orderingToInt o = fromIntegral (fromEnum o - 1)

intToOrdering :: CInt -> Ordering
intToOrdering i = compare i 0

peekOrdering :: Ptr CInt -> IO Ordering
peekOrdering = fmap intToOrdering . peek

withOrdering :: Ordering -> (Ptr CInt -> IO a) -> IO a
withOrdering o = with (orderingToInt o)

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_open"
  open'_ :: ((Ptr (Pcm)) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_close"
  close'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_prepare"
  prepare'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_start"
  start'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_drop"
  drop'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_drain"
  drain'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params"
  hw_params'_ :: ((Pcm) -> ((HwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_any"
  hw_params_any'_ :: ((Pcm) -> ((HwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_access"
  hw_params_set_access'_ :: ((Pcm) -> ((HwParams) -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_format"
  hw_params_set_format'_ :: ((Pcm) -> ((HwParams) -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_rate"
  hw_params_set_rate'_ :: ((Pcm) -> ((HwParams) -> (CUInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_channels"
  hw_params_set_channels'_ :: ((Pcm) -> ((HwParams) -> (CUInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_buffer_size"
  hw_params_set_buffer_size'_ :: ((Pcm) -> ((HwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_buffer_size"
  hw_params_get_buffer_size'_ :: ((HwParams) -> ((Ptr CULong) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_period_size"
  hw_params_get_period_size'_ :: ((HwParams) -> ((Ptr CULong) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_period_time_near"
  hw_params_set_period_time_near'_ :: ((Pcm) -> ((HwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_periods"
  hw_params_set_periods'_ :: ((Pcm) -> ((HwParams) -> (CUInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_buffer_time_near"
  hw_params_set_buffer_time_near'_ :: ((Pcm) -> ((HwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_buffer_time"
  hw_params_get_buffer_time'_ :: ((HwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_start_threshold"
  sw_params_set_start_threshold'_ :: ((Pcm) -> ((SwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_avail_min"
  sw_params_set_avail_min'_ :: ((Pcm) -> ((SwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_xfer_align"
  sw_params_set_xfer_align'_ :: ((Pcm) -> ((SwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_silence_threshold"
  sw_params_set_silence_threshold'_ :: ((Pcm) -> ((SwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_silence_size"
  sw_params_set_silence_size'_ :: ((Pcm) -> ((SwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_readi"
  readi'_ :: ((Pcm) -> ((Ptr ()) -> (CULong -> (IO CLong))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_writei"
  writei'_ :: ((Pcm) -> ((Ptr ()) -> (CULong -> (IO CLong))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_malloc"
  hw_params_malloc'_ :: ((Ptr (HwParams)) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_free"
  hw_params_free'_ :: ((HwParams) -> (IO ()))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_malloc"
  sw_params_malloc'_ :: ((Ptr (SwParams)) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_free"
  sw_params_free'_ :: ((SwParams) -> (IO ()))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params"
  sw_params'_ :: ((Pcm) -> ((SwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_current"
  sw_params_current'_ :: ((Pcm) -> ((SwParams) -> (IO CInt)))