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


{-# LINE 1 "./Sound/ALSA/Mixer/Internal.chs" #-}{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Sound.ALSA.Mixer.Internal
    ( Mixer()
    , SimpleElement()
    , SimpleElementId()
    , Channel(..)
    , allChannels
    , elements
    , withMixer
    , isPlaybackMono
    , isCaptureMono
    , hasPlaybackChannel
    , hasCaptureChannel
    , hasCommonVolume
    , hasPlaybackVolume
    , hasPlaybackVolumeJoined
    , hasCaptureVolume
    , hasCaptureVolumeJoined
    , hasCommonSwitch
    , hasPlaybackSwitch
    , hasPlaybackSwitchJoined
    , hasCaptureSwitch
    , hasCaptureSwitchJoined
    , getPlaybackVolume
    , getCaptureVolume
    , getPlaybackDb
    , getCaptureDb
    , getPlaybackSwitch
    , getCaptureSwitch
    , setPlaybackVolume
    , setCaptureVolume
    , setPlaybackDb
    , setCaptureDb
    , setPlaybackVolumeAll
    , setCaptureVolumeAll
    , setPlaybackDbAll
    , setCaptureDbAll
    , setPlaybackSwitch
    , setCaptureSwitch
    , setPlaybackSwitchAll
    , setCaptureSwitchAll
    , getPlaybackVolumeRange
    , getPlaybackDbRange
    , getCaptureVolumeRange
    , getCaptureDbRange
    , setPlaybackVolumeRange
    , setCaptureVolumeRange
    , getName
    , getIndex
    ) where

import Control.Monad (liftM, when)
import Control.Exception (bracket)
import Foreign
import Foreign.C.Error ( eNOENT )
import Foreign.C.String
import Foreign.C.Types
import Sound.ALSA.Exception ( checkResult_, throw )
import System.Posix.Process (getProcessID)


{-# LINE 62 "./Sound/ALSA/Mixer/Internal.chs" #-}

newtype Mixer = Mixer (Ptr (Mixer))
{-# LINE 64 "./Sound/ALSA/Mixer/Internal.chs" #-}
type Element = Ptr (())
{-# LINE 65 "./Sound/ALSA/Mixer/Internal.chs" #-}
type SimpleElementId = ForeignPtr (())
{-# LINE 66 "./Sound/ALSA/Mixer/Internal.chs" #-}
type SimpleElement = (Mixer, Element)

data Channel = Unknown
             | FrontLeft
             | FrontRight
             | RearLeft
             | RearRight
             | FrontCenter
             | Woofer
             | SideLeft
             | SideRight
             | RearCenter
             | Last
             | SND_MIXER_SCHN_MONO
             deriving (Eq,Read,Show)
instance Enum Channel where
  fromEnum Unknown = (-1)
  fromEnum FrontLeft = 0
  fromEnum FrontRight = 1
  fromEnum RearLeft = 2
  fromEnum RearRight = 3
  fromEnum FrontCenter = 4
  fromEnum Woofer = 5
  fromEnum SideLeft = 6
  fromEnum SideRight = 7
  fromEnum RearCenter = 8
  fromEnum Last = 31
  fromEnum SND_MIXER_SCHN_MONO = 0

  toEnum (-1) = Unknown
  toEnum 0 = FrontLeft
  toEnum 1 = FrontRight
  toEnum 2 = RearLeft
  toEnum 3 = RearRight
  toEnum 4 = FrontCenter
  toEnum 5 = Woofer
  toEnum 6 = SideLeft
  toEnum 7 = SideRight
  toEnum 8 = RearCenter
  toEnum 31 = Last
  toEnum 0 = SND_MIXER_SCHN_MONO
  toEnum unmatched = error ("Channel.toEnum: Cannot match " ++ show unmatched)

{-# LINE 81 "./Sound/ALSA/Mixer/Internal.chs" #-}

allChannels :: [Channel]
allChannels = map toEnum $ enumFromTo (fromEnum FrontLeft) (fromEnum RearCenter)

-----------------------------------------------------------------------
-- open
-- --------------------------------------------------------------------

foreign import ccall safe "alsa/asoundlib.h snd_mixer_open"
  open_ :: Ptr (Ptr Mixer) -> CInt -> IO CInt

open :: IO Mixer
open = withPtr $ \ppm ->
  do open_ ppm (fromIntegral 0) >>= checkResult_ "snd_mixer_open"
     liftM Mixer $ peek ppm

withPtr :: (Ptr (Ptr a) -> IO a) -> IO a
withPtr = bracket malloc free

foreign import ccall "alsa/asoundlib.h snd_mixer_close"
  freeMixer :: Ptr Mixer -> IO ()

-----------------------------------------------------------------------
-- attach
-- --------------------------------------------------------------------

attach :: (Mixer) -> (String) -> IO ()
attach a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  attach'_ a1' a2' >>= \res ->
  checkAttach res >> 
  return ()
{-# LINE 109 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkAttach = checkResult_ "snd_mixer_attach"

-----------------------------------------------------------------------
-- load
-- --------------------------------------------------------------------

sndMixerLoad :: (Mixer) -> IO ()
sndMixerLoad a1 =
  let {a1' = id a1} in 
  sndMixerLoad'_ a1' >>= \res ->
  checkSndMixerLoad res >> 
  return ()
{-# LINE 118 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSndMixerLoad = checkResult_ "snd_mixer_load"

sndMixerSelemRegister :: (Mixer) -> (Ptr ()) -> (Ptr (Ptr ())) -> IO ()
sndMixerSelemRegister a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  sndMixerSelemRegister'_ a1' a2' a3' >>= \res ->
  checkSndMixerSelemRegister res >> 
  return ()
{-# LINE 125 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSndMixerSelemRegister = checkResult_ "snd_mixer_selem_register"

load :: Mixer -> IO ()
load fmix = do
    sndMixerSelemRegister fmix nullPtr nullPtr
    sndMixerLoad fmix

-----------------------------------------------------------------------
-- getId
-- --------------------------------------------------------------------

sndMixerSelemIdMalloc :: IO ((SimpleElementId))
sndMixerSelemIdMalloc =
  alloca $ \a1' -> 
  sndMixerSelemIdMalloc'_ a1' >>= \res ->
  peekSimpleElementId  a1'>>= \a1'' -> 
  return (a1'')
{-# LINE 139 "./Sound/ALSA/Mixer/Internal.chs" #-}

sndMixerSelemGetId :: (Element) -> (SimpleElementId) -> IO ()
sndMixerSelemGetId a1 a2 =
  let {a1' = id a1} in 
  withForeignPtr a2 $ \a2' -> 
  sndMixerSelemGetId'_ a1' a2' >>= \res ->
  return ()
{-# LINE 142 "./Sound/ALSA/Mixer/Internal.chs" #-}

peekSimpleElementId pid = peek pid >>= newForeignPtr snd_mixer_selem_id_free

foreign import ccall "alsa/asoundlib.h &snd_mixer_selem_id_free"
  snd_mixer_selem_id_free :: FunPtr (Ptr () -> IO ())

getId :: Element -> IO SimpleElementId
getId e = do
   newSid <- sndMixerSelemIdMalloc
   sndMixerSelemGetId e newSid
   return newSid

-----------------------------------------------------------------------
-- elements
-- --------------------------------------------------------------------

sndMixerFirstElem :: (Mixer) -> IO ((Element))
sndMixerFirstElem a1 =
  let {a1' = id a1} in 
  sndMixerFirstElem'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 160 "./Sound/ALSA/Mixer/Internal.chs" #-}

sndMixerLastElem :: (Mixer) -> IO ((Element))
sndMixerLastElem a1 =
  let {a1' = id a1} in 
  sndMixerLastElem'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 163 "./Sound/ALSA/Mixer/Internal.chs" #-}

sndMixerElemNext :: (Element) -> IO ((Element))
sndMixerElemNext a1 =
  let {a1' = id a1} in 
  sndMixerElemNext'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 166 "./Sound/ALSA/Mixer/Internal.chs" #-}

elements :: Mixer -> IO [(SimpleElementId, SimpleElement)]
elements fMix = do
    pFirst <- sndMixerFirstElem fMix
    pLast <- sndMixerLastElem fMix
    es <- elements' pFirst [] pLast
    mapM (simpleElement fMix) es
  where elements' pThis xs pLast | pThis == pLast = return $ pThis : xs
                                 | otherwise = do
                                     pNext <- sndMixerElemNext pThis
                                     elements' pNext (pThis : xs) pLast

-----------------------------------------------------------------------
-- simpleElement
-- --------------------------------------------------------------------

sndMixerFindSelem :: (Mixer) -> (SimpleElementId) -> IO ((Element))
sndMixerFindSelem a1 a2 =
  let {a1' = id a1} in 
  withForeignPtr a2 $ \a2' -> 
  sndMixerFindSelem'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 185 "./Sound/ALSA/Mixer/Internal.chs" #-}

simpleElement :: Mixer -> Element -> IO (SimpleElementId, SimpleElement)
simpleElement fMix pElem = do
    fId <- getId pElem
    pSElem <- sndMixerFindSelem fMix fId
    if pSElem == nullPtr
        then throw "snd_mixer_find_selem" eNOENT
        else return (fId, (fMix, pSElem))

-----------------------------------------------------------------------
-- getName
-- --------------------------------------------------------------------

getName :: (SimpleElementId) -> IO ((String))
getName a1 =
  withForeignPtr a1 $ \a1' -> 
  getName'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 200 "./Sound/ALSA/Mixer/Internal.chs" #-}

-----------------------------------------------------------------------
-- getIndex
-- --------------------------------------------------------------------

getIndex :: (SimpleElementId) -> IO ((Integer))
getIndex a1 =
  withForeignPtr a1 $ \a1' -> 
  getIndex'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 207 "./Sound/ALSA/Mixer/Internal.chs" #-}

-----------------------------------------------------------------------
-- getMixerByName
-- --------------------------------------------------------------------

-- | Perform an 'IO' action with the named mixer. An exception of type
-- 'Sound.ALSA.Exception.T' will be thrown if the named mixer cannot be
-- found. A mixer named \"default\" should always exist.
withMixer :: String -> (Mixer -> IO a) -> IO a
withMixer name f = bracket (do m <- open
                               attach m name
                               load m
                               pid <- getProcessID
                               return (pid, m))
                           (\(creatorPID, Mixer m) ->
                              do myPID <- getProcessID
                                 when (myPID == creatorPID) $ freeMixer m)
                           (f . snd)

-----------------------------------------------------------------------
-- utilities
-- --------------------------------------------------------------------

cToBool = toBool

cFromBool = fromBool

withSimpleElement :: SimpleElement -> (Element -> IO a) -> IO a
withSimpleElement (m, s) f = f s

channelToC = toEnum . fromEnum

cToIntegral = (>>= return . fromIntegral) . peek

cFromIntegral :: Integer -> (Ptr CLong -> IO a) -> IO a
cFromIntegral = with . fromIntegral

negOne f = f $! negate 1

-----------------------------------------------------------------------
-- has
-- --------------------------------------------------------------------

isPlaybackMono :: (SimpleElement) -> IO ((Bool))
isPlaybackMono a1 =
  withSimpleElement a1 $ \a1' -> 
  isPlaybackMono'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 252 "./Sound/ALSA/Mixer/Internal.chs" #-}

isCaptureMono :: (SimpleElement) -> IO ((Bool))
isCaptureMono a1 =
  withSimpleElement a1 $ \a1' -> 
  isCaptureMono'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 255 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCommonVolume :: (SimpleElement) -> IO ((Bool))
hasCommonVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCommonVolume'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 258 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasPlaybackVolume :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackVolume'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 261 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasPlaybackVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolumeJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackVolumeJoined'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 264 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCaptureVolume :: (SimpleElement) -> IO ((Bool))
hasCaptureVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureVolume'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 267 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCaptureVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureVolumeJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureVolumeJoined'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 270 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCommonSwitch :: (SimpleElement) -> IO ((Bool))
hasCommonSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCommonSwitch'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 273 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasPlaybackSwitch :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackSwitch'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 276 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasPlaybackSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitchJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackSwitchJoined'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 279 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCaptureSwitch :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureSwitch'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 282 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCaptureSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitchJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureSwitchJoined'_ a1' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 285 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasPlaybackChannel :: (SimpleElement) -> (Channel) -> IO ((Bool))
hasPlaybackChannel a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  hasPlaybackChannel'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 289 "./Sound/ALSA/Mixer/Internal.chs" #-}

hasCaptureChannel :: (SimpleElement) -> (Channel) -> IO ((Bool))
hasCaptureChannel a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  hasCaptureChannel'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 293 "./Sound/ALSA/Mixer/Internal.chs" #-}

-----------------------------------------------------------------------
-- get
-- --------------------------------------------------------------------

getPlaybackVolume :: (SimpleElement) -> (Channel) -> IO ((Integer))
getPlaybackVolume a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getPlaybackVolume'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackVolume res >> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 302 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetPlaybackVolume = checkResult_ "snd_mixer_selem_get_playback_volume"

getCaptureVolume :: (SimpleElement) -> (Channel) -> IO ((Integer))
getCaptureVolume a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getCaptureVolume'_ a1' a2' a3' >>= \res ->
  checkGetCaptureVolume res >> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 309 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetCaptureVolume = checkResult_ "snd_mixer_selem_get_capture_volume"

getPlaybackDb :: (SimpleElement) -> (Channel) -> IO ((Integer))
getPlaybackDb a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getPlaybackDb'_ a1' a2' a3' >>= \res ->
  checkPlaybackDb res >> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 316 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkPlaybackDb = checkResult_ "snd_mixer_selem_get_playback_dB"

getCaptureDb :: (SimpleElement) -> (Channel) -> IO ((Integer))
getCaptureDb a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getCaptureDb'_ a1' a2' a3' >>= \res ->
  checkCaptureDb res >> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 323 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkCaptureDb = checkResult_ "snd_mixer_selem_get_capture_dB"

peekBool = (>>= return . cToBool) . peek

getPlaybackSwitch :: (SimpleElement) -> (Channel) -> IO ((Bool))
getPlaybackSwitch a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getPlaybackSwitch'_ a1' a2' a3' >>= \res ->
  checkPlaybackSwitch res >> 
  peekBool  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 332 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkPlaybackSwitch = checkResult_ "snd_mixer_selem_get_playback_switch"

getCaptureSwitch :: (SimpleElement) -> (Channel) -> IO ((Bool))
getCaptureSwitch a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getCaptureSwitch'_ a1' a2' a3' >>= \res ->
  checkCaptureSwitch res >> 
  peekBool  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 339 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkCaptureSwitch = checkResult_ "snd_mixer_selem_get_capture_switch"

getPlaybackVolumeRange :: (SimpleElement) -> IO ((Integer), (Integer))
getPlaybackVolumeRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getPlaybackVolumeRange'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackVolumeRange res >> 
  cToIntegral  a2'>>= \a2'' -> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a2'', a3'')
{-# LINE 346 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_get_playback_volume_range"

getCaptureVolumeRange :: (SimpleElement) -> IO ((Integer), (Integer))
getCaptureVolumeRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getCaptureVolumeRange'_ a1' a2' a3' >>= \res ->
  checkGetCaptureVolumeRange res >> 
  cToIntegral  a2'>>= \a2'' -> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a2'', a3'')
{-# LINE 353 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetCaptureVolumeRange = checkResult_ "snd_mixer_selem_get_capture_volume_range"

getPlaybackDbRange :: (SimpleElement) -> IO ((Integer), (Integer))
getPlaybackDbRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getPlaybackDbRange'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackDbRange res >> 
  cToIntegral  a2'>>= \a2'' -> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a2'', a3'')
{-# LINE 360 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetPlaybackDbRange = checkResult_ "snd_mixer_selem_get_playback_dB_range"

getCaptureDbRange :: (SimpleElement) -> IO ((Integer), (Integer))
getCaptureDbRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getCaptureDbRange'_ a1' a2' a3' >>= \res ->
  checkGetCaptureDbRange res >> 
  cToIntegral  a2'>>= \a2'' -> 
  cToIntegral  a3'>>= \a3'' -> 
  return (a2'', a3'')
{-# LINE 367 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkGetCaptureDbRange = checkResult_ "snd_mixer_selem_get_capture_dB_range"

-----------------------------------------------------------------------
-- set
-- --------------------------------------------------------------------

setPlaybackVolume :: (SimpleElement) -> (Channel) -> (Integer) -> IO ()
setPlaybackVolume a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromIntegral a3} in 
  setPlaybackVolume'_ a1' a2' a3' >>= \res ->
  checkSetPlaybackVolume res >> 
  return ()
{-# LINE 378 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackVolume = checkResult_ "snd_mixer_selem_set_playback_volume"

setCaptureVolume :: (SimpleElement) -> (Channel) -> (Integer) -> IO ()
setCaptureVolume a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromIntegral a3} in 
  setCaptureVolume'_ a1' a2' a3' >>= \res ->
  checkSetCaptureVolume res >> 
  return ()
{-# LINE 385 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureVolume = checkResult_ "snd_mixer_selem_set_capture_volume"

setPlaybackDb :: (SimpleElement) -> (Channel) -> (Integer) -> IO ()
setPlaybackDb a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromIntegral a3} in 
  negOne $ \a4' -> 
  setPlaybackDb'_ a1' a2' a3' a4' >>= \res ->
  checkSetPlaybackDb res >> 
  return ()
{-# LINE 393 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackDb = checkResult_ "snd_mixer_selem_set_playback_dB"

setCaptureDb :: (SimpleElement) -> (Channel) -> (Integer) -> IO ()
setCaptureDb a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromIntegral a3} in 
  negOne $ \a4' -> 
  setCaptureDb'_ a1' a2' a3' a4' >>= \res ->
  checkSetCaptureDb res >> 
  return ()
{-# LINE 401 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureDb = checkResult_ "snd_mixer_selem_set_capture_dB"

setPlaybackVolumeAll :: (SimpleElement) -> (Integer) -> IO ()
setPlaybackVolumeAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setPlaybackVolumeAll'_ a1' a2' >>= \res ->
  checkSetPlaybackVolumeAll res >> 
  return ()
{-# LINE 407 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackVolumeAll = checkResult_ "snd_mixer_selem_set_playback_volume_all"

setCaptureVolumeAll :: (SimpleElement) -> (Integer) -> IO ()
setCaptureVolumeAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setCaptureVolumeAll'_ a1' a2' >>= \res ->
  checkSetCaptureVolumeAll res >> 
  return ()
{-# LINE 413 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureVolumeAll = checkResult_ "snd_mixer_selem_set_capture_volume_all"

setPlaybackDbAll :: (SimpleElement) -> (Integer) -> IO ()
setPlaybackDbAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  negOne $ \a3' -> 
  setPlaybackDbAll'_ a1' a2' a3' >>= \res ->
  checkSetPlaybackDbAll res >> 
  return ()
{-# LINE 420 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackDbAll = checkResult_ "snd_mixer_selem_set_playback_dB_all"

setCaptureDbAll :: (SimpleElement) -> (Integer) -> IO ()
setCaptureDbAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  negOne $ \a3' -> 
  setCaptureDbAll'_ a1' a2' a3' >>= \res ->
  checkSetCaptureDbAll res >> 
  return ()
{-# LINE 427 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureDbAll = checkResult_ "snd_mixer_selem_set_capture_dB_all"

setPlaybackSwitch :: (SimpleElement) -> (Channel) -> (Bool) -> IO ()
setPlaybackSwitch a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromBool a3} in 
  setPlaybackSwitch'_ a1' a2' a3' >>= \res ->
  checkSetPlaybackSwitch res >> 
  return ()
{-# LINE 434 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackSwitch = checkResult_ "snd_mixer_selem_set_playback_switch"

setCaptureSwitch :: (SimpleElement) -> (Channel) -> (Bool) -> IO ()
setCaptureSwitch a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  let {a3' = fromBool a3} in 
  setCaptureSwitch'_ a1' a2' a3' >>= \res ->
  checkSetCaptureSwitch res >> 
  return ()
{-# LINE 441 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureSwitch = checkResult_ "snd_mixer_selem_set_capture_switch"

setPlaybackSwitchAll :: (SimpleElement) -> (Bool) -> IO ()
setPlaybackSwitchAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setPlaybackSwitchAll'_ a1' a2' >>= \res ->
  checkSetPlaybackSwitchAll res >> 
  return ()
{-# LINE 447 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackSwitchAll = checkResult_ "snd_mixer_selem_set_playback_switch_all"

setCaptureSwitchAll :: (SimpleElement) -> (Bool) -> IO ()
setCaptureSwitchAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  setCaptureSwitchAll'_ a1' a2' >>= \res ->
  checkSetCaptureSwitchAll res >> 
  return ()
{-# LINE 453 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureSwitchAll = checkResult_ "snd_mixer_selem_set_capture_switch_all"

setPlaybackVolumeRange' :: (SimpleElement) -> (Integer) -> (Integer) -> IO ()
setPlaybackVolumeRange' a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  setPlaybackVolumeRange''_ a1' a2' a3' >>= \res ->
  checkSetPlaybackVolumeRange res >> 
  return ()
{-# LINE 460 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_set_playback_volume_range"

setCaptureVolumeRange' :: (SimpleElement) -> (Integer) -> (Integer) -> IO ()
setCaptureVolumeRange' a1 a2 a3 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  setCaptureVolumeRange''_ a1' a2' a3' >>= \res ->
  checkSetCaptureVolumeRange res >> 
  return ()
{-# LINE 467 "./Sound/ALSA/Mixer/Internal.chs" #-}

checkSetCaptureVolumeRange = checkResult_ "snd_mixer_selem_set_capture_volume_range"

setPlaybackVolumeRange m = uncurry (setPlaybackVolumeRange' m)
setCaptureVolumeRange m = uncurry (setCaptureVolumeRange' m)

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_attach"
  attach'_ :: ((Mixer) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_load"
  sndMixerLoad'_ :: ((Mixer) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_register"
  sndMixerSelemRegister'_ :: ((Mixer) -> ((Ptr ()) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_malloc"
  sndMixerSelemIdMalloc'_ :: ((Ptr (Ptr (()))) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_id"
  sndMixerSelemGetId'_ :: ((Element) -> ((Ptr (())) -> (IO ())))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_first_elem"
  sndMixerFirstElem'_ :: ((Mixer) -> (IO (Element)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_last_elem"
  sndMixerLastElem'_ :: ((Mixer) -> (IO (Element)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_elem_next"
  sndMixerElemNext'_ :: ((Element) -> (IO (Element)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_find_selem"
  sndMixerFindSelem'_ :: ((Mixer) -> ((Ptr (())) -> (IO (Element))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_get_name"
  getName'_ :: ((Ptr (())) -> (IO (Ptr CChar)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_get_index"
  getIndex'_ :: ((Ptr (())) -> (IO CUInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_is_playback_mono"
  isPlaybackMono'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_is_capture_mono"
  isCaptureMono'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_common_volume"
  hasCommonVolume'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_volume"
  hasPlaybackVolume'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_volume_joined"
  hasPlaybackVolumeJoined'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_volume"
  hasCaptureVolume'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_volume_joined"
  hasCaptureVolumeJoined'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_common_switch"
  hasCommonSwitch'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_switch"
  hasPlaybackSwitch'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_switch_joined"
  hasPlaybackSwitchJoined'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_switch"
  hasCaptureSwitch'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_switch_joined"
  hasCaptureSwitchJoined'_ :: ((Element) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_channel"
  hasPlaybackChannel'_ :: ((Element) -> (CInt -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_channel"
  hasCaptureChannel'_ :: ((Element) -> (CInt -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_volume"
  getPlaybackVolume'_ :: ((Element) -> (CInt -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_volume"
  getCaptureVolume'_ :: ((Element) -> (CInt -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_dB"
  getPlaybackDb'_ :: ((Element) -> (CInt -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_dB"
  getCaptureDb'_ :: ((Element) -> (CInt -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_switch"
  getPlaybackSwitch'_ :: ((Element) -> (CInt -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_switch"
  getCaptureSwitch'_ :: ((Element) -> (CInt -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_volume_range"
  getPlaybackVolumeRange'_ :: ((Element) -> ((Ptr CLong) -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_volume_range"
  getCaptureVolumeRange'_ :: ((Element) -> ((Ptr CLong) -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_dB_range"
  getPlaybackDbRange'_ :: ((Element) -> ((Ptr CLong) -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_dB_range"
  getCaptureDbRange'_ :: ((Element) -> ((Ptr CLong) -> ((Ptr CLong) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume"
  setPlaybackVolume'_ :: ((Element) -> (CInt -> (CLong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume"
  setCaptureVolume'_ :: ((Element) -> (CInt -> (CLong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_dB"
  setPlaybackDb'_ :: ((Element) -> (CInt -> (CLong -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_dB"
  setCaptureDb'_ :: ((Element) -> (CInt -> (CLong -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume_all"
  setPlaybackVolumeAll'_ :: ((Element) -> (CLong -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume_all"
  setCaptureVolumeAll'_ :: ((Element) -> (CLong -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_dB_all"
  setPlaybackDbAll'_ :: ((Element) -> (CLong -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_dB_all"
  setCaptureDbAll'_ :: ((Element) -> (CLong -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_switch"
  setPlaybackSwitch'_ :: ((Element) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_switch"
  setCaptureSwitch'_ :: ((Element) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_switch_all"
  setPlaybackSwitchAll'_ :: ((Element) -> (CInt -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_switch_all"
  setCaptureSwitchAll'_ :: ((Element) -> (CInt -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume_range"
  setPlaybackVolumeRange''_ :: ((Element) -> (CLong -> (CLong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume_range"
  setCaptureVolumeRange''_ :: ((Element) -> (CLong -> (CLong -> (IO CInt))))