From 316f2be0a518a21deabf26a742f0e494dddea17b Mon Sep 17 00:00:00 2001 From: Jose A Ortega Ruiz Date: Wed, 31 Mar 2010 01:46:36 +0200 Subject: More options for the MBox plugin. Ignore-this: d3996ea695c38897088bc2c0851ce992 darcs-hash:20100330234636-748be-61ec1cb7775fd30a6cc4db6d30ffe4c03ed04456.gz --- Plugins/MBox.hs | 43 +++++++++++++++++++++++++++++++++++++++---- Plugins/Monitors/MPD.hs | 10 +++++----- 2 files changed, 44 insertions(+), 9 deletions(-) (limited to 'Plugins') diff --git a/Plugins/MBox.hs b/Plugins/MBox.hs index 3f7b70c..ce153e1 100644 --- a/Plugins/MBox.hs +++ b/Plugins/MBox.hs @@ -23,19 +23,52 @@ import Control.Exception (SomeException, handle, evaluate) import System.Directory import System.FilePath +import System.Console.GetOpt import System.INotify + import qualified Data.ByteString.Lazy.Char8 as B +data Options = Options + { oAll :: Bool + , oDir :: FilePath + , oPrefix :: String + , oSuffix :: String + } + +defaults :: Options +defaults = Options { oAll = False, oDir = "", oPrefix = "", oSuffix = "" } + +options :: [OptDescr (Options -> Options)] +options = + [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) "" + , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") "" + , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") "" + , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") "" + ] + +parseOptions :: [String] -> IO Options +parseOptions args = + case getOpt Permute options args of + (o, _, []) -> return $ foldr id defaults o + (_, _, errs) -> ioError . userError $ concat errs + -- | A list of display names, paths to mbox files and display colours, --- followed by a directory to resolve relative path names (can be "") -data MBox = MBox [(String, FilePath, String)] FilePath +-- followed by a list of options. +data MBox = MBox [(String, FilePath, String)] [String] String deriving (Read, Show) instance Exec MBox where - start (MBox ms dir) cb = do + alias (MBox _ _ a) = a + start (MBox ms args _) cb = do vs <- mapM (const $ newTVarIO ("", 0 :: Int)) ms + opts <- parseOptions args -- $ words args + let dir = oDir opts + allb = oAll opts + pref = oPrefix opts + suff = oSuffix opts + dirExists <- doesDirectoryExist dir let ts = map (\(t, _, _) -> t) ms sec = \(_, f, _) -> f @@ -53,7 +86,9 @@ instance Exec MBox where atomically $ writeTVar v (f, n) changeLoop (mapM (fmap snd . readTVar) vs) $ \ns -> - cb . unwords $ [ showC m n c | (m, n, c) <- zip3 ts ns cs, n /= 0 ] + let s = unwords [ showC m n c | (m, n, c) <- zip3 ts ns cs + , allb || n /= 0 ] + in cb (if length s == 0 then "" else pref ++ s ++ suff) showC :: String -> Int -> String -> String showC m n c = diff --git a/Plugins/Monitors/MPD.hs b/Plugins/Monitors/MPD.hs index 410662d..72b73d6 100644 --- a/Plugins/Monitors/MPD.hs +++ b/Plugins/Monitors/MPD.hs @@ -33,9 +33,9 @@ defaultOpts = MOpts { mPlaying = ">>", mStopped = "><", mPaused = "||" } 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" ["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 }) "") "" ] runMPD :: [String] -> Monitor String @@ -53,7 +53,7 @@ mopts argv = (o, _, []) -> return $ foldr id defaultOpts o (_, _, errs) -> ioError . userError $ concat errs -parseMPD :: (M.Response M.Status) -> (M.Response (Maybe M.Song)) -> MOpts +parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts -> (Float, [String]) parseMPD (Left e) _ _ = (0, show e:repeat "") parseMPD (Right st) song opts = (b, [ss, si, vol, len, lap, plen] ++ sf) @@ -74,7 +74,7 @@ stateGlyph s o = M.Paused -> mPaused o M.Stopped -> mStopped o -parseSong :: (M.Response (Maybe M.Song)) -> [String] +parseSong :: M.Response (Maybe M.Song) -> [String] parseSong (Left _) = repeat "" parseSong (Right Nothing) = repeat "" parseSong (Right (Just s)) = -- cgit v1.2.3