xmobar 0.10 → 0.11
raw patch · 23 files changed
+1222/−141 lines, 23 filesdep +libmpddep +time
Dependencies added: libmpd, time
Files
- Config.hs +4/−1
- IWlib.hsc +77/−0
- Plugins/MBox.hs +124/−0
- Plugins/Mail.hs +0/−1
- Plugins/Monitors.hs +65/−20
- Plugins/Monitors/Batt.hs +5/−5
- Plugins/Monitors/Common.hs +145/−35
- Plugins/Monitors/CoreCommon.hs +13/−9
- Plugins/Monitors/CoreTemp.hs +1/−1
- Plugins/Monitors/Cpu.hs +10/−10
- Plugins/Monitors/CpuFreq.hs +1/−1
- Plugins/Monitors/Disk.hs +137/−0
- Plugins/Monitors/MPD.hs +92/−0
- Plugins/Monitors/Mem.hs +23/−12
- Plugins/Monitors/MultiCpu.hs +66/−0
- Plugins/Monitors/Net.hs +11/−9
- Plugins/Monitors/Swap.hs +5/−6
- Plugins/Monitors/Top.hs +156/−0
- Plugins/Monitors/Wireless.hs +34/−0
- README +140/−10
- StatFS.hsc +70/−0
- Xmobar.hs +10/−6
- xmobar.cabal +33/−15
Config.hs view
@@ -35,6 +35,7 @@ #ifdef INOTIFY import Plugins.Mail+import Plugins.MBox #endif -- $config@@ -58,8 +59,10 @@ data XPosition = Top | TopW Align Int+ | TopSize Align Int Int | Bottom | BottomW Align Int+ | BottomSize Align Int Int | Static {xpos, ypos, width, height :: Int} | OnScreen Int XPosition deriving ( Read, Eq )@@ -94,7 +97,7 @@ -- this function's type signature. runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: #ifdef INOTIFY- Mail :*:+ Mail :*: MBox :*: #endif () runnableTypes = undefined
+ IWlib.hsc view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module : IWlib+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A partial binding to iwlib+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+++module IWlib (WirelessInfo(..), getWirelessInfo) where++import Foreign+import Foreign.C.Types+import Foreign.C.String++data WirelessInfo = WirelessInfo { wiEssid :: String, wiQuality :: Int }+ deriving Show++#include <iwlib.h>++data WCfg+data WStats+data WRange++foreign import ccall "iwlib.h iw_sockets_open"+ c_iw_open :: IO CInt++foreign import ccall "unistd.h close"+ c_iw_close :: CInt -> IO ()++foreign import ccall "iwlib.h iw_get_basic_config"+ c_iw_basic_config :: CInt -> CString -> Ptr WCfg -> IO CInt++foreign import ccall "iwlib.h iw_get_stats"+ c_iw_stats :: CInt -> CString -> Ptr WStats -> Ptr WRange -> CInt -> IO CInt++foreign import ccall "iwlib.h iw_get_range_info"+ c_iw_range :: CInt -> CString -> Ptr WRange -> IO CInt++getWirelessInfo :: String -> IO WirelessInfo+getWirelessInfo iface =+ allocaBytes (#size struct wireless_config) $ \wc ->+ allocaBytes (#size struct iw_statistics) $ \stats ->+ allocaBytes (#size struct iw_range) $ \rng ->+ withCString iface $ \istr -> do+ i <- c_iw_open+ bcr <- c_iw_basic_config i istr wc+ str <- c_iw_stats i istr stats rng 1+ rgr <- c_iw_range i istr rng+ c_iw_close i+ if (bcr < 0) then return nullInfo else+ do hase <- (#peek struct wireless_config, has_essid) wc :: IO CInt+ eon <- (#peek struct wireless_config, essid_on) wc :: IO CInt+ essid <- if hase /= 0 && eon /= 0 then+ do l <- (#peek struct wireless_config, essid_len) wc+ let e = (#ptr struct wireless_config, essid) wc+ peekCStringLen (e, fromIntegral (l :: CInt))+ else return ""+ q <- if str >= 0 && rgr >=0 then+ do qualv <- xqual $ (#ptr struct iw_statistics, qual) stats+ mv <- xqual $ (#ptr struct iw_range, max_qual) rng+ let mxv = if mv /= 0 then fromIntegral mv else 1+ return $ fromIntegral qualv / mxv+ else return (-1)+ let qv = round (100 * (q :: Double))+ return $ WirelessInfo { wiEssid = essid, wiQuality = min 100 qv }+ where nullInfo = WirelessInfo { wiEssid = "", wiQuality = -1 }+ xqual p = let qp = (#ptr struct iw_param, value) p in+ (#peek struct iw_quality, qual) qp :: IO CChar
+ Plugins/MBox.hs view
@@ -0,0 +1,124 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.MBox+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for checking mail in mbox files.+--+-----------------------------------------------------------------------------++module Plugins.MBox (MBox(..)) where++import Prelude hiding (catch)+import Plugins++import Control.Monad+import Control.Concurrent.STM+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+ , oUniq :: Bool+ , oDir :: FilePath+ , oPrefix :: String+ , oSuffix :: String+ }++defaults :: Options+defaults = Options {+ oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""+ }++options :: [OptDescr (Options -> Options)]+options =+ [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""+ , Option "u" [] (NoArg (\o -> o { oUniq = 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 list of options.+data MBox = MBox [(String, FilePath, String)] [String] String+ deriving (Read, Show)++instance Exec MBox where+ 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+ uniq = oUniq opts++ dirExists <- doesDirectoryExist dir+ let ts = map (\(t, _, _) -> t) ms+ sec = \(_, f, _) -> f+ md = if dirExists then (dir </>) . sec else sec+ fs = map md ms+ cs = map (\(_, _, c) -> c) ms+ ev = [CloseWrite]++ i <- initINotify+ zipWithM_ (\f v -> addWatch i ev f (handleNotification v)) fs vs++ forM_ (zip fs vs) $ \(f, v) -> do+ exists <- doesFileExist f+ n <- if exists then countMails f else return 0+ atomically $ writeTVar v (f, n)++ changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->+ let s = unwords [ showC uniq 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 :: Bool -> String -> Int -> String -> String+showC u m n c =+ if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"+ where msg = m ++ if not u || n > 1 then show n else ""++countMails :: FilePath -> IO Int+countMails f =+ handle ((\_ -> evaluate 0) :: SomeException -> IO Int)+ (do txt <- B.readFile f+ evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt)+ where from = B.pack "From "++handleNotification :: TVar (FilePath, Int) -> Event -> IO ()+handleNotification v _ = do+ (p, _) <- atomically $ readTVar v+ n <- countMails p+ atomically $ writeTVar v (p, n)++changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()+changeLoop s f = atomically s >>= go+ where+ go old = do+ f old+ go =<< atomically (do+ new <- s+ guard (new /= old)+ return new)
Plugins/Mail.hs view
@@ -15,7 +15,6 @@ module Plugins.Mail where import Prelude hiding (catch)-import System.IO import Plugins import Control.Monad
Plugins/Monitors.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.Monitors@@ -22,21 +24,41 @@ import Plugins.Monitors.Mem import Plugins.Monitors.Swap import Plugins.Monitors.Cpu+import Plugins.Monitors.MultiCpu import Plugins.Monitors.Batt import Plugins.Monitors.Thermal import Plugins.Monitors.CpuFreq import Plugins.Monitors.CoreTemp+import Plugins.Monitors.Disk+import Plugins.Monitors.Top+#ifdef IWLIB+import Plugins.Monitors.Wireless+#endif+#ifdef LIBMPD+import Plugins.Monitors.MPD+#endif -data Monitors = Weather Station Args Rate- | Network Interface Args Rate- | Memory Args Rate- | Swap Args Rate- | Cpu Args Rate- | Battery Args Rate- | BatteryP [String] Args Rate- | Thermal Zone Args Rate- | CpuFreq Args Rate- | CoreTemp Args Rate+data Monitors = Weather Station Args Rate+ | Network Interface Args Rate+ | Memory Args Rate+ | Swap Args Rate+ | Cpu Args Rate+ | MultiCpu Args Rate+ | Battery Args Rate+ | BatteryP [String] Args Rate+ | DiskU DiskSpec Args Rate+ | DiskIO DiskSpec Args Rate+ | Thermal Zone Args Rate+ | CpuFreq Args Rate+ | CoreTemp Args Rate+ | TopProc Args Rate+ | TopMem Args Rate+#ifdef IWLIB+ | Wireless Interface Args Rate+#endif+#ifdef LIBMPD+ | MPD Args Rate+#endif deriving (Show,Read,Eq) type Args = [String]@@ -46,6 +68,7 @@ type Zone = String type Interface = String type Rate = Int+type DiskSpec = [(String, String)] instance Exec Monitors where alias (Weather s _ _) = s@@ -54,17 +77,39 @@ alias (Memory _ _) = "memory" alias (Swap _ _) = "swap" alias (Cpu _ _) = "cpu"+ alias (MultiCpu _ _) = "multicpu" alias (Battery _ _) = "battery" alias (BatteryP _ _ _)= "battery" alias (CpuFreq _ _) = "cpufreq"+ alias (TopProc _ _) = "top"+ alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp"- start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r- start (Network i a r) = runM (a ++ [i]) netConfig runNet r- start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r- start (Memory a r) = runM a memConfig runMem r- start (Swap a r) = runM a swapConfig runSwap r- start (Cpu a r) = runM a cpuConfig runCpu r- start (Battery a r) = runM a battConfig runBatt r- start (BatteryP s a r) = runM a battConfig (runBatt' s) r- start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r- start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r+ alias (DiskU _ _ _) = "disku"+ alias (DiskIO _ _ _) = "diskio"+#ifdef IWLIB+ alias (Wireless i _ _) = i ++ "wi"+#endif+#ifdef LIBMPD+ alias (MPD _ _) = "mpd"+#endif+ start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r+ start (Network i a r) = runM (a ++ [i]) netConfig runNet r+ start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r+ start (Memory a r) = runM a memConfig runMem r+ start (Swap a r) = runM a swapConfig runSwap r+ start (Cpu a r) = runM a cpuConfig runCpu r+ start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r+ start (Battery a r) = runM a battConfig runBatt r+ start (BatteryP s a r) = runM a battConfig (runBatt' s) r+ start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r+ start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r+ start (DiskU s a r) = runM a diskUConfig (runDiskU s) r+ start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r+ start (TopMem a r) = runM a topMemConfig runTopMem r+ start (TopProc a r) = startTop a r+#ifdef IWLIB+ start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r+#endif+#ifdef LIBMPD+ start (MPD a r) = runM a mpdConfig runMPD r+#endif
Plugins/Monitors/Batt.hs view
@@ -24,7 +24,7 @@ battConfig :: IO MConfig battConfig = mkMConfig "Batt: <left>" -- template- ["left","status"] -- available replacements+ ["leftbar", "left", "status"] -- available replacements type File = (String, String) @@ -61,10 +61,10 @@ return $ if isNaN left then NA else Batt left c0 formatBatt :: Float -> Monitor [String]-formatBatt x =- do let f s = floatToPercent (s / 100)- l <- showWithColors f (x * 100)- return [l]+formatBatt x = do+ p <- showPercentsWithColors [x]+ b <- showPercentBar (100 * x) x+ return (b:p) runBatt :: [String] -> Monitor String runBatt = runBatt' ["BAT0","BAT1","BAT2"]
Plugins/Monitors/Common.hs view
@@ -3,7 +3,7 @@ -- Module : Plugins.Monitors.Common -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE)--- +-- -- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> -- Stability : unstable -- Portability : unportable@@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Common ( +module Plugins.Monitors.Common ( -- * Monitors -- $monitor Monitor@@ -35,7 +35,14 @@ , parseTemplate -- ** String Manipulation -- $strings+ , padString+ , showWithPadding , showWithColors+ , showWithColors'+ , showPercentsWithColors+ , showPercentBar+ , showLogBar+ , showWithUnits , takeDigits , showDigits , floatToPercent@@ -51,13 +58,13 @@ import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef-import qualified Data.Map as Map +import qualified Data.Map as Map import Data.List import Numeric import Text.ParserCombinators.Parsec import System.Console.GetOpt import Control.Exception (SomeException,handle)-import System.Process(readProcess)+import System.Process (readProcess) import Plugins -- $monitor@@ -72,18 +79,26 @@ , highColor :: IORef (Maybe String) , template :: IORef String , export :: IORef [String]- } + , ppad :: IORef Int+ , minWidth :: IORef Int+ , maxWidth :: IORef Int+ , padChars :: IORef [Char]+ , padRight :: IORef Bool+ , barBack :: IORef String+ , barFore :: IORef String+ , barWidth :: IORef Int+ } -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' type Selector a = MConfig -> IORef a sel :: Selector a -> Monitor a-sel s = +sel s = do hs <- ask liftIO $ readIORef (s hs) mods :: Selector a -> (a -> a) -> Monitor ()-mods s m = +mods s m = do v <- ask io $ modifyIORef (s v) m @@ -106,7 +121,15 @@ hc <- newIORef Nothing t <- newIORef tmpl e <- newIORef exprts- return $ MC nc l lc h hc t e+ p <- newIORef 0+ mn <- newIORef 0+ mx <- newIORef 0+ pc <- newIORef " "+ pr <- newIORef False+ bb <- newIORef ":"+ bf <- newIORef "#"+ bw <- newIORef 10+ return $ MC nc l lc h hc t e p mn mx pc pr bb bf bw data Opts = HighColor String | NormalColor String@@ -114,18 +137,36 @@ | Low String | High String | Template String+ | PercentPad String+ | MinWidth String+ | MaxWidth String+ | Width String+ | PadChars String+ | PadAlign String+ | BarBack String+ | BarFore String+ | BarWidth String options :: [OptDescr Opts] options =- [ Option ['H'] ["High"] (ReqArg High "number" ) "The high threshold"- , Option ['L'] ["Low"] (ReqArg Low "number" ) "The low threshold"- , Option ['h'] ["high"] (ReqArg HighColor "color number" ) "Color for the high threshold: ex \"#FF0000\""- , Option ['n'] ["normal"] (ReqArg NormalColor "color number" ) "Color for the normal threshold: ex \"#00FF00\""- , Option ['l'] ["low"] (ReqArg LowColor "color number" ) "Color for the low threshold: ex \"#0000FF\""- , Option ['t'] ["template"] (ReqArg Template "output template" ) "Output template."+ [ Option ['H'] ["High"] (ReqArg High "number" ) "The high threshold"+ , Option ['L'] ["Low"] (ReqArg Low "number" ) "The low threshold"+ , Option ['h'] ["high"] (ReqArg HighColor "color number" ) "Color for the high threshold: ex \"#FF0000\""+ , Option ['n'] ["normal"] (ReqArg NormalColor "color number" ) "Color for the normal threshold: ex \"#00FF00\""+ , Option ['l'] ["low"] (ReqArg LowColor "color number" ) "Color for the low threshold: ex \"#0000FF\""+ , Option ['t'] ["template"] (ReqArg Template "output template" ) "Output template."+ , Option ['p'] ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width."+ , Option ['m'] ["minwidth"] (ReqArg MinWidth "minimum width" ) "Minimum field width"+ , Option ['M'] ["maxwidth"] (ReqArg MaxWidth "maximum width" ) "Maximum field width"+ , Option ['w'] ["width"] (ReqArg Width "fixed width" ) "Fixed field width"+ , Option ['c'] ["padchars"] (ReqArg PadChars "padding chars" ) "Characters to use for padding"+ , Option ['a'] ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right"+ , Option ['b'] ["bback"] (ReqArg BarBack "bar background" ) "Characters used to draw bar backgrounds"+ , Option ['f'] ["bfore"] (ReqArg BarFore "bar foreground" ) "Characters used to draw bar foregrounds"+ , Option ['W'] ["bwidth"] (ReqArg BarWidth "bar width" ) "Bar width" ] -doArgs :: [String] +doArgs :: [String] -> ([String] -> Monitor String) -> Monitor String doArgs args action =@@ -138,6 +179,7 @@ doConfigOptions [] = io $ return () doConfigOptions (o:oo) = do let next = doConfigOptions oo+ nz s = let x = read s in max 0 x case o of High h -> setConfigValue (read h) high >> next Low l -> setConfigValue (read l) low >> next@@ -145,6 +187,16 @@ NormalColor nc -> setConfigValue (Just nc) normalColor >> next LowColor lc -> setConfigValue (Just lc) lowColor >> next Template t -> setConfigValue t template >> next+ PercentPad p -> setConfigValue (nz p) ppad >> next+ MinWidth mn -> setConfigValue (nz mn) minWidth >> next+ MaxWidth mx -> setConfigValue (nz mx) maxWidth >> next+ Width w -> setConfigValue (nz w) minWidth >>+ setConfigValue (nz w) maxWidth >> next+ PadChars pc -> setConfigValue pc padChars >> next+ PadAlign pa -> setConfigValue (isPrefixOf "r" pa) padRight >> next+ BarBack bb -> setConfigValue bb barBack >> next+ BarFore bf -> setConfigValue bf barFore >> next+ BarWidth bw -> setConfigValue (nz bw) barWidth >> next runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO () runM args conf action r cb = do go@@ -165,7 +217,7 @@ -- $parsers runP :: Parser [a] -> String -> IO [a]-runP p i = +runP p i = do case (parse p "" i) of Left _ -> return [] Right x -> return x@@ -193,7 +245,7 @@ } <|> return ("<" ++ s ++ " not found!>") skipTillString :: String -> Parser String-skipTillString s = +skipTillString s = manyTill skipRestOfLine $ string s -- | Parses the output template string@@ -203,7 +255,7 @@ ; com <- templateCommandParser ; ss <- nonPlaceHolder ; return (s, com, ss)- } + } where nonPlaceHolder = liftM concat . many $ (many1 $ noneOf "<") <|> colorSpec@@ -238,14 +290,14 @@ do t <- getConfigValue template s <- io $ runP templateParser t e <- getConfigValue export- let m = Map.fromList . zip e $ l - return $ combine m s + let m = Map.fromList . zip e $ l+ return $ combine m s -- | Given a finite "Map" and a parsed templatet produces the -- | resulting output string. combine :: Map.Map String String -> [(String, String, String)] -> String combine _ [] = []-combine m ((s,ts,ss):xs) = +combine m ((s,ts,ss):xs) = s ++ str ++ ss ++ combine m xs where str = Map.findWithDefault err ts m err = "<" ++ ts ++ " not found!>"@@ -255,7 +307,7 @@ type Pos = (Int, Int) takeDigits :: Int -> Float -> Float-takeDigits d n = +takeDigits d n = fromIntegral ((round (n * fact)) :: Int) / fact where fact = 10 ^ d @@ -263,13 +315,37 @@ showDigits d n = showFFloat (Just d) n "" -floatToPercent :: Float -> String-floatToPercent n = - showDigits 0 (n * 100) ++ "%"+showWithUnits :: Int -> Int -> Float -> String+showWithUnits d n x+ | x < 0 = "-" ++ showWithUnits d n (-x)+ | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n+ | x <= 1024 = showDigits d (x/1024) ++ units (n+1)+ | otherwise = showWithUnits d (n+1) (x/1024)+ where units = (!!) ["B", "K", "M", "G", "T"] +padString :: Int -> Int -> String -> Bool -> String -> String+padString mnw mxw pad pr s =+ let len = length s+ rmin = if mnw == 0 then 1 else mnw+ rmax = if mxw == 0 then max len rmin else mxw+ (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin)+ rlen = min (max rmn len) rmx+ in if rlen < len then+ take rlen s+ else let ps = take (rlen - len) (cycle pad)+ in if pr then s ++ ps else ps ++ s++floatToPercent :: Float -> Monitor String+floatToPercent n =+ do pad <- getConfigValue ppad+ pc <- getConfigValue padChars+ pr <- getConfigValue padRight+ let p = showDigits 0 (n * 100)+ return $ padString pad pad pc pr p ++ "%"+ stringParser :: Pos -> B.ByteString -> String stringParser (x,y) =- B.unpack . li x . B.words . li y . B.lines + B.unpack . li x . B.words . li y . B.lines where li i l | length l > i = l !! i | otherwise = B.empty @@ -281,20 +357,54 @@ Just c -> return $ "<fc=" ++ c ++ ">" ++ str ++ "</fc>" +showWithPadding :: String -> Monitor String+showWithPadding s =+ do mn <- getConfigValue minWidth+ mx <- getConfigValue maxWidth+ p <- getConfigValue padChars+ pr <- getConfigValue padRight+ return $ padString mn mx p pr s++colorizeString :: (Num a, Ord a) => a -> String -> Monitor String+colorizeString x s = do+ h <- getConfigValue high+ l <- getConfigValue low+ let col = setColor s+ [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low+ head $ [col highColor | x > hh ] +++ [col normalColor | x > ll ] +++ [col lowColor | True]+ showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String-showWithColors f x =- do h <- getConfigValue high- l <- getConfigValue low- let col = setColor $ f x- [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++- [col normalColor | x > ll ] ++- [col lowColor | True]+showWithColors f x = showWithPadding (f x) >>= colorizeString x +showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String+showWithColors' str v = showWithColors (const str) v++showPercentsWithColors :: [Float] -> Monitor [String]+showPercentsWithColors fs =+ do fstrs <- mapM floatToPercent fs+ zipWithM (showWithColors . const) fstrs (map (*100) fs)++showPercentBar :: Float -> Float -> Monitor String+showPercentBar v x = do+ bb <- getConfigValue barBack+ bf <- getConfigValue barFore+ bw <- getConfigValue barWidth+ let len = min bw $ round (fromIntegral bw * x)+ s <- colorizeString v (take len $ cycle bf)+ return $ s ++ (take (bw - len) $ cycle bb)++showLogBar :: Float -> Float -> Monitor String+showLogBar f v = do+ h <- fromIntegral `fmap` getConfigValue high+ bw <- fromIntegral `fmap` getConfigValue barWidth+ showPercentBar v $ f + (logBase 10 (v / h)) / bw+ -- $threads doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])-doActionTwiceWithDelay delay action = +doActionTwiceWithDelay delay action = do v1 <- newMVar [] forkIO $! getData action v1 0 v2 <- newMVar []
Plugins/Monitors/CoreCommon.hs view
@@ -25,19 +25,23 @@ -- Function checks the existence of first file specified by pattern and if the -- file doesn't exists failure message is shown, otherwise the data retrieval -- is performed.-checkedDataRetrieval :: String -> String -> String -> String -> Double -> Monitor String-checkedDataRetrieval failureMessage dir file pattern divisor = do+checkedDataRetrieval :: (Num a, Ord a, Show a) =>+ String -> String -> String -> String -> (Double -> a)+ -> Monitor String+checkedDataRetrieval failureMessage dir file pattern trans = do exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file] case exists of False -> return failureMessage- True -> retrieveData dir file pattern divisor+ True -> retrieveData dir file pattern trans -- |--- Function retrieves data from files in directory dir specified by pattern.--- String values are converted to double and adjusted with divisor. Final array--- is processed by template parser function and returned as monitor string.-retrieveData :: String -> String -> String -> Double -> Monitor String-retrieveData dir file pattern divisor = do+-- Function retrieves data from files in directory dir specified by+-- pattern. String values are converted to double and 'trans' applied+-- to each one. Final array is processed by template parser function+-- and returned as monitor string.+retrieveData :: (Num a, Ord a, Show a) =>+ String -> String -> String -> (Double -> a) -> Monitor String+retrieveData dir file pattern trans = do count <- io $ dirCount dir pattern contents <- io $ mapM getGuts $ files count values <- mapM (showWithColors show) $ map conversion contents@@ -50,5 +54,5 @@ && isDigit (last s)) files count = map (\i -> concat [dir, "/", pattern, show i, "/", file]) [0 .. count - 1]- conversion = (/divisor) . (read :: String -> Double)+ conversion = trans . (read :: String -> Double)
Plugins/Monitors/CoreTemp.hs view
@@ -37,5 +37,5 @@ pattern = "coretemp." divisor = 1e3 :: Double failureMessage = "CoreTemp: N/A"- checkedDataRetrieval failureMessage dir file pattern divisor+ checkedDataRetrieval failureMessage dir file pattern (/divisor)
Plugins/Monitors/Cpu.hs view
@@ -3,7 +3,7 @@ -- Module : Plugins.Monitors.Cpu -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE)--- +-- -- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> -- Stability : unstable -- Portability : unportable@@ -20,7 +20,7 @@ cpuConfig :: IO MConfig cpuConfig = mkMConfig "Cpu: <total>" -- template- ["total","user","nice","system","idle"] -- available replacements+ ["bar","total","user","nice","system","idle"] -- available replacements cpuData :: IO [Float] cpuData = do s <- B.readFile "/proc/stat"@@ -31,23 +31,23 @@ map read . map B.unpack . tail . B.words . flip (!!) 0 . B.lines parseCPU :: IO [Float]-parseCPU = +parseCPU = do (a,b) <- doActionTwiceWithDelay 750000 cpuData let dif = zipWith (-) b a tot = foldr (+) 0 dif percent = map (/ tot) dif return percent -formatCpu :: [Float] -> Monitor [String] +formatCpu :: [Float] -> Monitor [String] formatCpu [] = return [""]-formatCpu x =- do let f s = floatToPercent (s / 100)- t = foldr (+) 0 $ take 3 x- list = t:x- mapM (showWithColors f) . map (* 100) $ list+formatCpu xs = do+ let t = foldr (+) 0 $ take 3 xs+ b <- showPercentBar (100 * t) t+ ps <- showPercentsWithColors (t:xs)+ return (b:ps) runCpu :: [String] -> Monitor String runCpu _ = do c <- io $ parseCPU l <- formatCpu c- parseTemplate l + parseTemplate l
Plugins/Monitors/CpuFreq.hs view
@@ -36,5 +36,5 @@ pattern = "cpu" divisor = 1e6 :: Double failureMessage = "CpuFreq: N/A"- checkedDataRetrieval failureMessage dir file pattern divisor+ checkedDataRetrieval failureMessage dir file pattern (/divisor)
+ Plugins/Monitors/Disk.hs view
@@ -0,0 +1,137 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Disk+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Disk usage and throughput monitors for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Disk ( diskUConfig, runDiskU+ , diskIOConfig, runDiskIO+ ) where++import Plugins.Monitors.Common+import StatFS++import Control.Monad (zipWithM)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (isPrefixOf, find, intercalate)++diskIOConfig :: IO MConfig+diskIOConfig = mkMConfig "" ["total", "read", "write",+ "totalbar", "readbar", "writebar"]++diskUConfig :: IO MConfig+diskUConfig = mkMConfig ""+ ["size", "free", "used", "freep", "usedp", "freebar", "usedbar"]++type DevName = String+type Path = String++mountedDevices :: [String] -> IO [(DevName, Path)]+mountedDevices req = do+ s <- B.readFile "/etc/mtab"+ return (parse s)+ where+ parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines+ firstTwo (a:b:_) = (B.unpack a, B.unpack b)+ firstTwo _ = ("", "")+ isDev (d, p) = "/dev/" `isPrefixOf` d &&+ (p `elem` req || drop 5 d `elem` req)+ undev (d, f) = (drop 5 d, f)++diskData :: IO [(DevName, [Float])]+diskData = do+ s <- B.readFile "/proc/diskstats"+ let extract ws = (head ws, map read (tail ws))+ return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)++mountedData :: [DevName] -> IO [(DevName, [Float])]+mountedData devs = do+ (dt, dt') <- doActionTwiceWithDelay 750000 diskData+ return $ map (parseDev (zipWith diff dt' dt)) devs+ where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)++parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])+parseDev dat dev =+ case find ((==dev) . fst) dat of+ Nothing -> (dev, [0, 0, 0])+ Just (_, xs) ->+ let rSp = speed (xs !! 2) (xs !! 3)+ wSp = speed (xs !! 6) (xs !! 7)+ sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7)+ speed x t = if t == 0 then 0 else 500 * x / t+ dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0]+ in (dev, dat')++fsStats :: String -> IO [Integer]+fsStats path = do+ stats <- getFileSystemStats path+ case stats of+ Nothing -> return [-1, -1, -1]+ Just f -> let tot = fsStatByteCount f+ free = fsStatBytesAvailable f+ used = fsStatBytesUsed f+ in return [tot, free, used]++speedToStr :: Float -> String+speedToStr = showWithUnits 2 1++sizeToStr :: Integer -> String+sizeToStr = showWithUnits 3 0 . fromIntegral++findTempl :: DevName -> Path -> [(String, String)] -> String+findTempl dev path disks =+ case find devOrPath disks of+ Just (_, t) -> t+ Nothing -> ""+ where devOrPath (d, _) = d == dev || d == path++devTemplates :: [(String, String)]+ -> [(DevName, Path)]+ -> [(DevName, [Float])]+ -> [(String, [Float])]+devTemplates disks mounted dat =+ map (\(d, p) -> (findTempl d p disks, findData d)) mounted+ where findData dev = case find ((==dev) . fst) dat of+ Nothing -> [0, 0, 0]+ Just (_, xs) -> xs++runDiskIO' :: (String, [Float]) -> Monitor String+runDiskIO' (tmp, xs) = do+ s <- mapM (showWithColors speedToStr) xs+ b <- mapM (showLogBar 0.8) xs+ setConfigValue tmp template+ parseTemplate $ s ++ b++runDiskIO :: [(String, String)] -> [String] -> Monitor String+runDiskIO disks _ = do+ mounted <- io $ mountedDevices (map fst disks)+ dat <- io $ mountedData (map fst mounted)+ strs <- mapM runDiskIO' $ devTemplates disks mounted dat+ return $ intercalate " " strs++runDiskU' :: String -> String -> Monitor String+runDiskU' tmp path = do+ setConfigValue tmp template+ fstats <- io $ fsStats path+ let strs = map sizeToStr fstats+ freep = (fstats !! 1) * 100 `div` head fstats+ fr = fromIntegral freep / 100+ s <- zipWithM showWithColors' strs [100, freep, 100 - freep]+ sp <- showPercentsWithColors [fr, 1 - fr]+ fb <- showPercentBar (fromIntegral freep) fr+ ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr)+ parseTemplate $ s ++ sp ++ [fb, ub]++runDiskU :: [(String, String)] -> [String] -> Monitor String+runDiskU disks _ = do+ devs <- io $ mountedDevices (map fst disks)+ strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs+ return $ intercalate " " strs
+ Plugins/Monitors/MPD.hs view
@@ -0,0 +1,92 @@+-----------------------------------------------------------------------------+-- |+-- 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 ) where++import Plugins.Monitors.Common+import System.Console.GetOpt+import qualified Network.MPD as M++mpdConfig :: IO MConfig+mpdConfig = mkMConfig "MPD: <state>"+ [ "bar", "state", "statei", "volume", "length"+ , "lapsed", "plength"+ , "name", "artist", "composer", "performer"+ , "album", "title", "track", "trackno", "file", "genre"+ ]++data MOpts = MOpts {mPlaying :: String, mStopped :: String, mPaused :: String}++defaultOpts :: MOpts+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 }) "") ""+ ]++runMPD :: [String] -> Monitor String+runMPD args = do+ status <- io $ M.withMPD M.status+ song <- io $ M.withMPD M.currentSong+ opts <- io $ mopts args+ let (b, s) = parseMPD status song opts+ bs <- showPercentBar (100 * b) b+ parseTemplate (bs:s)++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+ -> (Float, [String])+parseMPD (Left e) _ _ = (0, show e:repeat "")+parseMPD (Right st) song opts = (b, [ss, si, vol, len, lap, plen] ++ sf)+ where s = M.stState st+ ss = show s+ si = stateGlyph s opts+ vol = int2Str $ M.stVolume st+ (lap, len) = (showTime p, showTime t)+ (p, t) = M.stTime st+ b = if t > 0 then fromIntegral p / fromIntegral t else 0+ plen = int2Str $ M.stPlaylistLength st+ sf = parseSong song++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) -> [String]+parseSong (Left _) = repeat ""+parseSong (Right Nothing) = repeat ""+parseSong (Right (Just s)) =+ [ M.sgName s, M.sgArtist s, M.sgComposer s, M.sgPerformer s+ , M.sgAlbum s, M.sgTitle s, track, trackno, M.sgFilePath s, M.sgGenre s]+ where (track, trackno) = (int2Str t, int2Str tn)+ (t, tn) = M.sgTrack s++showTime :: Integer -> String+showTime t = int2Str minutes ++ ":" ++ int2Str seconds+ where minutes = t `div` 60+ seconds = t `mod` 60++int2Str :: (Num a, Ord a) => a -> String+int2Str x = if x < 10 then '0':sx else sx where sx = show x
Plugins/Monitors/Mem.hs view
@@ -3,7 +3,7 @@ -- Module : Plugins.Monitors.Mem -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE)--- +-- -- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> -- Stability : unstable -- Portability : unportable@@ -12,36 +12,47 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Mem where+module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where import Plugins.Monitors.Common memConfig :: IO MConfig memConfig = mkMConfig "Mem: <usedratio>% (<cache>M)" -- template- ["total", "free", "buffer", -- available replacements- "cache", "rest", "used", "usedratio"]+ ["usedbar", "freebar", "usedratio", "total", -- available replacements+ "free", "buffer", "cache", "rest", "used"] fileMEM :: IO String fileMEM = readFile "/proc/meminfo" parseMEM :: IO [Float] parseMEM =- do file <- fileMEM + do file <- fileMEM let content = map words $ take 4 $ lines file [total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content rest = free + buffer + cache used = total - rest- usedratio = used * 100 / total- return [total, free, buffer, cache, rest, used, usedratio]+ usedratio = used / total+ return [usedratio, total, free, buffer, cache, rest, used] +totalMem :: IO Float+totalMem = fmap ((*1024) . (!!1)) parseMEM++usedMem :: IO Float+usedMem = fmap ((*1024) . (!!6)) parseMEM+ formatMem :: [Float] -> Monitor [String]-formatMem x =- do let f n = showDigits 0 n- mapM (showWithColors f) x+formatMem (r:xs) =+ do let f = showDigits 0+ rr = 100 * r+ ub <- showPercentBar rr r+ fb <- showPercentBar (100 - rr) (1 - r)+ s <- mapM (showWithColors f) (rr:xs)+ return (ub:fb:s)+formatMem _ = return $ replicate 9 "N/A" runMem :: [String] -> Monitor String runMem _ =- do m <- io $ parseMEM+ do m <- io parseMEM l <- formatMem m- parseTemplate l + parseTemplate l
+ Plugins/Monitors/MultiCpu.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.MultiCpu+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A multi-cpu monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where++import Plugins.Monitors.Common+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (isPrefixOf)++multiCpuConfig :: IO MConfig+multiCpuConfig =+ mkMConfig "Cpu: <total>"+ [ k ++ n | n <- "" : map show [0 :: Int ..]+ , k <- ["bar","total","user","nice","system","idle"]]+++cpuData :: IO [[Float]]+cpuData = do s <- B.readFile "/proc/stat"+ return $ cpuParser s++cpuParser :: B.ByteString -> [[Float]]+cpuParser = map parseList . cpuLists+ where cpuLists = takeWhile isCpu . map B.words . B.lines+ isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w+ isCpu _ = False+ parseList = map (read . B.unpack) . tail++parseCpuData :: IO [[Float]]+parseCpuData =+ do (as, bs) <- doActionTwiceWithDelay 950000 cpuData+ let p0 = zipWith percent bs as+ return p0++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++formatMultiCpus :: [[Float]] -> Monitor [String]+formatMultiCpus [] = showPercentsWithColors $ replicate 15 0.0+formatMultiCpus xs = fmap concat $ mapM formatCpu xs++formatCpu :: [Float] -> Monitor [String]+formatCpu xs+ | length xs < 4 = showPercentsWithColors $ replicate 6 0.0+ | otherwise = let t = foldr (+) 0 $ take 3 xs+ in do b <- showPercentBar (100 * t) t+ ps <- showPercentsWithColors (t:xs)+ return (b:ps)++runMultiCpu :: [String] -> Monitor String+runMultiCpu _ =+ do c <- io parseCpuData+ l <- formatMultiCpus c+ parseTemplate l
Plugins/Monitors/Net.hs view
@@ -29,14 +29,14 @@ netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>|<tx>" -- template- ["dev", "rx", "tx"] -- available replacements+ ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements -- Given a list of indexes, take the indexed elements from a list. getNElements :: [Int] -> [a] -> [a] getNElements ns as = map (as!!) ns -- Split into words, with word boundaries indicated by the given predicate.--- Drops delimiters. Duplicates 'Data.List.Split.wordsBy'. +-- Drops delimiters. Duplicates 'Data.List.Split.wordsBy'. -- -- > map (wordsBy (`elem` " :")) ["lo:31174097 31174097", "eth0: 43598 88888"] --@@ -62,17 +62,19 @@ netParser = map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines -formatNet :: Float -> Monitor String-formatNet d =- showWithColors f d- where f s = showDigits 1 s ++ "Kb"+formatNet :: Float -> Monitor (String, String)+formatNet d = do+ b <- showLogBar 0.8 d+ x <- showWithColors f d+ return (x, b)+ where f s = showDigits 1 s ++ "Kb" printNet :: NetDev -> Monitor String printNet nd = case nd of- ND d r t -> do rx <- formatNet r- tx <- formatNet t- parseTemplate [d,rx,tx]+ ND d r t -> do (rx, rb) <- formatNet r+ (tx, tb) <- formatNet t+ parseTemplate [d,rx,tx,rb,tb] NA -> return "N/A" parseNET :: String -> IO [NetDev]
Plugins/Monitors/Swap.hs view
@@ -3,7 +3,7 @@ -- Module : Plugins.Monitors.Swap -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE)--- +-- -- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> -- Stability : unstable -- Portability : unportable@@ -30,7 +30,7 @@ parseMEM = do file <- fileMEM let li i l- | l /= [] = (head l) !! i + | l /= [] = (head l) !! i | otherwise = B.empty fs s l | l == [] = False@@ -41,17 +41,16 @@ free = get_data "SwapFree:" st return [tot, (tot - free), free, (tot - free) / tot] -formatSwap :: [Float] -> Monitor [String] +formatSwap :: [Float] -> Monitor [String] formatSwap x = do let f1 n = showDigits 2 n- f2 n = floatToPercent n (hd, tl) = splitAt 3 x firsts <- mapM (showWithColors f1) hd- lasts <- mapM (showWithColors f2) tl+ lasts <- showPercentsWithColors (map (/100) tl) return $ firsts ++ lasts runSwap :: [String] -> Monitor String runSwap _ = do m <- io $ parseMEM l <- formatSwap m- parseTemplate l + parseTemplate l
+ Plugins/Monitors/Top.hs view
@@ -0,0 +1,156 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Top+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Process activity and memory consumption monitors+--+-----------------------------------------------------------------------------++{-# LANGUAGE ForeignFunctionInterface #-}++module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where++import Plugins.Monitors.Common+import Plugins.Monitors.Mem (usedMem)++import Control.Exception (SomeException, handle)+import System.Directory+import System.FilePath+import System.IO+import System.Posix.Unistd (getSysVar, SysVar(ClockTick))+import Foreign.C.Types+import Data.List (sortBy)+import Data.Ord (comparing)+import Data.IORef+import Data.Time.Clock++import Data.IntMap (IntMap)+import qualified Data.IntMap as M++intStrs :: [String]+intStrs = map show [(1::Int) ..]++topMemConfig :: IO MConfig+topMemConfig = mkMConfig "<both1>"+ [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]]++topConfig :: IO MConfig+topConfig = mkMConfig "<both1>"+ ("no" : [ k ++ n | n <- intStrs+ , k <- [ "name", "cpu", "both"+ , "mname", "mem", "mboth"]])++foreign import ccall "unistd.h getpagesize"+ c_getpagesize :: CInt++pageSize :: Float+pageSize = fromIntegral c_getpagesize / 1024++showInfo :: String -> String -> Float -> Monitor [String]+showInfo nm sms mms = do+ mnw <- getConfigValue maxWidth+ mxw <- getConfigValue minWidth+ let lsms = length sms+ nmw = mnw - lsms - 1+ nmx = mxw - lsms - 1+ rnm = if nmw > 0 then padString nmw nmx " " True nm else nm+ mstr <- showWithColors' sms mms+ both <- showWithColors' (rnm ++ " " ++ sms) mms+ return [nm, mstr, both]++processes :: IO [FilePath]+processes = fmap (filter isPid) (getDirectoryContents "/proc")+ where isPid = all (`elem` ['0'..'9'])++getProcessData :: FilePath -> IO [String]+getProcessData pidf =+ handle (const (return []) :: SomeException -> IO [String])+ (withFile ("/proc" </> pidf </> "stat") ReadMode readWords)+ where readWords = fmap words . hGetLine++handleProcesses :: ([String] -> a) -> IO [a]+handleProcesses f =+ fmap (foldr (\p ps -> if p == [] then ps else f p : ps) [])+ (processes >>= mapM getProcessData)++processName :: [String] -> String+processName = drop 1 . init . (!!1)++sortTop :: [(a, Float)] -> [(a, Float)]+sortTop = sortBy (flip (comparing snd))++type Meminfo = (String, Float)++meminfo :: [String] -> Meminfo+meminfo fs = (processName fs, pageSize * read (fs!!23))++meminfos :: IO [Meminfo]+meminfos = handleProcesses meminfo++showMeminfo :: Float -> Meminfo -> Monitor [String]+showMeminfo scale (nm, rss) =+ showInfo nm (showWithUnits 2 1 rss) (rss / (1024 * scale))++runTopMem :: [String] -> Monitor String+runTopMem _ = do+ ps <- io meminfos+ pstr <- mapM (showMeminfo 1) $ sortTop ps+ parseTemplate $ concat pstr++type Pid = Int+type TimeInfo = (String, Float)+type TimeEntry = (Pid, TimeInfo)+type Times = IntMap TimeInfo+type TimesRef = IORef (Times, UTCTime)++timeMemEntry :: [String] -> (TimeEntry, Meminfo)+timeMemEntry fs = ((p, (n, t)), (n, r))+ where p = read (head fs)+ n = processName fs+ t = read (fs!!13) + read (fs!!14)+ (_, r) = meminfo fs++timeMemEntries :: IO [(TimeEntry, Meminfo)]+timeMemEntries = handleProcesses timeMemEntry++timeMemInfos :: IO (Times, [Meminfo], Int)+timeMemInfos =+ fmap (\x -> (M.fromList . map fst $ x, map snd x, length x)) timeMemEntries++combineTimeInfos :: Times -> Times -> Times+combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0+ where timeDiff (n, x1) (_, x0) = (n, x1 - x0)++topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [Meminfo])+topProcesses tref scale = do+ (t1, mis, len) <- timeMemInfos+ c1 <- getCurrentTime+ atomicModifyIORef tref $ \(t0, c0) ->+ let scx = (fromRational . toRational $ diffUTCTime c1 c0) * scale / 100+ ts = M.elems $ combineTimeInfos t0 t1+ nts = map (\(nm, t) -> (nm, t / scx)) ts+ in ((t1, c1), (len, sortTop nts, sortTop mis))++showTimeInfo :: TimeInfo -> Monitor [String]+showTimeInfo (n, t) = showInfo n (showDigits 1 t) t++runTop :: TimesRef -> Float -> Float -> [String] -> Monitor String+runTop tref scale mscale _ = do+ (no, ps, ms) <- io $ topProcesses tref scale+ pstr <- mapM showTimeInfo ps+ mstr <- mapM (showMeminfo mscale) ms+ parseTemplate $! show no : concat (zipWith (++) pstr mstr)++startTop :: [String] -> Int -> (String -> IO ()) -> IO ()+startTop a r cb = do+ cr <- getSysVar ClockTick+ m <- usedMem+ c <- getCurrentTime+ tref <- newIORef (M.empty, c)+ runM a topConfig (runTop tref (fromIntegral cr) m) r cb
+ Plugins/Monitors/Wireless.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Wireless+-- Copyright : (c) Jose Antonio Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose Antonio Ortega Ruiz+-- Stability : unstable+-- Portability : unportable+--+-- A monitor reporting ESSID and link quality for wireless interfaces+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where++import Plugins.Monitors.Common+import IWlib++wirelessConfig :: IO MConfig+wirelessConfig =+ mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar"]++runWireless :: [String] -> Monitor String+runWireless (iface:_) = do+ wi <- io $ getWirelessInfo iface+ let essid = wiEssid wi+ qlty = wiQuality wi+ fqlty = fromIntegral qlty+ e = if essid == "" then "N/A" else essid+ q <- if qlty >= 0 then showWithColors show qlty else showWithPadding ""+ qb <- showPercentBar fqlty (fqlty / 100)+ parseTemplate [e, q, qb]+runWireless _ = return ""
README view
@@ -131,13 +131,18 @@ : Default font color. `position`-: Top, TopW, Bottom, BottomW or Static (with x, y, width and height).+: Top, TopW, TopSize, Bottom, BottomW, BottomSize or Static (with x, y,+ width and height). : TopW and BottomW take 2 arguments: an alignment parameter (L for left, C for centered, R for Right) and an integer for the percentage width xmobar window will have in respect to the screen width. +: TopSize and BottomSize take 3 arguments: an alignment parameter, an+ integer for the percentage width, and an integer for the minimum pixel+ height that the xmobar window will have.+ : For example: : position = BottomW C 75@@ -258,8 +263,9 @@ [xmobar] comes with some plugins, providing a set of system monitors, a standard input reader, an Unix named pipe reader, and a configurable date plugin. These plugins install the following internal commands:-`Weather`, `Network`, `Memory`, `Swap`, `Cpu`, `Battery`, `Thermal`,-`CpuFreq`, `CoreTemp`, `Date`, `StdinReader`, `CommandReader`, and `PipeReader`.+`Weather`, `Network`, `Memory`, `Swap`, `Cpu`, `MultiCpu`, `Battery`,+`Thermal`, `CpuFreq`, `CoreTemp`, `Date`, `StdinReader`,+`CommandReader`, and `PipeReader`. To remove them see below Installing/Removing a Plugin @@ -291,15 +297,29 @@ - aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%` - Args: the argument list (see below) - Variables that can be used with the `-t`/`--template` argument:- `dev`, `rx`, `tx`+ `dev`, `rx`, `tx`, `rxbar`, `txbar` - Default template: `<dev>: <rx>|<tx>` +`Wireless Interface Args RefreshRate`++- aliases to the interface name with the suffix "wi": thus, `Wirelss+ "wlan0" []` can be used as `%wlan0wi%`+- Args: the argument list (see below)+- Variables that can be used with the `-t`/`--template` argument:+ `essid`, `quality`, `qualitybar`+- Default template: `<essid> <quality>`+- Requires the C library libiw (part of the wireless tools suite)+ installed in your system. In addition, to activate this plugin you+ must pass --flags="with_iwlib" to "runhaskell Setup configure"+ or to "cabal install".+ `Memory Args RefreshRate` - aliases to `memory` - Args: the argument list (see below) - Variables that can be used with the `-t`/`--template` argument:- `total`, `free`, `buffer`, `cache`, `rest`, `used`, `usedratio`+ `total`, `free`, `buffer`, `cache`, `rest`, `used`,+ `usedratio`, `usedbar`, `freebar` - Default template: `Mem: <usedratio>% (<cache>M)` `Swap Args RefreshRate`@@ -315,29 +335,83 @@ - aliases to `cpu` - Args: the argument list (see below) - Variables that can be used with the `-t`/`--template` argument:- `total`, `user`, `nice`, `system`, `idle`+ `total`, `bar`, `user`, `nice`, `system`, `idle` - Default template: `Cpu: <total>` +`MultiCpu Args RefreshRate`++- aliases to `multicpu`+- Args: the argument list (see below)+- Variables that can be used with the `-t`/`--template` argument:+ `total`, `bar`, `user`, `nice`, `system`, `idle`,+ `total0`, `bar0`, `user0`, `nice0`, `system0`, `idle0`, ...+- Default template: `Cpu: <total>`+ `Battery Args RefreshRate` - aliases to `battery` - Args: the argument list (see below) - Variables that can be used with the `-t`/`--template` argument:- `left`+ `left`, `leftbar`, `status` - Default template: `Batt: <left>` `BatteryP Dirs Args RefreshRate` - aliases to `battery`-- Files: list of directories in /proc/acpi/battery/ directory where to+- Dirs: list of directories in /proc/acpi/battery/ directory where to look for the `state` and `info` files. Example: `["BAT0","BAT1","BAT2"]`. Only the first 3 directories will be searched. - Args: the argument list (see below) - Variables that can be used with the `-t`/`--template` argument:- `left`+ `left`, `leftbar`, `status` - Default template: `Batt: <left>` +`TopProc Args RefreshRate`++- aliases to `top`+- Args: the argument list (see below)+- Variables that can be used with the `-t`/`--template` argument:+ `no`, `name1`, `cpu1`, `both1`, `mname1`, `mem1`, `mboth1`,+ `name2`, `cpu2`, `both2`, `mname2`, `mem2`, `mboth2`, ...+- Default template: `<both1>`+- Displays the name and cpu/mem usage of running processes (`bothn`+ and `mboth` display both, and is useful to specify an overall+ maximum and/or minimum width, using the `-m`/`-M` arguments. `no` gives+ the total number of processes.++`TopMem Args RefreshRate`++- aliases to `topmem`+- Args: the argument list (see below)+- Variables that can be used with the `-t`/`--template` argument:+ `name1`, `mem1`, `both1`, `name2`, `mem2`, `both2`, ...+- Default template: `<both1>`+- Displays the name and RSS (resident memory size) of running+ processes (`bothn` displays both, and is useful to specify an+ overall maximum and/or minimum width, using the `-m`/`-M` arguments.++`DiskU Disks Args RefreshRate`++- aliases to `disku`+- Disks: list of pairs of the form (device or mount point, template),+ where the template can contain <size>, <free>, <used>, <freep> or+ <usedp>, <freebar> or <usedbar> for total, free, used, free+ percentage and used percentage of the given file system capacity. Example:+ `[("/", "<used>/<size>"), ("sdb1", "<usedbar>")]`+- Args: the argument list (see above). `-t`/`--template` is ignored.+- Default template: none (you must specify a template for each file system).++`DiskIO Disks Args RefreshRate`++- aliases to `diskio`+- Disks: list of pairs of the form (device or mount point, template),+ where the template can contain <total>, <read>, <write> for total,+ read and write speed, respectively. Example:+ `[("/", "<read> <write>"), ("sdb1", "<total>")]`+- Args: the argument list (see above). `-t`/`--template` is ignored.+- Default template: none (you must specify a template for each file system).+ `Thermal Zone Args RefreshRate` - aliases to the Zone: so `Zone "THRM" []` can be used in template as `%THRM%`@@ -369,13 +443,60 @@ - This monitor requires coretemp module to be loaded in kernel - Example: `Run CoreTemp ["-t","Temp:\<core0\>|\<core1\>C","-L","40","-H","60","-l","lightblue","-n","gray90","-h","red"] 50` ++`MPD Args RefreshRate`++- aliases to `mpd`+- Args: the argument list (see below). In addition you can provide+ `-P`, `-S` and `-Z`, with an string argument, to represent the+ playing, stopped and paused states in the `statei` template field.+- Variables that can be used with the `-t`/`--template` argument:+ `bar`, `state`, `statei`, `volume`, `length`+ `lapsed`, `plength`+ `name`, `artist`, `composer`, `performer`+ `album`, `title`, `track`, `file`, `genre`+- Default template: `MPD: <state>`+- Example:+ Run MPD ["-t",+ "<composer> <title> (<album>) <track>/<plength> <statei> ",+ "--", "-P", ">>", "-Z", "|", "-S", "><"] 10+ Note that you need "--" to separate regular monitor options from+ MPD's specific ones.+- This monitor will only be compiled if you ask for it using the+ `with_mpd` flag. It needs libmpd 4.1 or later (available on Hackage).+ `Mail Args` - aliases to `Mail` - Args: list of maildirs in form [("name1","path1"),("name2","path2")] - This plugin requires INOTIFY support in Linux kernel and hinotify library.- To activate, pass --flags="with_inotify" to "runhaskell Setup configure".+ To activate, pass --flags="with_inotify" to "runhaskell Setup configure"+ or to "cabal install". +`MBox Mboxes Opts Alias`++- Mboxes a list of mbox files of the form [("name", "path", "color")],+ where name is the displayed name, path the absolute or relative (to+ BaseDir) path of the mbox file, and color the color to use to display+ the mail count (use an empty string for the default).+- Opts is a possibly empty list of options, as flags. Possible values:+ -a --all (no arg) Show all mailboxes, even if empty.+ -d dir --dir dir a string giving the base directory where mbox files with+ a relative path live.+ -p prefix --prefix prefix a string giving a prefix for the list+ of displayed mail coints+ -s suffix --suffix suffix a string giving a suffix for the list+ of displayed mail coints+- This plugin requires INOTIFY support in Linux kernel and hinotify library.+ To activate, pass --flags="with_inotify" to "runhaskell Setup+ configure" or to "cabal install".+- Example:+ `Run MBox [("I ", "inbox", "red"), ("O ", "/foo/mbox", "")]+ ["-d", "/var/mail/", "-p", " "] "mbox"`+ will look for mails in `/var/mail/inbox` and `/foo/mbox`, and will put+ a space in front of the printed string (when it's not empty); it+ can be used in the template with the alias `mbox`.+ ### Monitor Plugins Commands Arguments These are the arguments that can be used for internal commands in the@@ -386,6 +507,15 @@ -h color number --high=color number Color for the high threshold: es "#FF0000" -n color number --normal=color number Color for the normal threshold: es "#00FF00" -l color number --low=color number Color for the low threshold: es "#0000FF"+ -p number --ppad=number Pad percentages to given width+ -m number --minwidth=number Minimum field width+ -M number --maxwidth=number Maximum field width+ -w number --width=number Fixed field width+ -c chars --padchars=chars Chars used (cyclically) for padding+ -a ["r" or "l"] --align=["r" or "l"] Pad alignment (right/left)+ -b chars --bback=chars Chars used to draw bar backgrounds (default ":")+ -f chars --bfore=chars Chars used to draw bar foregrounds (default "#")+ -W number --bwidth=number Bar width (default 10) -t output template --template=output template Output template of the command. Commands' arguments must be set as a list. Es:
+ StatFS.hsc view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module : StatFS+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A binding to C's statvfs(2)+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+++module StatFS ( FileSystemStats(..), getFileSystemStats ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Data.ByteString (useAsCString)+import Data.ByteString.Char8 (pack)++#include <sys/vfs.h>++data FileSystemStats = FileSystemStats {+ fsStatBlockSize :: Integer+ -- ^ Optimal transfer block size.+ , fsStatBlockCount :: Integer+ -- ^ Total data blocks in file system.+ , fsStatByteCount :: Integer+ -- ^ Total bytes in file system.+ , fsStatBytesFree :: Integer+ -- ^ Free bytes in file system.+ , fsStatBytesAvailable :: Integer+ -- ^ Free bytes available to non-superusers.+ , fsStatBytesUsed :: Integer+ -- ^ Bytes used.+ } deriving (Show, Eq)++data CStatfs++foreign import ccall unsafe "sys/vfs.h statfs64"+ c_statfs :: CString -> Ptr CStatfs -> IO CInt++toI :: CLong -> Integer+toI = toInteger++getFileSystemStats :: String -> IO (Maybe FileSystemStats)+getFileSystemStats path =+ allocaBytes (#size struct statfs) $ \vfs ->+ useAsCString (pack path) $ \cpath -> do+ res <- c_statfs cpath vfs+ if res == -1 then return Nothing+ else do+ bsize <- (#peek struct statfs, f_bsize) vfs+ bcount <- (#peek struct statfs, f_blocks) vfs+ bfree <- (#peek struct statfs, f_bfree) vfs+ bavail <- (#peek struct statfs, f_bavail) vfs+ let bpb = toI bsize+ return $ Just FileSystemStats+ { fsStatBlockSize = bpb+ , fsStatBlockCount = toI bcount+ , fsStatByteCount = toI bcount * bpb+ , fsStatBytesFree = toI bfree * bpb+ , fsStatBytesAvailable = toI bavail * bpb+ , fsStatBytesUsed = toI (bcount - bfree) * bpb+ }
Xmobar.hs view
@@ -147,13 +147,11 @@ setPosition p rs ht = case p' of Top -> (Rectangle rx ry rw h , True)- TopW L i -> (Rectangle rx ry (nw i) h , True)- TopW R i -> (Rectangle (right i) ry (nw i) h , True)- TopW C i -> (Rectangle (center i) ry (nw i) h , True)+ TopW a i -> (Rectangle (ax a i ) ry (nw i ) h , True)+ TopSize a i ch -> (Rectangle (ax a i ) ry (nw i ) (mh ch), True) Bottom -> (Rectangle rx ny rw h , True)- BottomW L i -> (Rectangle rx ny (nw i) h , True)- BottomW R i -> (Rectangle (right i) ny (nw i) h , True)- BottomW C i -> (Rectangle (center i) ny (nw i) h , True)+ BottomW a i -> (Rectangle (ax a i ) ny (nw i ) h , True)+ BottomSize a i ch -> (Rectangle (ax a i ) ny (nw i ) (mh ch), True) Static cx cy cw ch -> (Rectangle (fi cx ) (fi cy) (fi cw) (fi ch), True) OnScreen _ p'' -> setPosition p'' [scr] ht where@@ -164,9 +162,13 @@ center i = rx + (fi $ div (remwid i) 2) right i = rx + (fi $ remwid i) remwid i = rw - pw (fi i)+ ax L = const rx+ ax R = right+ ax C = center pw i = rw * (min 100 i) `div` 100 nw = fi . pw . fi h = fi ht+ mh h' = max (fi h') h safeIndex i = lookup i . zip [0..] @@ -192,8 +194,10 @@ OnScreen _ p' -> getStrutValues r p' rwh Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] Static _ _ _ _ -> getStaticStrutValues p rwh where st = fi y + fi h sb = rwh - fi y
xmobar.cabal view
@@ -1,11 +1,11 @@ name: xmobar-version: 0.10+version: 0.11 homepage: http://code.haskell.org/~arossato/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. .- Inspired by the Ion3 status bar, it supports similar features, - like dynamic color management, output templates, and extensibility + Inspired by the Ion3 status bar, it supports similar features,+ like dynamic color management, output templates, and extensibility through plugins. category: System license: BSD3@@ -26,25 +26,36 @@ flag with_utf8 description: With UTF-8 support.+ default: True flag with_inotify description: inotify support (modern Linux only). Required for the Mail plugin. default: False +flag with_iwlib+ description: wireless info support. Required for the Wireless plugin, needs iwlib installed.+ default: False++flag with_mpd+ description: mpd support. Needs libmpd installed.+ default: False+ executable xmobar main-is: Main.hs- other-Modules: Xmobar, Config, Parsers, Commands, XUtil, Runnable, Plugins+ other-modules: Xmobar, Config, Parsers, Commands, XUtil, StatFS, Runnable, Plugins ghc-prof-options: -prof -auto-all if true- ghc-options: -funbox-strict-fields -Wall+ ghc-options: -funbox-strict-fields -Wall if impl (ghc == 6.10.1) && arch (x86_64)- ghc-options: -O0+ ghc-options: -O0 if impl (ghc >= 6.12.1)- ghc-options: -fno-warn-unused-do-bind+ ghc-options: -fno-warn-unused-do-bind + build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm, time+ if flag(small_base) build-depends: base == 4.*, containers, process, old-time, old-locale, bytestring, directory @@ -52,15 +63,22 @@ build-depends: base < 3 if flag(with_xft)- build-depends: utf8-string, X11-xft >= 0.2- cpp-options: -DXFT+ build-depends: utf8-string, X11-xft >= 0.2+ cpp-options: -DXFT - if flag(with_utf8) && impl (ghc < 6.12.1)- build-depends: utf8-string- cpp-options: -DUTF8+ if flag(with_utf8)+ build-depends: utf8-string+ cpp-options: -DUTF8 if flag(with_inotify)- build-depends: hinotify- cpp-options: -DINOTIFY+ build-depends: hinotify+ cpp-options: -DINOTIFY - build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm+ if flag(with_iwlib)+ extra-libraries: iw+ other-modules: IWlib+ cpp-options: -DIWLIB++ if flag(with_mpd)+ build-depends: libmpd > 0.4+ cpp-options: -DLIBMPD