-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.MPD
-- Copyright   :  (c) Jose A Ortega Ruiz
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
--  MPD status and song
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where

import Data.List
import Data.Maybe (fromMaybe)
import Xmobar.Plugins.Monitors.Common
import System.Console.GetOpt
import qualified Network.MPD as M
import Control.Concurrent (threadDelay)
import Control.Monad.Except (catchError)

templateVars :: [String]
templateVars :: [String]
templateVars = [ String
"bar", String
"vbar", String
"ipat", String
"state", String
"statei", String
"volume", String
"length"
               , String
"lapsed", String
"remaining", String
"plength", String
"ppos", String
"flags", String
"file"
               , String
"name", String
"artist", String
"composer", String
"performer"
               , String
"album", String
"title", String
"track", String
"genre", String
"date"
               ]

mpdConfig :: IO MConfig
mpdConfig :: IO MConfig
mpdConfig = String -> [String] -> IO MConfig
mkMConfig String
"MPD: <state>" [String]
templateVars

data MOpts = MOpts
  { MOpts -> String
mPlaying :: String
  , MOpts -> String
mStopped :: String
  , MOpts -> String
mPaused :: String
  , MOpts -> Maybe IconPattern
mLapsedIconPattern :: Maybe IconPattern
  , MOpts -> Maybe String
mPort :: Maybe String
  , MOpts -> Maybe String
mHost :: Maybe String
  }

defaultOpts :: MOpts
defaultOpts :: MOpts
defaultOpts = MOpts
  { mPlaying :: String
mPlaying = String
">>"
  , mStopped :: String
mStopped = String
"><"
  , mPaused :: String
mPaused = String
"||"
  , mLapsedIconPattern :: Maybe IconPattern
mLapsedIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  , mPort :: Maybe String
mPort = Maybe String
forall a. Maybe a
Nothing
  , mHost :: Maybe String
mHost = Maybe String
forall a. Maybe a
Nothing
  }

options :: [OptDescr (MOpts -> MOpts)]
options :: [OptDescr (MOpts -> MOpts)]
options =
  [ String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"P" [String
"playing"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o -> MOpts
o { mPlaying = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"S" [String
"stopped"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o -> MOpts
o { mStopped = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"Z" [String
"paused"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o -> MOpts
o { mPaused = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"port"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o -> MOpts
o { mPort = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"h" [String
"host"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o -> MOpts
o { mHost = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (MOpts -> MOpts)
-> String
-> OptDescr (MOpts -> MOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"lapsed-icon-pattern"] ((String -> MOpts -> MOpts) -> String -> ArgDescr (MOpts -> MOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOpts
o ->
     MOpts
o { mLapsedIconPattern = Just $ parseIconPattern x }) String
"") String
""
  ]

withMPD :: MOpts -> M.MPD a -> IO (M.Response a)
withMPD :: forall a. MOpts -> MPD a -> IO (Response a)
withMPD MOpts
opts MPD a
a =
  Maybe String -> Maybe String -> MPD a -> IO (Response a)
forall a. Maybe String -> Maybe String -> MPD a -> IO (Response a)
M.withMPD_ (MOpts -> Maybe String
mHost MOpts
opts) (MOpts -> Maybe String
mPort MOpts
opts) MPD a
a IO (Response a)
-> (IOException -> IO (Response a)) -> IO (Response a)
forall a. IO a -> (IOException -> IO a) -> IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\IOException
_ -> Response a -> IO (Response a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MPDError -> Response a
forall a b. a -> Either a b
Left MPDError
M.NoMPD))

runMPD :: [String] -> Monitor String
runMPD :: [String] -> Monitor String
runMPD [String]
args = do
  opts <- IO MOpts -> Monitor MOpts
forall a. IO a -> Monitor a
io (IO MOpts -> Monitor MOpts) -> IO MOpts -> Monitor MOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (MOpts -> MOpts)] -> MOpts -> [String] -> IO MOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (MOpts -> MOpts)]
options MOpts
defaultOpts [String]
args
  status <- io $ withMPD opts M.status
  song <- io $ withMPD opts M.currentSong
  s <- parseMPD status song opts
  parseTemplate s

mpdWait :: IO ()
mpdWait :: IO ()
mpdWait = do
  status <- MPD [Subsystem] -> IO (Response [Subsystem])
forall a. MPD a -> IO (Response a)
M.withMPD (MPD [Subsystem] -> IO (Response [Subsystem]))
-> MPD [Subsystem] -> IO (Response [Subsystem])
forall a b. (a -> b) -> a -> b
$ [Subsystem] -> MPD [Subsystem]
forall (m :: * -> *). MonadMPD m => [Subsystem] -> m [Subsystem]
M.idle [Subsystem
M.PlayerS, Subsystem
M.MixerS, Subsystem
M.OptionsS]
  case status of
    Left MPDError
_ -> Int -> IO ()
threadDelay Int
5000
    Response [Subsystem]
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mpdReady :: [String] -> Monitor Bool
mpdReady :: [String] -> Monitor Bool
mpdReady [String]
args = do
  opts <- IO MOpts -> Monitor MOpts
forall a. IO a -> Monitor a
io (IO MOpts -> Monitor MOpts) -> IO MOpts -> Monitor MOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (MOpts -> MOpts)] -> MOpts -> [String] -> IO MOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (MOpts -> MOpts)]
options MOpts
defaultOpts [String]
args
  response <- io $ withMPD opts M.ping
  case response of
    Right ()
_         -> Bool -> Monitor Bool
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    -- Only cases where MPD isn't responding is an issue; bogus information at
    -- least won't hold xmobar up.
    Left MPDError
M.NoMPD    -> Bool -> Monitor Bool
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Left (M.ConnectionError IOException
_) -> Bool -> Monitor Bool
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Left MPDError
_          -> Bool -> Monitor Bool
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts
            -> Monitor [String]
parseMPD :: Response Status
-> Response (Maybe Song) -> MOpts -> Monitor [String]
parseMPD (Left MPDError
_) Response (Maybe Song)
_ MOpts
_ =
  Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString Monitor String -> (String -> Monitor [String]) -> Monitor [String]
forall a b.
ReaderT MConfig IO a
-> (a -> ReaderT MConfig IO b) -> ReaderT MConfig IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
na -> [String] -> Monitor [String]
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Monitor [String]) -> [String] -> Monitor [String]
forall a b. (a -> b) -> a -> b
$ String
na String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
""
parseMPD (Right Status
st) Response (Maybe Song)
song MOpts
opts = do
  songData <- Response (Maybe Song) -> Monitor [String]
parseSong Response (Maybe Song)
song
  bar <- showPercentBar (100 * b) b
  vbar <- showVerticalBar (100 * b) b
  ipat <- showIconPattern (mLapsedIconPattern opts) b
  return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags]
           ++ songData
  where s :: PlaybackState
s = Status -> PlaybackState
M.stState Status
st
        ss :: String
ss = PlaybackState -> String
forall a. Show a => a -> String
show PlaybackState
s
        si :: String
si = PlaybackState -> MOpts -> String
stateGlyph PlaybackState
s MOpts
opts
        vol :: String
vol = Volume -> String
forall a. (Show a, Num a, Ord a) => a -> String
int2str (Volume -> String) -> Volume -> String
forall a b. (a -> b) -> a -> b
$ Volume -> Maybe Volume -> Volume
forall a. a -> Maybe a -> a
fromMaybe Volume
0 (Status -> Maybe Volume
M.stVolume Status
st)
        (FractionalSeconds
p, FractionalSeconds
t) = (FractionalSeconds, FractionalSeconds)
-> Maybe (FractionalSeconds, FractionalSeconds)
-> (FractionalSeconds, FractionalSeconds)
forall a. a -> Maybe a -> a
fromMaybe (FractionalSeconds
0, FractionalSeconds
0) (Status -> Maybe (FractionalSeconds, FractionalSeconds)
M.stTime Status
st)
        [String
lap, String
len, String
remain] = (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
showTime
                                 [FractionalSeconds -> Integer
forall b. Integral b => FractionalSeconds -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor FractionalSeconds
p, FractionalSeconds -> Integer
forall b. Integral b => FractionalSeconds -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor FractionalSeconds
t, Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (FractionalSeconds -> Integer
forall b. Integral b => FractionalSeconds -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor FractionalSeconds
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- FractionalSeconds -> Integer
forall b. Integral b => FractionalSeconds -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor FractionalSeconds
p)]
        b :: Float
b = if FractionalSeconds
t FractionalSeconds -> FractionalSeconds -> Bool
forall a. Ord a => a -> a -> Bool
> FractionalSeconds
0 then FractionalSeconds -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (FractionalSeconds -> Float) -> FractionalSeconds -> Float
forall a b. (a -> b) -> a -> b
$ FractionalSeconds
p FractionalSeconds -> FractionalSeconds -> FractionalSeconds
forall a. Fractional a => a -> a -> a
/ FractionalSeconds
t else Float
0
        plen :: String
plen = Integer -> String
forall a. (Show a, Num a, Ord a) => a -> String
int2str (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Status -> Integer
M.stPlaylistLength Status
st
        ppos :: String
ppos = String -> IconPattern -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (IconPattern
forall a. (Show a, Num a, Ord a) => a -> String
int2str IconPattern -> (Int -> Int) -> IconPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$ Status -> Maybe Int
M.stSongPos Status
st
        flags :: String
flags = Status -> String
playbackMode Status
st

stateGlyph :: M.PlaybackState -> MOpts -> String
stateGlyph :: PlaybackState -> MOpts -> String
stateGlyph PlaybackState
s MOpts
o =
  case PlaybackState
s of
    PlaybackState
M.Playing -> MOpts -> String
mPlaying MOpts
o
    PlaybackState
M.Paused -> MOpts -> String
mPaused MOpts
o
    PlaybackState
M.Stopped -> MOpts -> String
mStopped MOpts
o

playbackMode :: M.Status -> String
playbackMode :: Status -> String
playbackMode Status
s =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Status -> Bool
p Status
s then String
f else String
"-" |
          (Status -> Bool
p,String
f) <- [(Status -> Bool
M.stRepeat,String
"r"),
                    (Status -> Bool
M.stRandom,String
"z"),
                    (Status -> Bool
M.stSingle,String
"s"),
                    (Status -> Bool
M.stConsume,String
"c")]]

parseSong :: M.Response (Maybe M.Song) -> Monitor [String]
parseSong :: Response (Maybe Song) -> Monitor [String]
parseSong (Left MPDError
_) = [String] -> Monitor [String]
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Monitor [String]) -> [String] -> Monitor [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat String
""
parseSong (Right Maybe Song
Nothing) = [String] -> Monitor [String]
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Monitor [String]) -> [String] -> Monitor [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat String
""
parseSong (Right (Just Song
s)) =
  let str :: Metadata -> String
str Metadata
sel = String -> ([Value] -> String) -> Maybe [Value] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> ([Value] -> [String]) -> [Value] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> String) -> [Value] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Value -> String
forall a. ToString a => a -> String
M.toString) (Metadata -> Song -> Maybe [Value]
M.sgGetTag Metadata
sel Song
s)
      sels :: [Metadata]
sels = [ Metadata
M.Name, Metadata
M.Artist, Metadata
M.Composer, Metadata
M.Performer
             , Metadata
M.Album, Metadata
M.Title, Metadata
M.Track, Metadata
M.Genre, Metadata
M.Date ]
      fields :: [String]
fields = Path -> String
forall a. ToString a => a -> String
M.toString (Song -> Path
M.sgFilePath Song
s) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Metadata -> String) -> [Metadata] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Metadata -> String
str [Metadata]
sels
  in (String -> Monitor String) -> [String] -> Monitor [String]
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 String -> Monitor String
showWithPadding [String]
fields

showTime :: Integer -> String
showTime :: Integer -> String
showTime Integer
t = Integer -> String
forall a. (Show a, Num a, Ord a) => a -> String
int2str Integer
minutes String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. (Show a, Num a, Ord a) => a -> String
int2str Integer
seconds
  where minutes :: Integer
minutes = Integer
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
60
        seconds :: Integer
seconds = Integer
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
60

int2str :: (Show a, Num a, Ord a) => a -> String
int2str :: forall a. (Show a, Num a, Ord a) => a -> String
int2str a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sx else String
sx where sx :: String
sx = a -> String
forall a. Show a => a -> String
show a
x