{-# LANGUAGE TupleSections #-}

-- | Bind media keys using dbus
-- Requires amixer to control volume.
module XMonad.Util.MediaKeys (-- * default keybindings
                               mediaKeys
                             -- * media control in the 'X' monad
                             , audioPrev
                             , audioNext
                             , audioPlayPause
                             ) where

import           Control.Arrow                (first)
import qualified Data.Map                     as M
import           Graphics.X11.ExtraTypes.XF86
import           Graphics.X11.Types
import           XMonad.Core
import           XMonad.Util.Volume

-- | Given your keymaps, add the media keybindings. Currently they are set up
-- for Spotify.
mediaKeys :: M.Map (KeyMask, KeySym) (X ()) -> M.Map (KeyMask, KeySym) (X ())
mediaKeys = M.union mediaKeyMap
    where mediaKeyMap = M.fromList mediaKeyList

mediaKeyList :: [((KeyMask, KeySym), X ())]
mediaKeyList = go <$> [ (xF86XK_AudioNext, audioNext)
                      , (xF86XK_AudioPrev, audioPrev)
                      , (xF86XK_AudioPlay, audioPlayPause)
                      , (xF86XK_AudioMute, toggleMute)
                      , (xF86XK_AudioLowerVolume, lowerVolume five)
                      , (xF86XK_AudioRaiseVolume, raiseVolume five)
                      ]

    where go = first (0 ,)
          five :: Word
          five = 5

-- | Helper function for use with dbus
sp :: String -> X ()
sp = spawn . (++) "dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player."

-- | Action in the 'X' monad to go to next
audioNext :: X ()
audioNext = sp "Next"

-- | Action in the 'X' monad to go the previous
audioPrev :: X ()
audioPrev = sp "Previous"

-- | Action in the 'X' monad to play/pause
audioPlayPause :: X ()
audioPlayPause = sp "PlayPause"