summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/MPD.hs
blob: c8c2dc98c13ce623687557d01fb65c01d85947dd (plain)
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