-----------------------------------------------------------------------------
-- |
-- Module      :  Sound.ALSA.Mixer
-- Copyright   :  (c) Thomas Tuegel 2011
-- License     :  BSD
--
-- Maintainer  :  Thomas Tuegel <ttuegel@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (Linux only)
--
-- This library provides bindings to the Advanced Linux Sound Architecture
-- (ALSA) library API. The portability of this library is limited to
-- systems with ALSA (i.e., Linux systems). The functions in this library
-- throw errors of type 'Sound.ALSA.Exception.T' on failure.
--
-----------------------------------------------------------------------------

module Sound.ALSA.Mixer
    ( -- * Types
      Control(..)
    , Mixer()
    , Channel(..)
    , PerChannel(..)
    , Volume(..)
    , Switch()
    , CUInt
    , CLong
      -- * Functions
      -- ** Mixers
    , controls
    , withMixer
      -- ** Controls
    , getControlByName
    , common
    , playback
    , capture
      -- ** PerChannels
    , channels
    , allChannels
    , joined
    , perChannel
    , getChannel
    , setChannel
      -- * Examples

      -- ** Getting and setting the volume of a Control
      -- $exampleVolume

      -- ** Getting and setting the switch of a Control
      -- $exampleSwitch
    ) where

import Control.Monad ( forM, liftM, when )
import Data.Maybe ( catMaybes )
import Foreign.C.Error ( Errno(..) )
import Foreign.C.Types
import Sound.ALSA.Exception ( catchErrno )
import Sound.ALSA.Mixer.Internal

-- | 'Control' represents one of the controls belonging to an ALSA mixer
-- element. Each control has a number of playback and capture channels.
-- The control may also have a switch and/or a volume capability associated
-- with it. The capability can be common to both playback and capture, or
-- there can be separate capabilities for each.
data Control = Control { Control -> CUInt
index :: CUInt
                       , Control -> String
name :: String
                       , Control -> Either Switch (Maybe Switch, Maybe Switch)
switch :: Either Switch (Maybe Switch, Maybe Switch)
                       , Control -> Either Volume (Maybe Volume, Maybe Volume)
volume :: Either Volume (Maybe Volume, Maybe Volume)
                       }

-- | 'PerChannel' represents a capability that with either a separate value for
-- each channel or with a common value for all channels.
data PerChannel e = Joined { forall e. PerChannel e -> IO e
getJoined :: IO e
                           , forall e. PerChannel e -> e -> IO ()
setJoined :: e -> IO ()
                           , forall e. PerChannel e -> [Channel]
joinedChannels :: [Channel]
                           }
                  | PerChannel { forall e. PerChannel e -> IO [(Channel, e)]
getPerChannel :: IO [(Channel, e)]
                               , forall e. PerChannel e -> [(Channel, e)] -> IO ()
setPerChannel :: [(Channel, e)] -> IO ()
                               , forall e. PerChannel e -> [Channel]
perChannels :: [Channel]
                               }

-- | True if the 'PerChannel' object has a common value for all channels.
joined :: PerChannel e -> Bool
joined :: forall e. PerChannel e -> Bool
joined j :: PerChannel e
j@(Joined IO e
_ e -> IO ()
_ [Channel]
_) = Bool
True
joined PerChannel e
_ = Bool
False

-- | True if the 'PerChannel' object has a separate value for each channel.
perChannel :: PerChannel e -> Bool
perChannel :: forall e. PerChannel e -> Bool
perChannel p :: PerChannel e
p@(PerChannel IO [(Channel, e)]
_ [(Channel, e)] -> IO ()
_ [Channel]
_) = Bool
True
perChannel PerChannel e
_ = Bool
False

-- | All channels supported by a 'PerChannel' object.
channels :: PerChannel e -> [Channel]
channels :: forall e. PerChannel e -> [Channel]
channels PerChannel e
p | PerChannel e -> Bool
forall e. PerChannel e -> Bool
joined PerChannel e
p = PerChannel e -> [Channel]
forall e. PerChannel e -> [Channel]
joinedChannels PerChannel e
p
           | Bool
otherwise = PerChannel e -> [Channel]
forall e. PerChannel e -> [Channel]
perChannels PerChannel e
p

-- | 'Switch' represents a switch capability for controls and channels that can
-- be muted and unmuted.
type Switch = PerChannel Bool

-- | 'Volume' represents a volume capability. There may be a separate value per
-- channel, but each capability has only one range.
data Volume = Volume { Volume -> IO (CLong, CLong)
getRange :: IO (CLong, CLong)
                       -- ^ Returns the minimum and maximum volumes (unitless).
                     , Volume -> (CLong, CLong) -> IO ()
setRange :: (CLong, CLong) -> IO ()
                       -- ^ Sets the minimum and maximum volumes (unitless).
                     , Volume -> IO (CLong, CLong)
getRangeDb :: IO (CLong, CLong)
                       -- ^ Returns the minimum and maximum volumes in
                       -- hundredths of a decibel.
                     , Volume -> PerChannel CLong
value :: PerChannel CLong
                       -- ^ Volume values for each channel.
                     , Volume -> PerChannel CLong
dB :: PerChannel CLong
                       -- ^ Volume values for each channel in hundredths of
                       -- a decibel.
                     }

-- | Get the value associated with a particular channel, if that channel exists.
getChannel :: Channel -> PerChannel x -> IO (Maybe x)
getChannel :: forall x. Channel -> PerChannel x -> IO (Maybe x)
getChannel Channel
c PerChannel x
p | PerChannel x -> Bool
forall e. PerChannel e -> Bool
joined PerChannel x
p = let r :: IO (Maybe x)
r | Channel
c Channel -> [Channel] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PerChannel x -> [Channel]
forall e. PerChannel e -> [Channel]
channels PerChannel x
p =
                                      (x -> Maybe x) -> IO x -> IO (Maybe x)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM x -> Maybe x
forall a. a -> Maybe a
Just (IO x -> IO (Maybe x)) -> IO x -> IO (Maybe x)
forall a b. (a -> b) -> a -> b
$ PerChannel x -> IO x
forall e. PerChannel e -> IO e
getJoined PerChannel x
p
                                  | Bool
otherwise = Maybe x -> IO (Maybe x)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe x
forall a. Maybe a
Nothing
                            in IO (Maybe x)
r
               | Bool
otherwise = ([(Channel, x)] -> Maybe x) -> IO [(Channel, x)] -> IO (Maybe x)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Channel -> [(Channel, x)] -> Maybe x
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Channel
c) (IO [(Channel, x)] -> IO (Maybe x))
-> IO [(Channel, x)] -> IO (Maybe x)
forall a b. (a -> b) -> a -> b
$ PerChannel x -> IO [(Channel, x)]
forall e. PerChannel e -> IO [(Channel, e)]
getPerChannel PerChannel x
p

-- | Set the value associated with a particular channel, if that channel exists.
setChannel :: Channel -> PerChannel x -> x -> IO ()
setChannel :: forall x. Channel -> PerChannel x -> x -> IO ()
setChannel Channel
c PerChannel x
p x
v | PerChannel x -> Bool
forall e. PerChannel e -> Bool
joined PerChannel x
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Channel
c Channel -> [Channel] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PerChannel x -> [Channel]
forall e. PerChannel e -> [Channel]
channels PerChannel x
p) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PerChannel x -> x -> IO ()
forall e. PerChannel e -> e -> IO ()
setJoined PerChannel x
p x
v
                 | Bool
otherwise = PerChannel x -> [(Channel, x)] -> IO ()
forall e. PerChannel e -> [(Channel, e)] -> IO ()
setPerChannel PerChannel x
p [(Channel
c, x
v)]

-- | For a given capability, which may be for either playback or capture, or
-- common to both, return the playback capability if it exists.
playback :: Either a (Maybe a, Maybe a) -> Maybe a
playback :: forall a. Either a (Maybe a, Maybe a) -> Maybe a
playback (Left a
_) = Maybe a
forall a. Maybe a
Nothing
playback (Right (Maybe a
x, Maybe a
_)) = Maybe a
x

-- | For a given capability, which may be for either playback or capture, or
-- common to both, return the capture capability if it exists.
capture :: Either a (Maybe a, Maybe a) -> Maybe a
capture :: forall a. Either a (Maybe a, Maybe a) -> Maybe a
capture (Left a
_) = Maybe a
forall a. Maybe a
Nothing
capture (Right (Maybe a
_, Maybe a
x)) = Maybe a
x

-- | For a given capability, which may be for either playback or capture, or
-- common to both, return the common capability if it exists.
common :: Either a (Maybe a, Maybe a) -> Maybe a
common :: forall a. Either a (Maybe a, Maybe a) -> Maybe a
common (Left a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
common (Right (Maybe a, Maybe a)
_) = Maybe a
forall a. Maybe a
Nothing

mkSwitch :: SimpleElement -> IO (Either Switch (Maybe Switch, Maybe Switch))
mkSwitch :: SimpleElement -> IO (Either Switch (Maybe Switch, Maybe Switch))
mkSwitch SimpleElement
se = do
    hasPlayChan <- (Channel -> IO Bool) -> [Channel] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SimpleElement -> Channel -> IO Bool
hasPlaybackChannel SimpleElement
se) [Channel]
allChannels
    hasCaptChan <- mapM (hasCaptureChannel se) allChannels
    let pChans = ((Channel, Bool) -> Channel) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Channel, Bool) -> Channel
forall a b. (a, b) -> a
fst ([(Channel, Bool)] -> [Channel]) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ((Channel, Bool) -> Bool) -> [(Channel, Bool)] -> [(Channel, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Channel, Bool)] -> [(Channel, Bool)])
-> [(Channel, Bool)] -> [(Channel, Bool)]
forall a b. (a -> b) -> a -> b
$ [Channel] -> [Bool] -> [(Channel, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
allChannels [Bool]
hasPlayChan
        cChans = ((Channel, Bool) -> Channel) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Channel, Bool) -> Channel
forall a b. (a, b) -> a
fst ([(Channel, Bool)] -> [Channel]) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ((Channel, Bool) -> Bool) -> [(Channel, Bool)] -> [(Channel, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Channel, Bool)] -> [(Channel, Bool)])
-> [(Channel, Bool)] -> [(Channel, Bool)]
forall a b. (a -> b) -> a -> b
$ [Channel] -> [Bool] -> [(Channel, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
allChannels [Bool]
hasCaptChan
    hasComSw <- hasCommonSwitch se
    hasPlaySw <- hasPlaybackSwitch se
    hasPlaySwJ <- hasPlaybackSwitchJoined se
    hasCaptSw <- hasCaptureSwitch se
    hasCaptSwJ <- hasCaptureSwitchJoined se
    return $ if hasComSw
                then Left $ if hasPlaySwJ
                              then comJoinedSwitch pChans
                              else comPerChannelSwitch pChans
                else let playSw | Bool -> Bool
not Bool
hasPlaySw = Maybe Switch
forall a. Maybe a
Nothing
                                | Bool
otherwise = Switch -> Maybe Switch
forall a. a -> Maybe a
Just
                                    (Switch -> Maybe Switch) -> Switch -> Maybe Switch
forall a b. (a -> b) -> a -> b
$ if Bool
hasPlaySwJ
                                        then [Channel] -> Switch
playJoinedSwitch [Channel]
pChans
                                        else [Channel] -> Switch
playPerChannelSwitch [Channel]
pChans
                         captSw | Bool -> Bool
not Bool
hasCaptSw = Maybe Switch
forall a. Maybe a
Nothing
                                | Bool
otherwise = Switch -> Maybe Switch
forall a. a -> Maybe a
Just
                                    (Switch -> Maybe Switch) -> Switch -> Maybe Switch
forall a b. (a -> b) -> a -> b
$ if Bool
hasCaptSwJ
                                        then [Channel] -> Switch
captJoinedSwitch [Channel]
cChans
                                        else [Channel] -> Switch
captPerChannelSwitch [Channel]
cChans
                     in Right (playSw, captSw)
  where joined :: (SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
joined SimpleElement -> Channel -> IO e
fGet SimpleElement -> Channel -> e -> IO ()
fSet [Channel]
chans =
            Joined { getJoined :: IO e
getJoined = SimpleElement -> Channel -> IO e
fGet SimpleElement
se ([Channel] -> Channel
forall a. HasCallStack => [a] -> a
head [Channel]
chans)
                   , setJoined :: e -> IO ()
setJoined = SimpleElement -> Channel -> e -> IO ()
fSet SimpleElement
se ([Channel] -> Channel
forall a. HasCallStack => [a] -> a
head [Channel]
chans)
                   , joinedChannels :: [Channel]
joinedChannels = [Channel]
chans
                   }
        perChannel :: (SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
perChannel SimpleElement -> Channel -> IO e
fGet SimpleElement -> Channel -> e -> IO b
fSet [Channel]
chans =
            PerChannel { getPerChannel :: IO [(Channel, e)]
getPerChannel = ([e] -> [(Channel, e)]) -> IO [e] -> IO [(Channel, e)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Channel] -> [e] -> [(Channel, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
chans)
                            (IO [e] -> IO [(Channel, e)]) -> IO [e] -> IO [(Channel, e)]
forall a b. (a -> b) -> a -> b
$ (Channel -> IO e) -> [Channel] -> IO [e]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SimpleElement -> Channel -> IO e
fGet SimpleElement
se) [Channel]
chans
                       , setPerChannel :: [(Channel, e)] -> IO ()
setPerChannel = ((Channel, e) -> IO b) -> [(Channel, e)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Channel -> e -> IO b) -> (Channel, e) -> IO b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SimpleElement -> Channel -> e -> IO b
fSet SimpleElement
se))
                       , perChannels :: [Channel]
perChannels = [Channel]
chans
                       }
        comJoinedSwitch :: [Channel] -> Switch
comJoinedSwitch = (SimpleElement -> Channel -> IO Bool)
-> (SimpleElement -> Channel -> Bool -> IO ())
-> [Channel]
-> Switch
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
joined SimpleElement -> Channel -> IO Bool
getPlaybackSwitch SimpleElement -> Channel -> Bool -> IO ()
setPlaybackSwitch
        comPerChannelSwitch :: [Channel] -> Switch
comPerChannelSwitch = (SimpleElement -> Channel -> IO Bool)
-> (SimpleElement -> Channel -> Bool -> IO ())
-> [Channel]
-> Switch
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
perChannel SimpleElement -> Channel -> IO Bool
getPlaybackSwitch SimpleElement -> Channel -> Bool -> IO ()
setPlaybackSwitch
        playJoinedSwitch :: [Channel] -> Switch
playJoinedSwitch = [Channel] -> Switch
comJoinedSwitch
        playPerChannelSwitch :: [Channel] -> Switch
playPerChannelSwitch = [Channel] -> Switch
comPerChannelSwitch
        captJoinedSwitch :: [Channel] -> Switch
captJoinedSwitch = (SimpleElement -> Channel -> IO Bool)
-> (SimpleElement -> Channel -> Bool -> IO ())
-> [Channel]
-> Switch
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
joined SimpleElement -> Channel -> IO Bool
getCaptureSwitch SimpleElement -> Channel -> Bool -> IO ()
setCaptureSwitch
        captPerChannelSwitch :: [Channel] -> Switch
captPerChannelSwitch = (SimpleElement -> Channel -> IO Bool)
-> (SimpleElement -> Channel -> Bool -> IO ())
-> [Channel]
-> Switch
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
perChannel SimpleElement -> Channel -> IO Bool
getCaptureSwitch SimpleElement -> Channel -> Bool -> IO ()
setCaptureSwitch

mkVolume :: SimpleElement -> IO (Either Volume (Maybe Volume, Maybe Volume))
mkVolume :: SimpleElement -> IO (Either Volume (Maybe Volume, Maybe Volume))
mkVolume SimpleElement
se = do
    hasPlayChan <- (Channel -> IO Bool) -> [Channel] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SimpleElement -> Channel -> IO Bool
hasPlaybackChannel SimpleElement
se) [Channel]
allChannels
    hasCaptChan <- mapM (hasCaptureChannel se) allChannels
    let pChans = ((Channel, Bool) -> Channel) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Channel, Bool) -> Channel
forall a b. (a, b) -> a
fst ([(Channel, Bool)] -> [Channel]) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ((Channel, Bool) -> Bool) -> [(Channel, Bool)] -> [(Channel, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Channel, Bool)] -> [(Channel, Bool)])
-> [(Channel, Bool)] -> [(Channel, Bool)]
forall a b. (a -> b) -> a -> b
$ [Channel] -> [Bool] -> [(Channel, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
allChannels [Bool]
hasPlayChan
        cChans = ((Channel, Bool) -> Channel) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Channel, Bool) -> Channel
forall a b. (a, b) -> a
fst ([(Channel, Bool)] -> [Channel]) -> [(Channel, Bool)] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ((Channel, Bool) -> Bool) -> [(Channel, Bool)] -> [(Channel, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Channel, Bool)] -> [(Channel, Bool)])
-> [(Channel, Bool)] -> [(Channel, Bool)]
forall a b. (a -> b) -> a -> b
$ [Channel] -> [Bool] -> [(Channel, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
allChannels [Bool]
hasCaptChan
    hasComV <- hasCommonVolume se
    hasPlayV <- hasPlaybackVolume se
    hasPlayVJ <- hasPlaybackVolumeJoined se
    hasCaptV <- hasCaptureVolume se
    hasCaptVJ <- hasCaptureVolumeJoined se
    return $
        if hasComV
           then let (v, d) | hasPlayVJ = ( comJoinedVol pChans
                                         , comJoinedDb pChans
                                         )
                           | otherwise = ( comPerChannelVol pChans
                                         , comPerChannelDb pChans
                                         )
                in Left $ playVolume { value = v, dB = d }
           else let playVol | Bool -> Bool
not Bool
hasPlayV = Maybe Volume
forall a. Maybe a
Nothing
                            | Bool
otherwise =
                                let (PerChannel CLong
v, PerChannel CLong
d) | Bool
hasPlayVJ =
                                               ( [Channel] -> PerChannel CLong
playJoinedVol [Channel]
pChans
                                               , [Channel] -> PerChannel CLong
playJoinedDb [Channel]
pChans
                                               )
                                           | Bool
otherwise =
                                               ( [Channel] -> PerChannel CLong
playPerChannelVol [Channel]
pChans
                                               , [Channel] -> PerChannel CLong
playPerChannelDb [Channel]
pChans
                                               )
                                in Volume -> Maybe Volume
forall a. a -> Maybe a
Just Volume
playVolume { value = v, dB = d }
                    captVol | Bool -> Bool
not Bool
hasCaptV = Maybe Volume
forall a. Maybe a
Nothing
                            | Bool
otherwise =
                                let (PerChannel CLong
v, PerChannel CLong
d) | Bool
hasCaptVJ =
                                               ( [Channel] -> PerChannel CLong
captJoinedVol [Channel]
cChans
                                               , [Channel] -> PerChannel CLong
captJoinedDb [Channel]
cChans
                                               )
                                           | Bool
otherwise =
                                               ( [Channel] -> PerChannel CLong
captPerChannelVol [Channel]
cChans
                                               , [Channel] -> PerChannel CLong
captPerChannelDb [Channel]
cChans
                                               )
                                in Volume -> Maybe Volume
forall a. a -> Maybe a
Just (Volume -> Maybe Volume) -> Volume -> Maybe Volume
forall a b. (a -> b) -> a -> b
$ Volume
captVolume { value = v, dB = d }
                in Right (playVol, captVol)
  where j :: (SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
j SimpleElement -> Channel -> IO e
fGet SimpleElement -> Channel -> e -> IO ()
fSet [Channel]
chans =
            Joined { getJoined :: IO e
getJoined = SimpleElement -> Channel -> IO e
fGet SimpleElement
se ([Channel] -> Channel
forall a. HasCallStack => [a] -> a
head [Channel]
chans)
                   , setJoined :: e -> IO ()
setJoined = SimpleElement -> Channel -> e -> IO ()
fSet SimpleElement
se ([Channel] -> Channel
forall a. HasCallStack => [a] -> a
head [Channel]
chans)
                   , joinedChannels :: [Channel]
joinedChannels = [Channel]
chans
                   }
        pc :: (SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
pc SimpleElement -> Channel -> IO e
fGet SimpleElement -> Channel -> e -> IO b
fSet [Channel]
chans =
            PerChannel { getPerChannel :: IO [(Channel, e)]
getPerChannel = ([e] -> [(Channel, e)]) -> IO [e] -> IO [(Channel, e)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Channel] -> [e] -> [(Channel, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Channel]
chans)
                            (IO [e] -> IO [(Channel, e)]) -> IO [e] -> IO [(Channel, e)]
forall a b. (a -> b) -> a -> b
$ (Channel -> IO e) -> [Channel] -> IO [e]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SimpleElement -> Channel -> IO e
fGet SimpleElement
se) [Channel]
chans
                       , setPerChannel :: [(Channel, e)] -> IO ()
setPerChannel = ((Channel, e) -> IO b) -> [(Channel, e)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Channel -> e -> IO b) -> (Channel, e) -> IO b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SimpleElement -> Channel -> e -> IO b
fSet SimpleElement
se))
                       , perChannels :: [Channel]
perChannels = [Channel]
chans
                       }
        playVolume :: Volume
playVolume = Volume { getRange :: IO (CLong, CLong)
getRange = SimpleElement -> IO (CLong, CLong)
getPlaybackVolumeRange SimpleElement
se
                            , setRange :: (CLong, CLong) -> IO ()
setRange = SimpleElement -> (CLong, CLong) -> IO ()
setPlaybackVolumeRange SimpleElement
se
                            , getRangeDb :: IO (CLong, CLong)
getRangeDb = SimpleElement -> IO (CLong, CLong)
getPlaybackDbRange SimpleElement
se
                            , value :: PerChannel CLong
value = PerChannel CLong
forall a. HasCallStack => a
undefined
                            , dB :: PerChannel CLong
dB = PerChannel CLong
forall a. HasCallStack => a
undefined
                            }
        captVolume :: Volume
captVolume = Volume { getRange :: IO (CLong, CLong)
getRange = SimpleElement -> IO (CLong, CLong)
getCaptureVolumeRange SimpleElement
se
                            , setRange :: (CLong, CLong) -> IO ()
setRange = SimpleElement -> (CLong, CLong) -> IO ()
setCaptureVolumeRange SimpleElement
se
                            , getRangeDb :: IO (CLong, CLong)
getRangeDb = SimpleElement -> IO (CLong, CLong)
getCaptureDbRange SimpleElement
se
                            , value :: PerChannel CLong
value = PerChannel CLong
forall a. HasCallStack => a
undefined
                            , dB :: PerChannel CLong
dB = PerChannel CLong
forall a. HasCallStack => a
undefined
                            }
        comJoinedVol :: [Channel] -> PerChannel CLong
comJoinedVol = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
j SimpleElement -> Channel -> IO CLong
getPlaybackVolume SimpleElement -> Channel -> CLong -> IO ()
setPlaybackVolume
        comJoinedDb :: [Channel] -> PerChannel CLong
comJoinedDb = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
j SimpleElement -> Channel -> IO CLong
getPlaybackDb SimpleElement -> Channel -> CLong -> IO ()
setPlaybackDb
        comPerChannelVol :: [Channel] -> PerChannel CLong
comPerChannelVol = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
pc SimpleElement -> Channel -> IO CLong
getPlaybackVolume SimpleElement -> Channel -> CLong -> IO ()
setPlaybackVolume
        comPerChannelDb :: [Channel] -> PerChannel CLong
comPerChannelDb = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
pc SimpleElement -> Channel -> IO CLong
getPlaybackDb SimpleElement -> Channel -> CLong -> IO ()
setPlaybackDb
        playJoinedVol :: [Channel] -> PerChannel CLong
playJoinedVol = [Channel] -> PerChannel CLong
comJoinedVol
        playPerChannelVol :: [Channel] -> PerChannel CLong
playPerChannelVol = [Channel] -> PerChannel CLong
comPerChannelVol
        playJoinedDb :: [Channel] -> PerChannel CLong
playJoinedDb = [Channel] -> PerChannel CLong
comJoinedDb
        playPerChannelDb :: [Channel] -> PerChannel CLong
playPerChannelDb = [Channel] -> PerChannel CLong
comPerChannelDb
        captJoinedVol :: [Channel] -> PerChannel CLong
captJoinedVol = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
j SimpleElement -> Channel -> IO CLong
getCaptureVolume SimpleElement -> Channel -> CLong -> IO ()
setCaptureVolume
        captPerChannelVol :: [Channel] -> PerChannel CLong
captPerChannelVol = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
pc SimpleElement -> Channel -> IO CLong
getCaptureVolume SimpleElement -> Channel -> CLong -> IO ()
setCaptureVolume
        captJoinedDb :: [Channel] -> PerChannel CLong
captJoinedDb = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO ())
-> [Channel]
-> PerChannel e
j SimpleElement -> Channel -> IO CLong
getCaptureDb SimpleElement -> Channel -> CLong -> IO ()
setCaptureDb
        captPerChannelDb :: [Channel] -> PerChannel CLong
captPerChannelDb = (SimpleElement -> Channel -> IO CLong)
-> (SimpleElement -> Channel -> CLong -> IO ())
-> [Channel]
-> PerChannel CLong
forall {e} {b}.
(SimpleElement -> Channel -> IO e)
-> (SimpleElement -> Channel -> e -> IO b)
-> [Channel]
-> PerChannel e
pc SimpleElement -> Channel -> IO CLong
getCaptureDb SimpleElement -> Channel -> CLong -> IO ()
setCaptureDb

-- | All the 'Control' objects associated with a particular 'Mixer'.
controls :: Mixer -> IO [Control]
controls :: Mixer -> IO [Control]
controls Mixer
mix = do
    es <- Mixer -> IO [(SimpleElementId, SimpleElement)]
elements Mixer
mix
    forM es $ \(SimpleElementId
idN, SimpleElement
se) -> do
        n <- SimpleElementId -> IO String
getName SimpleElementId
idN
        i <- getIndex idN
        sw <- mkSwitch se
        v <- mkVolume se
        return $! Control { name = n
                          , index = i
                          , switch = sw
                          , volume = v
                          }

-- | Get the named 'Control', if it exists, from the named 'Mixer'.
getControlByName :: Mixer   -- ^ Mixer
                 -> String  -- ^ Control name
                 -> IO (Maybe Control)
getControlByName :: Mixer -> String -> IO (Maybe Control)
getControlByName Mixer
mix String
controlName = do
    cs <- Mixer -> IO [Control]
controls Mixer
mix
    return $ lookup controlName $ zip (map name cs) cs

{- $exampleVolume
This example demonstrates the method of accessing the volume of a Control.
The example function reads the volume and increases it by the value supplied.

>   changeVolumeBy :: CLong -> IO ()
>   changeVolumeBy i =
>       withMixer "default" $ \mixer ->
>         do Just control <- getControlByName mixer "Master"
>            let Just playbackVolume = playback $ volume control
>            (min, max) <- getRange playbackVolume
>            Just vol <- getChannel FrontLeft $ value $ playbackVolume
>            when ((i > 0 && vol < max) || (i < 0 && vol > min))
>              $ setChannel FrontLeft (value $ playbackVolume) $ vol + i

-}

{- $exampleSwitch
This example demonstrates the method of accessing the switch of a Control.
The example function reads the value of the switch and toggles it.

>   toggleMute :: IO ()
>   toggleMute =
>       withMixer "default" $ \mixer ->
>         do Just control <- getControlByName mixer "Master"
>            let Just playbackSwitch = playback $ switch control
>            Just sw <- getChannel FrontLeft playbackSwitch
>            setChannel FrontLeft playbackSwitch $ not sw

-}