diff options
Diffstat (limited to 'src/Plugins')
30 files changed, 636 insertions, 207 deletions
diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index a2ea2a3..9a7266e 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -14,7 +14,7 @@ module Plugins.BufferedPipeReader where -import Control.Monad(forM_, when) +import Control.Monad(forM_, when, void) import Control.Concurrent import Control.Concurrent.STM import System.IO @@ -66,7 +66,7 @@ instance Exec BufferedPipeReader where where sfork :: IO () -> IO () - sfork f = forkIO f >> return () + sfork f = void (forkIO f) update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do diff --git a/src/Plugins/Date.hs b/src/Plugins/Date.hs index 3caad30..a263536 100644 --- a/src/Plugins/Date.hs +++ b/src/Plugins/Date.hs @@ -21,6 +21,7 @@ module Plugins.Date (Date(..)) where import Plugins import System.Locale +import Control.Monad (liftM) import Data.Time data Date = Date String String Int @@ -32,4 +33,4 @@ instance Exec Date where rate (Date _ _ r) = r date :: String -> IO String -date format = getZonedTime >>= return . formatTime defaultTimeLocale format +date format = liftM (formatTime defaultTimeLocale format) getZonedTime diff --git a/src/Plugins/EWMH.hs b/src/Plugins/EWMH.hs index d5b70cb..5f1c0c4 100644 --- a/src/Plugins/EWMH.hs +++ b/src/Plugins/EWMH.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -w #-} -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | @@ -58,7 +58,7 @@ instance Exec EWMH where liftIO $ nextEvent' d ep e <- liftIO $ getEvent ep case e of - PropertyEvent { ev_atom = a, ev_window = w } -> do + PropertyEvent { ev_atom = a, ev_window = w } -> case lookup a handlers' of Just f -> f w _ -> return () @@ -95,7 +95,7 @@ fmt e (Workspaces opts) = sep " " attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)] nonEmptys = Set.unions . map desktops . Map.elems $ clients e -modifier :: Modifier -> (String -> String) +modifier :: Modifier -> String -> String modifier Hide = const "" modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg , ">", x, "</fc>"] @@ -227,9 +227,9 @@ updateClientList _ = do dels = Map.difference cl cl' new = Map.difference cl' cl modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'}) - mapM_ unmanage (map fst $ Map.toList dels) - mapM_ listen (map fst $ Map.toList cl') - mapM_ update (map fst $ Map.toList new) + mapM_ (unmanage . fst) (Map.toList dels) + mapM_ (listen . fst) (Map.toList cl') + mapM_ (update . fst) (Map.toList new) _ -> return () where unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0 diff --git a/src/Plugins/Kbd.hsc b/src/Plugins/Kbd.hsc index 241dde4..318effc 100644 --- a/src/Plugins/Kbd.hsc +++ b/src/Plugins/Kbd.hsc @@ -276,6 +276,9 @@ xkbUseCoreKbd = #const XkbUseCoreKbd xkbStateNotify :: CUInt xkbStateNotify = #const XkbStateNotify +xkbIndicatorStateNotify :: CUInt +xkbIndicatorStateNotify = #const XkbIndicatorStateNotify + xkbMapNotify :: CUInt xkbMapNotify = #const XkbMapNotify diff --git a/src/Plugins/Locks.hs b/src/Plugins/Locks.hs index 3c1e0a9..79b1583 100644 --- a/src/Plugins/Locks.hs +++ b/src/Plugins/Locks.hs @@ -20,6 +20,8 @@ import Data.Bits import Control.Monad import Graphics.X11.Xlib.Extras import Plugins +import Plugins.Kbd +import XUtil (nextEvent') data Locks = Locks deriving (Read, Show) @@ -30,22 +32,33 @@ locks = [ ( xK_Caps_Lock, "CAPS" ) , ( xK_Scroll_Lock, "SCROLL" ) ] +run' :: Display -> Window -> IO String +run' d root = do + modMap <- getModifierMapping d + ( _, _, _, _, _, _, _, m ) <- queryPointer d root + + ls <- filterM ( \( ks, _ ) -> do + kc <- keysymToKeycode d ks + return $ case find (elem kc . snd) modMap of + Nothing -> False + Just ( i, _ ) -> testBit m (fromIntegral i) + ) locks + + return $ unwords $ map snd ls + instance Exec Locks where alias Locks = "locks" - rate Locks = 2 - run Locks = do + start Locks cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d) + _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m - modMap <- getModifierMapping d - ( _, _, _, _, _, _, _, m ) <- queryPointer d root + allocaXEvent $ \ep -> forever $ do + cb =<< run' d root + nextEvent' d ep + getEvent ep - ls <- filterM ( \( ks, _ ) -> do - kc <- keysymToKeycode d ks - return $ case find (elem kc . snd) modMap of - Nothing -> False - Just ( i, _ ) -> testBit m (fromIntegral i) - ) locks closeDisplay d - - return $ unwords $ map snd ls + return () + where + m = xkbAllStateComponentsMask diff --git a/src/Plugins/MBox.hs b/src/Plugins/MBox.hs index d9a9765..62f9d78 100644 --- a/src/Plugins/MBox.hs +++ b/src/Plugins/MBox.hs @@ -71,7 +71,7 @@ data MBox = MBox [(String, FilePath, String)] [String] String instance Exec MBox where alias (MBox _ _ a) = a #ifndef INOTIFY - start _ _ = do + start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++ " but the MBox plugin requires it" #else diff --git a/src/Plugins/Mail.hs b/src/Plugins/Mail.hs index d4abb0b..772d1d7 100644 --- a/src/Plugins/Mail.hs +++ b/src/Plugins/Mail.hs @@ -41,7 +41,7 @@ data Mail = Mail [(String, FilePath)] String instance Exec Mail where alias (Mail _ a) = a #ifndef INOTIFY - start _ _ = do + start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify," ++ " but the Mail plugin requires it." #else @@ -62,9 +62,9 @@ instance Exec Mail where atomically $ modifyTVar v (S.union s) changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns -> - cb . unwords $ [m ++ ":" ++ show n - | (m, n) <- zip ts ns - , n /= 0 ] + cb . unwords $ [m ++ show n + | (m, n) <- zip ts ns + , n /= 0 ] handle :: TVar (Set String) -> Event -> IO () handle v e = atomically $ modifyTVar v $ case e of diff --git a/src/Plugins/MarqueePipeReader.hs b/src/Plugins/MarqueePipeReader.hs new file mode 100644 index 0000000..8120c84 --- /dev/null +++ b/src/Plugins/MarqueePipeReader.hs @@ -0,0 +1,68 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.MarqueePipeReader +-- Copyright : (c) Reto Habluetzel +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading from named pipes for long texts with marquee +-- +----------------------------------------------------------------------------- + +module Plugins.MarqueePipeReader where + +import System.IO (openFile, IOMode(ReadWriteMode), Handle) +import Plugins (tenthSeconds, Exec(alias, start), hGetLineSafe) +import System.Posix.Files (getFileStatus, isNamedPipe) +import Control.Concurrent(forkIO, threadDelay) +import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan) +import Control.Exception +import Control.Monad(forever, unless) + +type Length = Int -- length of the text to display +type Rate = Int -- delay in tenth seconds +type Separator = String -- if text wraps around, use separator + +data MarqueePipeReader = MarqueePipeReader String (Length, Rate, Separator) String + deriving (Read, Show) + +instance Exec MarqueePipeReader where + alias (MarqueePipeReader _ _ a) = a + start (MarqueePipeReader p (len, rate, sep) _) cb = do + let (def, pipe) = split ':' p + unless (null def) (cb def) + checkPipe pipe + h <- openFile pipe ReadWriteMode + line <- hGetLineSafe h + chan <- atomically newTChan + forkIO $ writer (toInfTxt line sep) sep len rate chan cb + forever $ pipeToChan h chan + where + split c xs | c `elem` xs = let (pre, post) = span (c /=) xs + in (pre, dropWhile (c ==) post) + | otherwise = ([], xs) + +pipeToChan :: Handle -> TChan String -> IO () +pipeToChan h chan = do + line <- hGetLineSafe h + atomically $ writeTChan chan line + +writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO () +writer txt sep len rate chan cb = do + cb (take len txt) + mbnext <- atomically $ tryReadTChan chan + case mbnext of + Just new -> writer (toInfTxt new sep) sep len rate chan cb + Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb + +toInfTxt :: String -> String -> String +toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ") + +checkPipe :: FilePath -> IO () +checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do + status <- getFileStatus file + unless (isNamedPipe status) waitForPipe + where waitForPipe = threadDelay 1000 >> checkPipe file diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs index 860da71..bee3c06 100644 --- a/src/Plugins/Monitors.hs +++ b/src/Plugins/Monitors.hs @@ -108,17 +108,17 @@ instance Exec Monitors where alias (Cpu _ _) = "cpu" alias (MultiCpu _ _) = "multicpu" alias (Battery _ _) = "battery" - alias (BatteryP _ _ _)= "battery" + alias (BatteryP {})= "battery" alias (BatteryN _ _ _ a)= a alias (Brightness _ _) = "bright" alias (CpuFreq _ _) = "cpufreq" alias (TopProc _ _) = "top" alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp" - alias (DiskU _ _ _) = "disku" - alias (DiskIO _ _ _) = "diskio" + alias (DiskU {}) = "disku" + alias (DiskIO {}) = "diskio" alias (Uptime _ _) = "uptime" - alias (CatInt n _ _ _) = "cat" ++ (show n) + alias (CatInt n _ _ _) = "cat" ++ show n #ifdef IWLIB alias (Wireless i _ _) = i ++ "wi" #endif @@ -156,7 +156,7 @@ instance Exec Monitors where start (Uptime a r) = runM a uptimeConfig runUptime r start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r #ifdef IWLIB - start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r + start (Wireless i a r) = runM a wirelessConfig (runWireless i) r #endif #ifdef LIBMPD start (MPD a r) = runMD a mpdConfig runMPD r mpdReady diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs index 3eb2051..f7b31e4 100644 --- a/src/Plugins/Monitors/Batt.hs +++ b/src/Plugins/Monitors/Batt.hs @@ -34,6 +34,9 @@ data BattOpts = BattOpts , highThreshold :: Float , onlineFile :: FilePath , scale :: Float + , onIconPattern :: Maybe IconPattern + , offIconPattern :: Maybe IconPattern + , idleIconPattern :: Maybe IconPattern } defaultOpts :: BattOpts @@ -49,6 +52,9 @@ defaultOpts = BattOpts , highThreshold = -10 , onlineFile = "AC/online" , scale = 1e6 + , onIconPattern = Nothing + , offIconPattern = Nothing + , idleIconPattern = Nothing } options :: [OptDescr (BattOpts -> BattOpts)] @@ -64,6 +70,12 @@ options = , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") "" , Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") "" + , Option "" ["on-icon-pattern"] (ReqArg (\x o -> + o { onIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["off-icon-pattern"] (ReqArg (\x o -> + o { offIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["idle-icon-pattern"] (ReqArg (\x o -> + o { idleIconPattern = Just $ parseIconPattern x }) "") "" ] parseOpts :: [String] -> IO BattOpts @@ -72,7 +84,9 @@ parseOpts argv = (o, _, []) -> return $ foldr id defaultOpts o (_, _, errs) -> ioError . userError $ concat errs -data Result = Result Float Float Float String | NA +data Status = Charging | Discharging | Idle + +data Result = Result Float Float Float Status | NA sysDir :: FilePath sysDir = "/sys/class/power_supply" @@ -80,7 +94,7 @@ sysDir = "/sys/class/power_supply" battConfig :: IO MConfig battConfig = mkMConfig "Batt: <watts>, <left>% / <timeleft>" -- template - ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts"] -- replacements + ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements data Files = Files { fFull :: String @@ -105,7 +119,7 @@ batteryFiles bat = do is_charge <- exists "charge_now" is_energy <- if is_charge then return False else exists "energy_now" is_power <- exists "power_now" - plain <- if is_charge then exists "charge_full" else exists "energy_full" + plain <- exists (if is_charge then "charge_full" else "energy_full") let cf = if is_power then "power_now" else "current_now" sf = if plain then "" else "_design" return $ case (is_charge, is_energy) of @@ -150,9 +164,10 @@ readBatteries opts bfs = time = if idle then 0 else sum $ map time' bats mwatts = if idle then 1 else sign * watts time' b = (if ac then full b - now b else now b) / mwatts - acstr = if idle then idleString opts else - if ac then onString opts else offString opts - return $ if isNaN left then NA else Result left watts time acstr + acst | idle = Idle + | ac = Charging + | otherwise = Discharging + return $ if isNaN left then NA else Result left watts time acst runBatt :: [String] -> Monitor String runBatt = runBatt' ["BAT0","BAT1","BAT2"] @@ -167,7 +182,8 @@ runBatt' bfs args = do Result x w t s -> do l <- fmtPercent x ws <- fmtWatts w opts suffix d - parseTemplate (l ++ [s, fmtTime $ floor t, ws]) + si <- getIconPattern opts s x + parseTemplate (l ++ [fmtStatus opts s, fmtTime $ floor t, ws, si]) NA -> getConfigValue naString where fmtPercent :: Float -> Monitor [String] fmtPercent x = do @@ -184,9 +200,18 @@ runBatt' bfs args = do then minutes else '0' : minutes where hours = show (x `div` 3600) minutes = show ((x `mod` 3600) `div` 60) + fmtStatus opts Idle = idleString opts + fmtStatus opts Charging = onString opts + fmtStatus opts Discharging = offString opts maybeColor Nothing str = str maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" color x o | x >= 0 = maybeColor (posColor o) | -x >= highThreshold o = maybeColor (highWColor o) | -x >= lowThreshold o = maybeColor (mediumWColor o) | otherwise = maybeColor (lowWColor o) + getIconPattern opts status x = do + let x' = minimum [1, x] + case status of + Idle -> showIconPattern (idleIconPattern opts) x' + Charging -> showIconPattern (onIconPattern opts) x' + Discharging -> showIconPattern (offIconPattern opts) x' diff --git a/src/Plugins/Monitors/Bright.hs b/src/Plugins/Monitors/Bright.hs index 1c4cc01..cb510f6 100644 --- a/src/Plugins/Monitors/Bright.hs +++ b/src/Plugins/Monitors/Bright.hs @@ -14,6 +14,7 @@ module Plugins.Monitors.Bright (brightConfig, runBright) where +import Control.Applicative ((<$>)) import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import System.FilePath ((</>)) @@ -25,18 +26,22 @@ import Plugins.Monitors.Common data BrightOpts = BrightOpts { subDir :: String , currBright :: String , maxBright :: String + , curBrightIconPattern :: Maybe IconPattern } defaultOpts :: BrightOpts defaultOpts = BrightOpts { subDir = "acpi_video0" , currBright = "actual_brightness" , maxBright = "max_brightness" + , curBrightIconPattern = Nothing } options :: [OptDescr (BrightOpts -> BrightOpts)] options = [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") "" , Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") "" , Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") "" + , Option "" ["brightness-icon-pattern"] (ReqArg (\x o -> + o { curBrightIconPattern = Just $ parseIconPattern x }) "") "" ] -- from Batt.hs @@ -51,7 +56,7 @@ sysDir = "/sys/class/backlight/" brightConfig :: IO MConfig brightConfig = mkMConfig "<percent>" -- template - ["vbar", "percent", "bar"] -- replacements + ["vbar", "percent", "bar", "ipat"] -- replacements data Files = Files { fCurr :: String , fMax :: String @@ -60,12 +65,12 @@ data Files = Files { fCurr :: String brightFiles :: BrightOpts -> IO Files brightFiles opts = do - is_curr <- fileExist $ (fCurr files) - is_max <- fileExist $ (fCurr files) - if is_curr && is_max then return files else return NoFiles - where prefix = sysDir </> (subDir opts) - files = Files { fCurr = prefix </> (currBright opts) - , fMax = prefix </> (maxBright opts) + is_curr <- fileExist $ fCurr files + is_max <- fileExist $ fCurr files + return (if is_curr && is_max then files else NoFiles) + where prefix = sysDir </> subDir opts + files = Files { fCurr = prefix </> currBright opts + , fMax = prefix </> maxBright opts } runBright :: [String] -> Monitor String @@ -75,19 +80,20 @@ runBright args = do c <- io $ readBright f case f of NoFiles -> return "hurz" - _ -> fmtPercent c >>= parseTemplate - where fmtPercent :: Float -> Monitor [String] - fmtPercent c = do r <- showVerticalBar (100 * c) c - s <- showPercentWithColors c - t <- showPercentBar (100 * c) c - return [r,s,t] + _ -> fmtPercent opts c >>= parseTemplate + where fmtPercent :: BrightOpts -> Float -> Monitor [String] + fmtPercent opts c = do r <- showVerticalBar (100 * c) c + s <- showPercentWithColors c + t <- showPercentBar (100 * c) c + d <- showIconPattern (curBrightIconPattern opts) c + return [r,s,t,d] readBright :: Files -> IO Float readBright NoFiles = return 0 readBright files = do - currVal<- grab $ (fCurr files) - maxVal <- grab $ (fMax files) - return $ (currVal / maxVal) - where grab f = handle handler (fmap (read . B.unpack) $ B.readFile f) + currVal<- grab $ fCurr files + maxVal <- grab $ fMax files + return (currVal / maxVal) + where grab f = handle handler (read . B.unpack <$> B.readFile f) handler = const (return 0) :: SomeException -> IO Float diff --git a/src/Plugins/Monitors/CatInt.hs b/src/Plugins/Monitors/CatInt.hs index 3d19270..aacbd71 100644 --- a/src/Plugins/Monitors/CatInt.hs +++ b/src/Plugins/Monitors/CatInt.hs @@ -20,6 +20,6 @@ catIntConfig = mkMConfig "<v>" ["v"] runCatInt :: FilePath -> [String] -> Monitor String runCatInt p _ = - let failureMessage = "Cannot read: " ++ (show p) + let failureMessage = "Cannot read: " ++ show p fmt x = show (truncate x :: Int) in checkedDataRetrieval failureMessage [[p]] Nothing id fmt diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs index 70f1b5f..7d11258 100644 --- a/src/Plugins/Monitors/Common.hs +++ b/src/Plugins/Monitors/Common.hs @@ -40,6 +40,8 @@ module Plugins.Monitors.Common ( , parseTemplate' -- ** String Manipulation -- $strings + , IconPattern + , parseIconPattern , padString , showWithPadding , showWithColors @@ -48,8 +50,10 @@ module Plugins.Monitors.Common ( , showPercentsWithColors , showPercentBar , showVerticalBar + , showIconPattern , showLogBar , showLogVBar + , showLogIconPattern , showWithUnits , takeDigits , showDigits @@ -60,6 +64,7 @@ module Plugins.Monitors.Common ( ) where +import Control.Applicative ((<$>)) import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef @@ -112,7 +117,7 @@ mods s m = setConfigValue :: a -> Selector a -> Monitor () setConfigValue v s = - mods s (\_ -> v) + mods s (const v) getConfigValue :: Selector a -> Monitor a getConfigValue = sel @@ -342,11 +347,23 @@ combine m ((s,ts,ss):xs) = do next <- combine m xs str <- case Map.lookup ts m of Nothing -> return $ "<" ++ ts ++ ">" - Just r -> let f "" = r; f n = n; in fmap f $ parseTemplate' r m + Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m return $ s ++ str ++ ss ++ next -- $strings +type IconPattern = Int -> String + +parseIconPattern :: String -> IconPattern +parseIconPattern path = + let spl = splitOnPercent path + in \i -> concat $ intersperse (show i) spl + where splitOnPercent [] = [[]] + splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs + splitOnPercent (x:xs) = + let rest = splitOnPercent xs + in (x : head rest) : tail rest + type Pos = (Int, Int) takeDigits :: Int -> Float -> Float @@ -452,6 +469,15 @@ showPercentBar v x = do s <- colorizeString v (take len $ cycle bf) return $ s ++ take (bw - len) (cycle bb) +showIconPattern :: Maybe IconPattern -> Float -> Monitor String +showIconPattern Nothing _ = return "" +showIconPattern (Just str) x = return $ str $ convert $ 100 * x + where convert val + | t <= 0 = 0 + | t > 8 = 8 + | otherwise = t + where t = round val `div` 12 + showVerticalBar :: Float -> Float -> Monitor String showVerticalBar v x = colorizeString v [convert $ 100 * x] where convert :: Float -> Char @@ -459,10 +485,23 @@ showVerticalBar v x = colorizeString v [convert $ 100 * x] | t <= 9600 = ' ' | t > 9608 = chr 9608 | otherwise = chr t - where t = 9600 + ((round val) `div` 12) + where t = 9600 + (round val `div` 12) showLogBar :: Float -> Float -> Monitor String -showLogBar f v = do +showLogBar f v = + let intConfig c = fromIntegral `fmap` getConfigValue c + in do + h <- intConfig high + l <- intConfig low + bw <- intConfig barWidth + let [ll, hh] = sort [l, h] + choose x | x == 0.0 = 0 + | x <= ll = 1 / bw + | otherwise = f + logBase 2 (x / hh) / bw + showPercentBar v $ choose v + +showLogVBar :: Float -> Float -> Monitor String +showLogVBar f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth @@ -470,10 +509,10 @@ showLogBar f v = do choose x | x == 0.0 = 0 | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw - showPercentBar v $ choose v + showVerticalBar v $ choose v -showLogVBar :: Float -> Float -> Monitor String -showLogVBar f v = do +showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String +showLogIconPattern str f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth @@ -481,4 +520,4 @@ showLogVBar f v = do choose x | x == 0.0 = 0 | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw - showVerticalBar v $ choose v + showIconPattern str $ choose v diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs index bfe9aca..e19baf0 100644 --- a/src/Plugins/Monitors/CoreTemp.hs +++ b/src/Plugins/Monitors/CoreTemp.hs @@ -27,8 +27,8 @@ import Data.Char (isDigit) coreTempConfig :: IO MConfig coreTempConfig = mkMConfig "Temp: <core0>C" -- template - (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available - -- replacements + (map ((++) "core" . show) [0 :: Int ..]) -- available + -- replacements -- | -- Function retrieves monitor string holding the core temperature @@ -39,7 +39,7 @@ runCoreTemp _ = do failureMessage <- getConfigValue naString let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"] path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"] - lbl = Just ("_label", read . (dropWhile (not . isDigit))) + lbl = Just ("_label", read . dropWhile (not . isDigit)) divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show' diff --git a/src/Plugins/Monitors/Cpu.hs b/src/Plugins/Monitors/Cpu.hs index 6e83c67..7fed989 100644 --- a/src/Plugins/Monitors/Cpu.hs +++ b/src/Plugins/Monitors/Cpu.hs @@ -18,18 +18,40 @@ module Plugins.Monitors.Cpu (startCpu) where import Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import System.Console.GetOpt + +data CpuOpts = CpuOpts + { loadIconPattern :: Maybe IconPattern + } + +defaultOpts :: CpuOpts +defaultOpts = CpuOpts + { loadIconPattern = Nothing + } + +options :: [OptDescr (CpuOpts -> CpuOpts)] +options = + [ Option "" ["load-icon-pattern"] (ReqArg (\x o -> + o { loadIconPattern = Just $ parseIconPattern x }) "") "" + ] + +parseOpts :: [String] -> IO CpuOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs cpuConfig :: IO MConfig cpuConfig = mkMConfig "Cpu: <total>%" - ["bar","vbar","total","user","nice","system","idle","iowait"] + ["bar","vbar","ipat","total","user","nice","system","idle","iowait"] -type CpuDataRef = IORef [Float] +type CpuDataRef = IORef [Int] -cpuData :: IO [Float] +cpuData :: IO [Int] cpuData = cpuParser `fmap` B.readFile "/proc/stat" -cpuParser :: B.ByteString -> [Float] +cpuParser :: B.ByteString -> [Int] cpuParser = map (read . B.unpack) . tail . B.words . head . B.lines parseCpu :: CpuDataRef -> IO [Float] @@ -38,23 +60,25 @@ parseCpu cref = b <- cpuData writeIORef cref b let dif = zipWith (-) b a - tot = foldr (+) 0 dif - percent = map (/ tot) dif + tot = fromIntegral $ sum dif + percent = map ((/ tot) . fromIntegral) dif return percent -formatCpu :: [Float] -> Monitor [String] -formatCpu [] = return $ replicate 8 "" -formatCpu xs = do +formatCpu :: CpuOpts -> [Float] -> Monitor [String] +formatCpu _ [] = return $ replicate 8 "" +formatCpu opts xs = do let t = sum $ take 3 xs b <- showPercentBar (100 * t) t v <- showVerticalBar (100 * t) t + d <- showIconPattern (loadIconPattern opts) t ps <- showPercentsWithColors (t:xs) - return (b:v:ps) + return (b:v:d:ps) runCpu :: CpuDataRef -> [String] -> Monitor String -runCpu cref _ = +runCpu cref argv = do c <- io (parseCpu cref) - l <- formatCpu c + opts <- io $ parseOpts argv + l <- formatCpu opts c parseTemplate l startCpu :: [String] -> Int -> (String -> IO ()) -> IO () diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs index 3fe2577..d3ecf89 100644 --- a/src/Plugins/Monitors/CpuFreq.hs +++ b/src/Plugins/Monitors/CpuFreq.hs @@ -24,8 +24,8 @@ import Plugins.Monitors.CoreCommon cpuFreqConfig :: IO MConfig cpuFreqConfig = mkMConfig "Freq: <cpu0>" -- template - (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available - -- replacements + (map ((++) "cpu" . show) [0 :: Int ..]) -- available + -- replacements -- | -- Function retrieves monitor string holding the cpu frequency (or frequencies) @@ -33,7 +33,7 @@ runCpuFreq :: [String] -> Monitor String runCpuFreq _ = do let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"] divisor = 1e6 :: Double - fmt x | x < 1 = (show (round (x * 1000) :: Integer)) ++ "MHz" - | otherwise = (show x) ++ "GHz" + fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz" + | otherwise = show x ++ "GHz" failureMessage <- getConfigValue naString checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index e0a7886..0019c1a 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012 Jose A Ortega Ruiz +-- Copyright : (c) 2010, 2011, 2012, 2014 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -25,16 +25,67 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find) import Data.Maybe (catMaybes) import System.Directory (canonicalizePath, doesFileExist) +import System.Console.GetOpt + +data DiskIOOpts = DiskIOOpts + { totalIconPattern :: Maybe IconPattern + , writeIconPattern :: Maybe IconPattern + , readIconPattern :: Maybe IconPattern + } + +parseDiskIOOpts :: [String] -> IO DiskIOOpts +parseDiskIOOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + where defaultOpts = DiskIOOpts + { totalIconPattern = Nothing + , writeIconPattern = Nothing + , readIconPattern = Nothing + } + options = + [ Option "" ["total-icon-pattern"] (ReqArg (\x o -> + o { totalIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["write-icon-pattern"] (ReqArg (\x o -> + o { writeIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["read-icon-pattern"] (ReqArg (\x o -> + o { readIconPattern = Just $ parseIconPattern x}) "") "" + ] diskIOConfig :: IO MConfig diskIOConfig = mkMConfig "" ["total", "read", "write" ,"totalbar", "readbar", "writebar" ,"totalvbar", "readvbar", "writevbar" + ,"totalipat", "readipat", "writeipat" ] +data DiskUOpts = DiskUOpts + { freeIconPattern :: Maybe IconPattern + , usedIconPattern :: Maybe IconPattern + } + +parseDiskUOpts :: [String] -> IO DiskUOpts +parseDiskUOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + where defaultOpts = DiskUOpts + { freeIconPattern = Nothing + , usedIconPattern = Nothing + } + options = + [ Option "" ["free-icon-pattern"] (ReqArg (\x o -> + o { freeIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["used-icon-pattern"] (ReqArg (\x o -> + o { usedIconPattern = Just $ parseIconPattern x}) "") "" + ] + diskUConfig :: IO MConfig diskUConfig = mkMConfig "" - ["size", "free", "used", "freep", "usedp", "freebar", "freevbar", "usedbar", "usedvbar"] + [ "size", "free", "used", "freep", "usedp" + , "freebar", "freevbar", "freeipat" + , "usedbar", "usedvbar", "usedipat" + ] type DevName = String type Path = String @@ -63,10 +114,10 @@ diskDevices req = do s <- B.readFile "/proc/diskstats" parse `fmap` mapM canon (devs s) where - canon (d, p) = do {d' <- canonicalizePath (d); return (d', p)} + canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = map (third . B.words) . B.lines parse = map undev . filter isReq - third (_:_:c:_) = ("/dev/" ++ (B.unpack c), B.unpack c) + third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c) third _ = ("", "") isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) @@ -127,19 +178,22 @@ devTemplates disks mounted dat = Nothing -> [0, 0, 0] Just (_, xs) -> xs -runDiskIO' :: (String, [Float]) -> Monitor String -runDiskIO' (tmp, xs) = do +runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String +runDiskIO' opts (tmp, xs) = do s <- mapM (showWithColors speedToStr) xs b <- mapM (showLogBar 0.8) xs vb <- mapM (showLogVBar 0.8) xs + ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v) + $ zip [totalIconPattern, readIconPattern, writeIconPattern] xs setConfigValue tmp template - parseTemplate $ s ++ b ++ vb + parseTemplate $ s ++ b ++ vb ++ ipat runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String -runDiskIO dref disks _ = do +runDiskIO dref disks argv = do + opts <- io $ parseDiskIOOpts argv dev <- io $ mountedOrDiskDevices (map fst disks) dat <- io $ mountedData dref (map fst dev) - strs <- mapM runDiskIO' $ devTemplates disks dev dat + strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat return $ unwords strs startDiskIO :: [(String, String)] -> @@ -160,25 +214,28 @@ fsStats path = do used = fsStatBytesUsed f in return [tot, free, used] -runDiskU' :: String -> String -> Monitor String -runDiskU' tmp path = do +runDiskU' :: DiskUOpts -> String -> String -> Monitor String +runDiskU' opts tmp path = do setConfigValue tmp template [total, free, diff] <- io (handle ign $ fsStats path) - let strs = map sizeToStr [total, free, diff] + let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 - s <- zipWithM showWithColors' strs [100, freep, 100 - freep] + s <- zipWithM showWithColors' strs [freep, 100 - freep] sp <- showPercentsWithColors [fr, 1 - fr] fb <- showPercentBar (fromIntegral freep) fr fvb <- showVerticalBar (fromIntegral freep) fr + fipat <- showIconPattern (freeIconPattern opts) fr ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr) uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) - parseTemplate $ s ++ sp ++ [fb,fvb,ub,uvb] + uipat <- showIconPattern (usedIconPattern opts) (1 - fr) + parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer] runDiskU :: [(String, String)] -> [String] -> Monitor String -runDiskU disks _ = do +runDiskU disks argv = do devs <- io $ mountedDevices (map fst disks) - strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs + opts <- io $ parseDiskUOpts argv + strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs return $ unwords strs diff --git a/src/Plugins/Monitors/MPD.hs b/src/Plugins/Monitors/MPD.hs index ac976f2..5e02587 100644 --- a/src/Plugins/Monitors/MPD.hs +++ b/src/Plugins/Monitors/MPD.hs @@ -15,6 +15,7 @@ module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where import Data.List +import Data.Maybe (fromMaybe) import Plugins.Monitors.Common import System.Console.GetOpt import qualified Network.MPD as M @@ -22,7 +23,7 @@ import Control.Concurrent (threadDelay) mpdConfig :: IO MConfig mpdConfig = mkMConfig "MPD: <state>" - [ "bar", "vbar", "state", "statei", "volume", "length" + [ "bar", "vbar", "ipat", "state", "statei", "volume", "length" , "lapsed", "remaining", "plength", "ppos", "file" , "name", "artist", "composer", "performer" , "album", "title", "track", "genre" @@ -32,6 +33,7 @@ data MOpts = MOpts { mPlaying :: String , mStopped :: String , mPaused :: String + , mLapsedIconPattern :: Maybe IconPattern } defaultOpts :: MOpts @@ -39,6 +41,7 @@ defaultOpts = MOpts { mPlaying = ">>" , mStopped = "><" , mPaused = "||" + , mLapsedIconPattern = Nothing } options :: [OptDescr (MOpts -> MOpts)] @@ -46,6 +49,8 @@ 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 @@ -71,7 +76,7 @@ mpdReady _ = do -- 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.TimedOut -> return False + Left (M.ConnectionError _) -> return False Left _ -> return True mopts :: [String] -> IO MOpts @@ -87,12 +92,13 @@ parseMPD (Right st) song opts = do songData <- parseSong song bar <- showPercentBar (100 * b) b vbar <- showVerticalBar (100 * b) b - return $ [bar, vbar, ss, si, vol, len, lap, remain, plen, ppos] ++ songData + 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 $ M.stVolume st - (p, t) = M.stTime st + vol = int2str $ fromMaybe 0 (M.stVolume st) + (p, t) = fromMaybe (0, 0) (M.stTime st) [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 diff --git a/src/Plugins/Monitors/Mem.hs b/src/Plugins/Monitors/Mem.hs index e409095..403fa43 100644 --- a/src/Plugins/Monitors/Mem.hs +++ b/src/Plugins/Monitors/Mem.hs @@ -16,12 +16,44 @@ module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where import Plugins.Monitors.Common import qualified Data.Map as M +import System.Console.GetOpt + +data MemOpts = MemOpts + { usedIconPattern :: Maybe IconPattern + , freeIconPattern :: Maybe IconPattern + , availableIconPattern :: Maybe IconPattern + } + +defaultOpts :: MemOpts +defaultOpts = MemOpts + { usedIconPattern = Nothing + , freeIconPattern = Nothing + , availableIconPattern = Nothing + } + +options :: [OptDescr (MemOpts -> MemOpts)] +options = + [ Option "" ["used-icon-pattern"] (ReqArg (\x o -> + o { usedIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["free-icon-pattern"] (ReqArg (\x o -> + o { freeIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["available-icon-pattern"] (ReqArg (\x o -> + o { availableIconPattern = Just $ parseIconPattern x }) "") "" + ] + +parseOpts :: [String] -> IO MemOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs memConfig :: IO MConfig memConfig = mkMConfig "Mem: <usedratio>% (<cache>M)" -- template - ["usedbar", "usedvbar", "freebar", "freevbar", "usedratio", "freeratio", "total", - "free", "buffer", "cache", "rest", "used"] -- available replacements + ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat", + "availablebar", "availablevbar", "availableipat", + "usedratio", "freeratio", "availableratio", + "total", "free", "buffer", "cache", "available", "used"] -- available replacements fileMEM :: IO String fileMEM = readFile "/proc/meminfo" @@ -30,13 +62,14 @@ parseMEM :: IO [Float] parseMEM = do file <- fileMEM let content = map words $ take 8 $ lines file - info = M.fromList $ map (\line -> (line !! 0, (read $ line !! 1 :: Float) / 1024)) content + info = M.fromList $ map (\line -> (head line, (read $ line !! 1 :: Float) / 1024)) content [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] - rest = free + buffer + cache - used = total - (M.findWithDefault rest "MemAvailable:" info) + available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info + used = total - available usedratio = used / total freeratio = free / total - return [usedratio, freeratio, total, free, buffer, cache, rest, used, freeratio] + availableratio = available / total + return [usedratio, freeratio, availableratio, total, free, buffer, cache, available, used] totalMem :: IO Float totalMem = fmap ((*1024) . (!!1)) parseMEM @@ -44,22 +77,20 @@ totalMem = fmap ((*1024) . (!!1)) parseMEM usedMem :: IO Float usedMem = fmap ((*1024) . (!!6)) parseMEM -formatMem :: [Float] -> Monitor [String] -formatMem (r:fr:xs) = +formatMem :: MemOpts -> [Float] -> Monitor [String] +formatMem opts (r:fr:ar:xs) = do let f = showDigits 0 - rr = 100 * r - ub <- showPercentBar rr r - uvb <- showVerticalBar rr r - fb <- showPercentBar (100 - rr) (1 - r) - fvb <- showVerticalBar (100 - rr) ( 1 - r) - rs <- showPercentWithColors r - fs <- showPercentWithColors fr - s <- mapM (showWithColors f) xs - return (ub:uvb:fb:fvb:rs:fs:s) -formatMem _ = replicate 10 `fmap` getConfigValue naString + mon i x = [showPercentBar (100 * x) x, showVerticalBar (100 * x) x, showIconPattern i x] + sequence $ mon (usedIconPattern opts) r + ++ mon (freeIconPattern opts) fr + ++ mon (availableIconPattern opts) ar + ++ map showPercentWithColors [r, fr, ar] + ++ map (showWithColors f) xs +formatMem _ _ = replicate 10 `fmap` getConfigValue naString runMem :: [String] -> Monitor String -runMem _ = +runMem argv = do m <- io parseMEM - l <- formatMem m + opts <- io $ parseOpts argv + l <- formatMem opts m parseTemplate l diff --git a/src/Plugins/Monitors/Mpris.hs b/src/Plugins/Monitors/Mpris.hs index 98b4c0f..245c0df 100644 --- a/src/Plugins/Monitors/Mpris.hs +++ b/src/Plugins/Monitors/Mpris.hs @@ -25,6 +25,7 @@ import Text.Printf (printf) import DBus import qualified DBus.Client as DC +import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import System.IO.Unsafe (unsafePerformIO) @@ -43,10 +44,10 @@ instance MprisVersion MprisVersion1 where { methodCallDestination = Just busName } where - busName = busName_ $ "org.mpris." ++ p - objectPath = objectPath_ $ "/Player" - interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer" - memberName = memberName_ $ "GetMetadata" + busName = busName_ $ "org.mpris." ++ p + objectPath = objectPath_ "/Player" + interfaceName = interfaceName_ "org.freedesktop.MediaPlayer" + memberName = memberName_ "GetMetadata" fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title" , "tracknumber" ] @@ -58,10 +59,10 @@ instance MprisVersion MprisVersion2 where , methodCallBody = arguments } where - busName = busName_ $ "org.mpris.MediaPlayer2." ++ p - objectPath = objectPath_ $ "/org/mpris/MediaPlayer2" - interfaceName = interfaceName_ $ "org.freedesktop.DBus.Properties" - memberName = memberName_ $ "Get" + busName = busName_ $ "org.mpris.MediaPlayer2." ++ p + objectPath = objectPath_ "/org/mpris/MediaPlayer2" + interfaceName = interfaceName_ "org.freedesktop.DBus.Properties" + memberName = memberName_ "Get" arguments = map (toVariant::String -> Variant) ["org.mpris.MediaPlayer2.Player", "Metadata"] @@ -98,7 +99,7 @@ fromVar = fromJust . fromVariant unpackMetadata :: [Variant] -> [(String, Variant)] unpackMetadata [] = [] -unpackMetadata xs = ((map (\(k, v) -> (fromVar k, fromVar v))) . unpack . head) xs where +unpackMetadata xs = (map (fromVar *** fromVar) . unpack . head) xs where unpack v = case variantType v of TypeDictionary _ _ -> dictionaryItems $ fromVar v TypeVariant -> unpack $ fromVar v diff --git a/src/Plugins/Monitors/MultiCpu.hs b/src/Plugins/Monitors/MultiCpu.hs index 429c38a..eab21da 100644 --- a/src/Plugins/Monitors/MultiCpu.hs +++ b/src/Plugins/Monitors/MultiCpu.hs @@ -15,12 +15,39 @@ module Plugins.Monitors.MultiCpu (startMultiCpu) where import Plugins.Monitors.Common +import Control.Applicative ((<$>)) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import System.Console.GetOpt + +data MultiCpuOpts = MultiCpuOpts + { loadIconPatterns :: [IconPattern] + , loadIconPattern :: Maybe IconPattern + } + +defaultOpts :: MultiCpuOpts +defaultOpts = MultiCpuOpts + { loadIconPatterns = [] + , loadIconPattern = Nothing + } + +options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)] +options = + [ Option "" ["load-icon-pattern"] (ReqArg (\x o -> + o { loadIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["load-icon-patterns"] (ReqArg (\x o -> + o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") "" + ] + +parseOpts :: [String] -> IO MultiCpuOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs variables :: [String] -variables = ["bar", "vbar","total","user","nice","system","idle"] +variables = ["bar", "vbar","ipat","total","user","nice","system","idle"] vNum :: Int vNum = length variables @@ -52,20 +79,25 @@ parseCpuData cref = percent :: [Float] -> [Float] -> [Float] percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0] where dif = zipWith (-) b a - tot = foldr (+) 0 dif + tot = sum dif -formatMultiCpus :: [[Float]] -> Monitor [String] -formatMultiCpus [] = return [] -formatMultiCpus xs = fmap concat $ mapM formatCpu xs +formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String] +formatMultiCpus _ [] = return [] +formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs) -formatCpu :: [Float] -> Monitor [String] -formatCpu xs +formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String] +formatCpu opts i xs | length xs < 4 = showPercentsWithColors $ replicate vNum 0.0 - | otherwise = let t = foldr (+) 0 $ take 3 xs + | otherwise = let t = sum $ take 3 xs in do b <- showPercentBar (100 * t) t h <- showVerticalBar (100 * t) t + d <- showIconPattern tryString t ps <- showPercentsWithColors (t:xs) - return (b:h:ps) + return (b:h:d:ps) + where tryString + | i == 0 = loadIconPattern opts + | i <= length (loadIconPatterns opts) = Just $ (loadIconPatterns opts) !! (i - 1) + | otherwise = Nothing splitEvery :: (Eq a) => Int -> [a] -> [[a]] splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x) @@ -78,9 +110,10 @@ formatAutoCpus [] = return $ replicate vNum "" formatAutoCpus xs = return $ map unwords (groupData xs) runMultiCpu :: CpuDataRef -> [String] -> Monitor String -runMultiCpu cref _ = +runMultiCpu cref argv = do c <- io $ parseCpuData cref - l <- formatMultiCpus c + opts <- io $ parseOpts argv + l <- formatMultiCpus opts c a <- formatAutoCpus l parseTemplate $ a ++ l diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index e49d1aa..5954a77 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -22,12 +22,47 @@ import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import Control.Monad (forM, filterM) +import Control.Monad (forM, filterM, liftM) import System.Directory (getDirectoryContents, doesFileExist) import System.FilePath ((</>)) +import System.Console.GetOpt import qualified Data.ByteString.Lazy.Char8 as B +data NetOpts = NetOpts + { rxIconPattern :: Maybe IconPattern + , txIconPattern :: Maybe IconPattern + } + +defaultOpts :: NetOpts +defaultOpts = NetOpts + { rxIconPattern = Nothing + , txIconPattern = Nothing + } + +options :: [OptDescr (NetOpts -> NetOpts)] +options = + [ Option "" ["rx-icon-pattern"] (ReqArg (\x o -> + o { rxIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["tx-icon-pattern"] (ReqArg (\x o -> + o { txIconPattern = Just $ parseIconPattern x }) "") "" + ] + +parseOpts :: [String] -> IO NetOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + +data UnitPerSec = Bs | KBs | MBs | GBs deriving (Eq,Enum,Ord) +data NetValue = NetValue Float UnitPerSec deriving (Eq,Show) + +instance Show UnitPerSec where + show Bs = "B/s" + show KBs = "KB/s" + show MBs = "MB/s" + show GBs = "GB/s" + data NetDev = NA | NI String | ND String Float Float deriving (Eq,Show,Read) @@ -42,8 +77,8 @@ instance Ord NetDev where compare NA _ = LT compare _ NA = GT compare (NI _) (NI _) = EQ - compare (NI _) (ND _ _ _) = LT - compare (ND _ _ _) (NI _) = GT + compare (NI _) (ND {}) = LT + compare (ND {}) (NI _) = GT compare (ND _ x1 y1) (ND _ x2 y2) = if downcmp /= EQ then downcmp @@ -53,7 +88,7 @@ instance Ord NetDev where netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template - ["dev", "rx", "tx", "rxbar", "rxvbar", "txbar", "txvbar"] -- available replacements + ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"] -- available replacements operstateDir :: String -> FilePath operstateDir d = "/sys/class/net" </> d </> "operstate" @@ -74,7 +109,7 @@ readNetDev (d:x:y:_) = do up <- isUp d return (if up then ND d (r x) (r y) else NI d) where r s | s == "" = 0 - | otherwise = read s / 1024 + | otherwise = read s readNetDev _ = return NA @@ -97,23 +132,26 @@ findNetDev dev = do isDev (NI d) = d == dev isDev NA = False -formatNet :: Float -> Monitor (String, String, String) -formatNet d = do +formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String) +formatNet mipat d = do s <- getConfigValue useSuffix dd <- getConfigValue decDigits - let str = if s then (++"Kb/s") . showDigits dd else showDigits dd + let str True v = showDigits dd d' ++ show u + where (NetValue d' u) = byteNetVal v + str False v = showDigits dd $ v / 1024 b <- showLogBar 0.9 d vb <- showLogVBar 0.9 d - x <- showWithColors str d - return (x, b, vb) + ipat <- showLogIconPattern mipat 0.9 d + x <- showWithColors (str s) d + return (x, b, vb, ipat) -printNet :: NetDev -> Monitor String -printNet nd = +printNet :: NetOpts -> NetDev -> Monitor String +printNet opts nd = case nd of ND d r t -> do - (rx, rb, rvb) <- formatNet r - (tx, tb, tvb) <- formatNet t - parseTemplate [d,rx,tx,rb,rvb,tb,tvb] + (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r + (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t + parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat] NI _ -> return "" NA -> getConfigValue naString @@ -133,14 +171,20 @@ parseNet nref nd = do return $ diffRate n0 n1 runNet :: NetDevRef -> String -> [String] -> Monitor String -runNet nref i _ = io (parseNet nref i) >>= printNet +runNet nref i argv = do + dev <- io $ parseNet nref i + opts <- io $ parseOpts argv + printNet opts dev parseNets :: [(NetDevRef, String)] -> IO [NetDev] -parseNets = mapM $ \(ref, i) -> parseNet ref i +parseNets = mapM $ uncurry parseNet runNets :: [(NetDevRef, String)] -> [String] -> Monitor String -runNets refs _ = io (parseActive refs) >>= printNet - where parseActive refs' = parseNets refs' >>= return . selectActive +runNets refs argv = do + dev <- io $ parseActive refs + opts <- io $ parseOpts argv + printNet opts dev + where parseActive refs' = liftM selectActive (parseNets refs') selectActive = maximum startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO () @@ -159,3 +203,10 @@ startDynNet a r cb = do _ <- parseNet nref d return (nref, d) runM a netConfig (runNets refs) r cb + +byteNetVal :: Float -> NetValue +byteNetVal v + | v < 1024**1 = NetValue v Bs + | v < 1024**2 = NetValue (v/1024**1) KBs + | v < 1024**3 = NetValue (v/1024**2) MBs + | otherwise = NetValue (v/1024**3) GBs diff --git a/src/Plugins/Monitors/Swap.hs b/src/Plugins/Monitors/Swap.hs index 107eb1e..b6c5019 100644 --- a/src/Plugins/Monitors/Swap.hs +++ b/src/Plugins/Monitors/Swap.hs @@ -33,8 +33,8 @@ parseMEM = | l /= [] = head l !! i | otherwise = B.empty fs s l - | l == [] = False - | otherwise = head l == B.pack s + | null l = False + | otherwise = head l == B.pack s get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) st = map B.words . B.lines $ file tot = get_data "SwapTotal:" st diff --git a/src/Plugins/Monitors/Thermal.hs b/src/Plugins/Monitors/Thermal.hs index a3ffe6d..6013511 100644 --- a/src/Plugins/Monitors/Thermal.hs +++ b/src/Plugins/Monitors/Thermal.hs @@ -14,6 +14,7 @@ module Plugins.Monitors.Thermal where +import Control.Monad (liftM) import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common import System.Posix.Files (fileExist) @@ -32,11 +33,9 @@ runThermal args = do let zone = head args file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature" exists <- io $ fileExist file - case exists of - False -> return $ "Thermal (" ++ zone ++ "): N/A" - True -> do number <- io $ B.readFile file - >>= return . (read :: String -> Int) - . stringParser (1, 0) - thermal <- showWithColors show number - parseTemplate [ thermal ] + if exists + then do number <- io $ liftM ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file) + thermal <- showWithColors show number + parseTemplate [ thermal ] + else return $ "Thermal (" ++ zone ++ "): N/A" diff --git a/src/Plugins/Monitors/Top.hs b/src/Plugins/Monitors/Top.hs index 6be3c1c..3d246ff 100644 --- a/src/Plugins/Monitors/Top.hs +++ b/src/Plugins/Monitors/Top.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top --- Copyright : (c) Jose A Ortega Ruiz +-- Copyright : (c) 2010, 2011, 2012, 2013, 2014 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -101,7 +101,7 @@ meminfos = handleProcesses meminfo showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = - showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc) + showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc) where sc = if scale > 0 then scale else 100 showMemInfos :: [MemInfo] -> Monitor [[String]] diff --git a/src/Plugins/Monitors/Volume.hs b/src/Plugins/Monitors/Volume.hs index 22b7f6c..8c39b9f 100644 --- a/src/Plugins/Monitors/Volume.hs +++ b/src/Plugins/Monitors/Volume.hs @@ -24,7 +24,7 @@ import System.Console.GetOpt volumeConfig :: IO MConfig volumeConfig = mkMConfig "Vol: <volume>% <status>" - ["volume", "volumebar", "volumevbar", "dB","status"] + ["volume", "volumebar", "volumevbar", "dB","status", "volumeipat"] data VolumeOpts = VolumeOpts @@ -34,6 +34,7 @@ data VolumeOpts = VolumeOpts , offColor :: Maybe String , highDbThresh :: Float , lowDbThresh :: Float + , volumeIconPattern :: Maybe IconPattern } defaultOpts :: VolumeOpts @@ -44,6 +45,7 @@ defaultOpts = VolumeOpts , offColor = Just "red" , highDbThresh = -5.0 , lowDbThresh = -30.0 + , volumeIconPattern = Nothing } options :: [OptDescr (VolumeOpts -> VolumeOpts)] @@ -54,6 +56,8 @@ options = , Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") "" , Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") "" , Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") "" + , Option "" ["volume-icon-pattern"] (ReqArg (\x o -> + o { volumeIconPattern = Just $ parseIconPattern x }) "") "" ] parseOpts :: [String] -> IO VolumeOpts @@ -80,6 +84,10 @@ formatVolVBar :: Integer -> Integer -> Integer -> Monitor String formatVolVBar lo hi v = showVerticalBar (100 * x) x where x = percent v lo hi +formatVolDStr :: Maybe IconPattern -> Integer -> Integer -> Integer -> Monitor String +formatVolDStr ipat lo hi v = + showIconPattern ipat $ percent v lo hi + switchHelper :: VolumeOpts -> (VolumeOpts -> Maybe String) -> (VolumeOpts -> String) @@ -126,7 +134,8 @@ runVolume mixerName controlName argv = do v <- liftMonitor $ liftM3 formatVolVBar lo hi val d <- getFormatDB opts db s <- getFormatSwitch opts sw - parseTemplate [p, b, v, d, s] + ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val + parseTemplate [p, b, v, d, s, ipat] where diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs index dfc421e..3cfbc74 100644 --- a/src/Plugins/Monitors/Weather.hs +++ b/src/Plugins/Monitors/Weather.hs @@ -22,7 +22,6 @@ import Network.HTTP import Text.ParserCombinators.Parsec - weatherConfig :: IO MConfig weatherConfig = mkMConfig "<station>: <tempC>C, rh <rh>% (<hour>)" -- template @@ -32,12 +31,16 @@ weatherConfig = mkMConfig , "month" , "day" , "hour" - , "wind" + , "windCardinal" + , "windAzimuth" + , "windMph" + , "windKnots" , "visibility" , "skyCondition" , "tempC" , "tempF" - , "dewPoint" + , "dewPointC" + , "dewPointF" , "rh" , "pressure" ] @@ -49,12 +52,16 @@ data WeatherInfo = , month :: String , day :: String , hour :: String - , wind :: String + , windCardinal :: String + , windAzimuth :: String + , windMph :: String + , windKnots :: String , visibility :: String , skyCondition :: String , tempC :: Int , tempF :: Int - , dewPoint :: String + , dewPointC :: Int + , dewPointF :: Int , humidity :: Int , pressure :: Int } deriving (Show) @@ -68,7 +75,41 @@ pTime = do y <- getNumbersAsString char ' ' (h:hh:mi:mimi) <- getNumbersAsString char ' ' - return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) + return (y, m, d ,h:hh:":"++mi:mimi) + +-- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0" +pWind0 :: + ( + String -- cardinal direction + , String -- azimuth direction + , String -- speed (MPH) + , String -- speed (knot) + ) +pWind0 = + ("μ", "μ", "0", "0") + +pWind :: + Parser ( + String -- cardinal direction + , String -- azimuth direction + , String -- speed (MPH) + , String -- speed (knot) + ) +pWind = + let tospace = manyTill anyChar (char ' ') + wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0") + return pWind0 + wind = do manyTill skipRestOfLine (string "Wind: from the ") + cardinal <- tospace + char '(' + azimuth <- tospace + string "degrees) at " + mph <- tospace + string "MPH (" + knot <- tospace + manyTill anyChar newline + return (cardinal, azimuth, mph, knot) + in try wind0 <|> wind pTemp :: Parser (Int, Int) pTemp = do let num = digit <|> char '-' <|> char '.' @@ -76,10 +117,10 @@ pTemp = do let num = digit <|> char '-' <|> char '.' manyTill anyChar $ char '(' c <- manyTill num $ char ' ' skipRestOfLine - return $ (floor (read c :: Double), floor (read f :: Double)) + return (floor (read c :: Double), floor (read f :: Double)) pRh :: Parser Int -pRh = do s <- manyTill digit $ (char '%' <|> char '.') +pRh = do s <- manyTill digit (char '%' <|> char '.') return $ read s pPressure :: Parser Int @@ -112,18 +153,19 @@ parseData = ) skipRestOfLine >> getAllBut "/" (y,m,d,h) <- pTime - w <- getAfterString "Wind: " + (wc, wa, wm, wk) <- pWind v <- getAfterString "Visibility: " sk <- getAfterString "Sky conditions: " skipTillString "Temperature: " (tC,tF) <- pTemp - dp <- getAfterString "Dew Point: " + skipTillString "Dew Point: " + (dC, dF) <- pTemp skipTillString "Relative Humidity: " rh <- pRh skipTillString "Pressure (altimeter): " p <- pPressure manyTill skipRestOfLine eof - return $ [WI st ss y m d h w v sk tC tF dp rh p] + return [WI st ss y m d h wc wa wm wk v sk tC tF dC dF rh p] defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" @@ -139,10 +181,10 @@ getData station = do errHandler _ = return "<Could not retrieve data>" formatWeather :: [WeatherInfo] -> Monitor String -formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] = +formatWeather [WI st ss y m d h wc wa wm wk v sk tC tF dC dF r p] = do cel <- showWithColors show tC far <- showWithColors show tF - parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ] + parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, v, sk, cel, far, show dC, show dF, show r , show p ] formatWeather _ = getConfigValue naString runWeather :: [String] -> Monitor String @@ -158,10 +200,10 @@ weatherReady str = do io $ CE.catch (simpleHTTP request >>= checkResult) errHandler where errHandler :: CE.IOException -> IO Bool errHandler _ = return False - checkResult result = do + checkResult result = case result of Left _ -> return False - Right response -> do + Right response -> case rspCode response of -- Permission or network errors are failures; anything -- else is recoverable. diff --git a/src/Plugins/Monitors/Wireless.hs b/src/Plugins/Monitors/Wireless.hs index c6e6b44..b1e3c7e 100644 --- a/src/Plugins/Monitors/Wireless.hs +++ b/src/Plugins/Monitors/Wireless.hs @@ -14,15 +14,39 @@ module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where +import System.Console.GetOpt + import Plugins.Monitors.Common import IWlib +data WirelessOpts = WirelessOpts + { qualityIconPattern :: Maybe IconPattern + } + +defaultOpts :: WirelessOpts +defaultOpts = WirelessOpts + { qualityIconPattern = Nothing + } + +options :: [OptDescr (WirelessOpts -> WirelessOpts)] +options = + [ Option "" ["quality-icon-pattern"] (ReqArg (\d opts -> + opts { qualityIconPattern = Just $ parseIconPattern d }) "") "" + ] + +parseOpts :: [String] -> IO WirelessOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + wirelessConfig :: IO MConfig wirelessConfig = - mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar"] + mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar", "qualityipat"] -runWireless :: [String] -> Monitor String -runWireless (iface:_) = do +runWireless :: String -> [String] -> Monitor String +runWireless iface args = do + opts <- io $ parseOpts args wi <- io $ getWirelessInfo iface na <- getConfigValue naString let essid = wiEssid wi @@ -34,5 +58,5 @@ runWireless (iface:_) = do else showWithPadding "" qb <- showPercentBar qlty (qlty / 100) qvb <- showVerticalBar qlty (qlty / 100) - parseTemplate [ep, q, qb, qvb] -runWireless _ = getConfigValue naString + qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100) + parseTemplate [ep, q, qb, qvb, qipat] diff --git a/src/Plugins/PipeReader.hs b/src/Plugins/PipeReader.hs index 7efea60..058ed46 100644 --- a/src/Plugins/PipeReader.hs +++ b/src/Plugins/PipeReader.hs @@ -19,7 +19,7 @@ import Plugins import System.Posix.Files import Control.Concurrent(threadDelay) import Control.Exception -import Control.Monad(when) +import Control.Monad(forever, unless) data PipeReader = PipeReader String String deriving (Read, Show) @@ -28,21 +28,18 @@ instance Exec PipeReader where alias (PipeReader _ a) = a start (PipeReader p _) cb = do let (def, pipe) = split ':' p - when (not $ null def) (cb def) + unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode forever (hGetLineSafe h >>= cb) where - forever a = a >> forever a - split c xs | c `elem` xs = let (pre, post) = span ((/=) c) xs - in (pre, dropWhile ((==) c) post) + split c xs | c `elem` xs = let (pre, post) = span (c /=) xs + in (pre, dropWhile (c ==) post) | otherwise = ([], xs) checkPipe :: FilePath -> IO () -checkPipe file = do +checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do - status <- getFileStatus file - if isNamedPipe status - then return () - else waitForPipe + status <- getFileStatus file + unless (isNamedPipe status) waitForPipe where waitForPipe = threadDelay 1000 >> checkPipe file diff --git a/src/Plugins/StdinReader.hs b/src/Plugins/StdinReader.hs index 35f0375..31d041e 100644 --- a/src/Plugins/StdinReader.hs +++ b/src/Plugins/StdinReader.hs @@ -34,7 +34,7 @@ instance Exec StdinReader where s <- handle (\(SomeException e) -> do hPrint stderr e; return "") (hGetLineSafe stdin) cb $ escape stdinReader s - eof <- hIsEOF stdin + eof <- isEOF if eof then exitImmediately ExitSuccess else start stdinReader cb |