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
|
-----------------------------------------------------------------------------
-- |
-- 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 Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where
import Data.List
import Plugins.Monitors.Common
import System.Console.GetOpt
import qualified Network.MPD as M
import Control.Concurrent (threadDelay)
mpdConfig :: IO MConfig
mpdConfig = mkMConfig "MPD: <state>"
[ "bar", "vbar", "ipat", "state", "statei", "volume", "length"
, "lapsed", "remaining", "plength", "ppos", "file"
, "name", "artist", "composer", "performer"
, "album", "title", "track", "genre"
]
data MOpts = MOpts
{ mPlaying :: String
, mStopped :: String
, mPaused :: String
, mLapsedIconPattern :: Maybe IconPattern
}
defaultOpts :: MOpts
defaultOpts = MOpts
{ mPlaying = ">>"
, mStopped = "><"
, mPaused = "||"
, mLapsedIconPattern = 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 "" ["lapsed-icon-pattern"] (ReqArg (\x o ->
o { mLapsedIconPattern = Just $ parseIconPattern x }) "") ""
]
runMPD :: [String] -> Monitor String
runMPD args = do
opts <- io $ mopts args
status <- io $ M.withMPD M.status
song <- io $ M.withMPD M.currentSong
s <- parseMPD status song opts
parseTemplate s
mpdWait :: IO ()
mpdWait = do
status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS]
case status of
Left _ -> threadDelay 10000000
_ -> return ()
mpdReady :: [String] -> Monitor Bool
mpdReady _ = do
response <- io $ M.withMPD 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
mopts :: [String] -> IO MOpts
mopts argv =
case getOpt Permute options argv of
(o, _, []) -> return $ foldr id defaultOpts o
(_, _, errs) -> ioError . userError $ concat errs
parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts
-> Monitor [String]
parseMPD (Left e) _ _ = return $ show e:replicate 19 ""
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] ++ songData
where s = M.stState st
ss = show s
si = stateGlyph s opts
vol = int2str $ case M.stVolume st of
Just x -> x
Nothing -> 0
(p, t) = case M.stTime st of
Just x -> x
Nothing -> (0, 0)
[lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)]
b = if t > 0 then realToFrac $ p / fromIntegral t else 0
plen = int2str $ M.stPlaylistLength st
ppos = maybe "" (int2str . (+1)) $ M.stSongPos st
stateGlyph :: M.State -> MOpts -> String
stateGlyph s o =
case s of
M.Playing -> mPlaying o
M.Paused -> mPaused o
M.Stopped -> mStopped o
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 ]
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
|
