{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

-- | This uses ALSA to control the volume.
module XMonad.Util.ALSA ( toggleMute
                        , raiseVolume
                        , lowerVolume
                        -- * Default keybindings
                        , volumeKeys
                        ) where

import           Control.Composition
import           Control.Monad
import           Control.Monad.IO.Class
import qualified Data.Map                     as M
import           Graphics.X11.ExtraTypes.XF86
import           Graphics.X11.Types
import           Sound.ALSA.Mixer

-- | Mute/unmute within the `X` Monad.
toggleMute :: MonadIO m => m ()
toggleMute = liftIO $
    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

-- TODO: upstream replacement of 'Integer'?
changeVolume :: MonadIO m
             => Channel
             -> Int -- ^ Percentage
             -> m ()
changeVolume channel i = liftIO $
    withMixer "default" $ \mixer -> do
        Just control <- getControlByName mixer "Master"
        let Just playbackVolume = playback $ volume control
        (min', max') <- both fromIntegral <$> getRange playbackVolume
        Just vol <- fmap fromIntegral <$> getChannel channel (value playbackVolume)
        let i' = i * ((max' - min') `div` 100)
        when ((i' > 0 && vol < max') || (i' < 0 && vol > min')) $
            setChannel channel (value playbackVolume) $ fromIntegral (vol + i')

-- | Raise volume
raiseVolume :: MonadIO m => Int -> m ()
raiseVolume = axe [ changeVolume FrontLeft, changeVolume FrontRight ]

-- | Lower volume
lowerVolume :: MonadIO m => Int -> m ()
lowerVolume = raiseVolume . negate

-- | Given your keymaps, add volume control keybindings.
volumeKeys :: MonadIO m => M.Map (KeyMask, KeySym) (m ()) -> M.Map (KeyMask, KeySym) (m ())
volumeKeys = M.union mediaKeyMap
    where mediaKeyMap = M.fromList volumeKeyList

volumeKeyList :: MonadIO m => [((KeyMask, KeySym), m ())]
volumeKeyList = [ ((0, xF86XK_AudioMute), toggleMute)
                , ((0, xF86XK_AudioLowerVolume), lowerVolume 5)
                , ((0, xF86XK_AudioRaiseVolume), raiseVolume 5)
                ]