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
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