-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (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 qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



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 (C2HSImp.Ptr (Mixer))
{-# LINE 64 "./Sound/ALSA/Mixer/Internal.chs" #-}

type Element = C2HSImp.Ptr (())
{-# LINE 65 "./Sound/ALSA/Mixer/Internal.chs" #-}

type SimpleElementId = C2HSImp.ForeignPtr (())
{-# LINE 66 "./Sound/ALSA/Mixer/Internal.chs" #-}

type SimpleElement = (Mixer, Element)

data Channel = Unknown
             | FrontLeft
             | SND_MIXER_SCHN_MONO
             | FrontRight
             | RearLeft
             | RearRight
             | FrontCenter
             | Woofer
             | SideLeft
             | SideRight
             | RearCenter
             | Last
  deriving (Eq,Read,Show)
instance Enum Channel where
  succ Unknown = FrontLeft
  succ FrontLeft = FrontRight
  succ SND_MIXER_SCHN_MONO = FrontRight
  succ FrontRight = RearLeft
  succ RearLeft = RearRight
  succ RearRight = FrontCenter
  succ FrontCenter = Woofer
  succ Woofer = SideLeft
  succ SideLeft = SideRight
  succ SideRight = RearCenter
  succ RearCenter = Last
  succ Last = error "Channel.succ: Last has no successor"

  pred FrontLeft = Unknown
  pred SND_MIXER_SCHN_MONO = Unknown
  pred FrontRight = FrontLeft
  pred RearLeft = FrontRight
  pred RearRight = RearLeft
  pred FrontCenter = RearRight
  pred Woofer = FrontCenter
  pred SideLeft = Woofer
  pred SideRight = SideLeft
  pred RearCenter = SideRight
  pred Last = RearCenter
  pred Unknown = error "Channel.pred: Unknown 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 Last

  fromEnum Unknown = (-1)
  fromEnum FrontLeft = 0
  fromEnum SND_MIXER_SCHN_MONO = 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

  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 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 
  C2HSImp.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' >>
  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' >>
  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 -- Returns null if list of mixer-elems is empty.
    es <- elements' pFirst []
    mapM (simpleElement fMix) es
  where elements' pThis xs | pThis == nullPtr = return xs
                           | otherwise = do
                               pNext <- sndMixerElemNext pThis
                               elements' pNext (pThis : xs)

-----------------------------------------------------------------------
-- 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 184 "./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 ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

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


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

getIndex :: (SimpleElementId) -> IO ((CUInt))
getIndex a1 =
  withForeignPtr a1 $ \a1' -> 
  getIndex'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 206 "./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

negOne f = f $! negate 1

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

isPlaybackMono :: (SimpleElement) -> IO ((Bool))
isPlaybackMono a1 =
  withSimpleElement a1 $ \a1' -> 
  isPlaybackMono'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


isCaptureMono :: (SimpleElement) -> IO ((Bool))
isCaptureMono a1 =
  withSimpleElement a1 $ \a1' -> 
  isCaptureMono'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCommonVolume :: (SimpleElement) -> IO ((Bool))
hasCommonVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCommonVolume'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasPlaybackVolume :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackVolume'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasPlaybackVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolumeJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackVolumeJoined'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCaptureVolume :: (SimpleElement) -> IO ((Bool))
hasCaptureVolume a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureVolume'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCaptureVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureVolumeJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureVolumeJoined'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCommonSwitch :: (SimpleElement) -> IO ((Bool))
hasCommonSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCommonSwitch'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasPlaybackSwitch :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackSwitch'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasPlaybackSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitchJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasPlaybackSwitchJoined'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCaptureSwitch :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitch a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureSwitch'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


hasCaptureSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitchJoined a1 =
  withSimpleElement a1 $ \a1' -> 
  hasCaptureSwitchJoined'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 279 "./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' = C2HSImp.toBool res} in
  return (res')

{-# LINE 283 "./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' = C2HSImp.toBool res} in
  return (res')

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


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

getPlaybackVolume :: (SimpleElement) -> (Channel) -> IO ((CLong))
getPlaybackVolume a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getPlaybackVolume'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackVolume res >> 
  peek  a3'>>= \a3'' -> 
  return (a3'')

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


checkGetPlaybackVolume = checkResult_ "snd_mixer_selem_get_playback_volume"

getCaptureVolume :: (SimpleElement) -> (Channel) -> IO ((CLong))
getCaptureVolume a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getCaptureVolume'_ a1' a2' a3' >>= \res ->
  checkGetCaptureVolume res >> 
  peek  a3'>>= \a3'' -> 
  return (a3'')

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


checkGetCaptureVolume = checkResult_ "snd_mixer_selem_get_capture_volume"

getPlaybackDb :: (SimpleElement) -> (Channel) -> IO ((CLong))
getPlaybackDb a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getPlaybackDb'_ a1' a2' a3' >>= \res ->
  checkPlaybackDb res >> 
  peek  a3'>>= \a3'' -> 
  return (a3'')

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


checkPlaybackDb = checkResult_ "snd_mixer_selem_get_playback_dB"

getCaptureDb :: (SimpleElement) -> (Channel) -> IO ((CLong))
getCaptureDb a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = channelToC a2} in 
  alloca $ \a3' -> 
  getCaptureDb'_ a1' a2' a3' >>= \res ->
  checkCaptureDb res >> 
  peek  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 317 "./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 326 "./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 333 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkCaptureSwitch = checkResult_ "snd_mixer_selem_get_capture_switch"

getPlaybackVolumeRange :: (SimpleElement) -> IO ((CLong), (CLong))
getPlaybackVolumeRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getPlaybackVolumeRange'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackVolumeRange res >> 
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (a2'', a3'')

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


checkGetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_get_playback_volume_range"

getCaptureVolumeRange :: (SimpleElement) -> IO ((CLong), (CLong))
getCaptureVolumeRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getCaptureVolumeRange'_ a1' a2' a3' >>= \res ->
  checkGetCaptureVolumeRange res >> 
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (a2'', a3'')

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


checkGetCaptureVolumeRange = checkResult_ "snd_mixer_selem_get_capture_volume_range"

getPlaybackDbRange :: (SimpleElement) -> IO ((CLong), (CLong))
getPlaybackDbRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getPlaybackDbRange'_ a1' a2' a3' >>= \res ->
  checkGetPlaybackDbRange res >> 
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (a2'', a3'')

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


checkGetPlaybackDbRange = checkResult_ "snd_mixer_selem_get_playback_dB_range"

getCaptureDbRange :: (SimpleElement) -> IO ((CLong), (CLong))
getCaptureDbRange a1 =
  withSimpleElement a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  getCaptureDbRange'_ a1' a2' a3' >>= \res ->
  checkGetCaptureDbRange res >> 
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (a2'', a3'')

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


checkGetCaptureDbRange = checkResult_ "snd_mixer_selem_get_capture_dB_range"

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

setPlaybackVolume :: (SimpleElement) -> (Channel) -> (CLong) -> 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 372 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkSetPlaybackVolume = checkResult_ "snd_mixer_selem_set_playback_volume"

setCaptureVolume :: (SimpleElement) -> (Channel) -> (CLong) -> 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 379 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkSetCaptureVolume = checkResult_ "snd_mixer_selem_set_capture_volume"

setPlaybackDb :: (SimpleElement) -> (Channel) -> (CLong) -> 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 387 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkSetPlaybackDb = checkResult_ "snd_mixer_selem_set_playback_dB"

setCaptureDb :: (SimpleElement) -> (Channel) -> (CLong) -> 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 395 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkSetCaptureDb = checkResult_ "snd_mixer_selem_set_capture_dB"

setPlaybackVolumeAll :: (SimpleElement) -> (CLong) -> IO ()
setPlaybackVolumeAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setPlaybackVolumeAll'_ a1' a2' >>= \res ->
  checkSetPlaybackVolumeAll res >> 
  return ()

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


checkSetPlaybackVolumeAll = checkResult_ "snd_mixer_selem_set_playback_volume_all"

setCaptureVolumeAll :: (SimpleElement) -> (CLong) -> IO ()
setCaptureVolumeAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  setCaptureVolumeAll'_ a1' a2' >>= \res ->
  checkSetCaptureVolumeAll res >> 
  return ()

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


checkSetCaptureVolumeAll = checkResult_ "snd_mixer_selem_set_capture_volume_all"

setPlaybackDbAll :: (SimpleElement) -> (CLong) -> IO ()
setPlaybackDbAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  negOne $ \a3' -> 
  setPlaybackDbAll'_ a1' a2' a3' >>= \res ->
  checkSetPlaybackDbAll res >> 
  return ()

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


checkSetPlaybackDbAll = checkResult_ "snd_mixer_selem_set_playback_dB_all"

setCaptureDbAll :: (SimpleElement) -> (CLong) -> IO ()
setCaptureDbAll a1 a2 =
  withSimpleElement a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  negOne $ \a3' -> 
  setCaptureDbAll'_ a1' a2' a3' >>= \res ->
  checkSetCaptureDbAll res >> 
  return ()

{-# LINE 421 "./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' = C2HSImp.fromBool a3} in 
  setPlaybackSwitch'_ a1' a2' a3' >>= \res ->
  checkSetPlaybackSwitch res >> 
  return ()

{-# LINE 428 "./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' = C2HSImp.fromBool a3} in 
  setCaptureSwitch'_ a1' a2' a3' >>= \res ->
  checkSetCaptureSwitch res >> 
  return ()

{-# LINE 435 "./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' = C2HSImp.fromBool a2} in 
  setPlaybackSwitchAll'_ a1' a2' >>= \res ->
  checkSetPlaybackSwitchAll res >> 
  return ()

{-# LINE 441 "./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' = C2HSImp.fromBool a2} in 
  setCaptureSwitchAll'_ a1' a2' >>= \res ->
  checkSetCaptureSwitchAll res >> 
  return ()

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


checkSetCaptureSwitchAll = checkResult_ "snd_mixer_selem_set_capture_switch_all"

setPlaybackVolumeRange' :: (SimpleElement) -> (CLong) -> (CLong) -> 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 454 "./Sound/ALSA/Mixer/Internal.chs" #-}


checkSetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_set_playback_volume_range"

setCaptureVolumeRange' :: (SimpleElement) -> (CLong) -> (CLong) -> 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 461 "./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) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

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

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

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

foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_id"
  sndMixerSelemGetId'_ :: ((Element) -> ((C2HSImp.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) -> ((C2HSImp.Ptr (())) -> (IO (Element))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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