1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
-----------------------------------------------------------------------------
-- |
-- 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 = [ "bar", "vbar", "ipat", "state", "statei", "volume", "length"
, "lapsed", "remaining", "plength", "ppos", "flags", "file"
, "name", "artist", "composer", "performer"
, "album", "title", "track", "genre", "date"
]
mpdConfig :: IO MConfig
mpdConfig = mkMConfig "MPD: <state>" templateVars
data MOpts = MOpts
{ mPlaying :: String
, mStopped :: String
, mPaused :: String
, mLapsedIconPattern :: Maybe IconPattern
, mPort :: Maybe String
, mHost :: Maybe String
}
defaultOpts :: MOpts
defaultOpts = MOpts
{ mPlaying = ">>"
, mStopped = "><"
, mPaused = "||"
, mLapsedIconPattern = Nothing
, mPort = Nothing
, mHost = Nothing
}
options :: [OptDescr (MOpts -> MOpts)]
options =
[ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""
, Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""
, Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""
, Option "p" ["port"] (ReqArg (\x o -> o { mPort = Just x }) "") ""
, Option "h" ["host"] (ReqArg (\x o -> o { mHost = Just x }) "") ""
, Option "" ["lapsed-icon-pattern"] (ReqArg (\x o ->
o { mLapsedIconPattern = Just $ parseIconPattern x }) "") ""
]
withMPD :: MOpts -> M.MPD a -> IO (M.Response a)
withMPD opts a =
M.withMPD_ (mHost opts) (mPort opts) a `catchError` (\_ -> return (Left M.NoMPD))
runMPD :: [String] -> Monitor String
runMPD args = do
opts <- io $ parseOptsWith options defaultOpts args
status <- io $ withMPD opts M.status
song <- io $ withMPD opts M.currentSong
s <- parseMPD status song opts
parseTemplate s
mpdWait :: IO ()
mpdWait = do
status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS, M.OptionsS]
case status of
Left _ -> threadDelay 5000
_ -> return ()
mpdReady :: [String] -> Monitor Bool
mpdReady args = do
opts <- io $ parseOptsWith options defaultOpts args
response <- io $ withMPD opts M.ping
case response of
Right _ -> return True
-- Only cases where MPD isn't responding is an issue; bogus information at
-- least won't hold xmobar up.
Left M.NoMPD -> return False
Left (M.ConnectionError _) -> return False
Left _ -> return True
parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts
-> Monitor [String]
parseMPD (Left _) _ _ = return $ "N/A": repeat ""
parseMPD (Right st) song opts = do
songData <- parseSong 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 = M.stState st
ss = show s
si = stateGlyph s opts
vol = int2str $ fromMaybe 0 (M.stVolume st)
(p, t) = fromMaybe (0, 0) (M.stTime st)
[lap, len, remain] = map showTime
[floor p, floor t, max 0 (floor t - floor p)]
b = if t > 0 then realToFrac $ p / t else 0
plen = int2str $ M.stPlaylistLength st
ppos = maybe "" (int2str . (+1)) $ M.stSongPos st
flags = playbackMode st
stateGlyph :: M.PlaybackState -> MOpts -> String
stateGlyph s o =
case s of
M.Playing -> mPlaying o
M.Paused -> mPaused o
M.Stopped -> mStopped o
playbackMode :: M.Status -> String
playbackMode s =
concat [if p s then f else "-" |
(p,f) <- [(M.stRepeat,"r"),
(M.stRandom,"z"),
(M.stSingle,"s"),
(M.stConsume,"c")]]
parseSong :: M.Response (Maybe M.Song) -> Monitor [String]
parseSong (Left _) = return $ repeat ""
parseSong (Right Nothing) = return $ repeat ""
parseSong (Right (Just s)) =
let str sel = maybe "" (intercalate ", " . map M.toString) (M.sgGetTag sel s)
sels = [ M.Name, M.Artist, M.Composer, M.Performer
, M.Album, M.Title, M.Track, M.Genre, M.Date ]
fields = M.toString (M.sgFilePath s) : map str sels
in mapM showWithPadding fields
showTime :: Integer -> String
showTime t = int2str minutes ++ ":" ++ int2str seconds
where minutes = t `div` 60
seconds = t `mod` 60
int2str :: (Show a, Num a, Ord a) => a -> String
int2str x = if x < 10 then '0':sx else sx where sx = show x
|
