diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-12-21 02:36:35 +0100 | 
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-12-21 02:36:35 +0100 | 
| commit | e3853a9cb2a9a2cffa174d1334e2ca8ba610f151 (patch) | |
| tree | 13aa04faea320afe85636e23686280386c1c2910 /src/Plugins/Monitors | |
| parent | 598bfe5deeff079280e8513c55dc7bda3e8cf9a0 (diff) | |
| download | xmobar-e3853a9cb2a9a2cffa174d1334e2ca8ba610f151.tar.gz xmobar-e3853a9cb2a9a2cffa174d1334e2ca8ba610f151.tar.bz2 | |
Haskell sources moved to src/ to unclutter toplevel
Diffstat (limited to 'src/Plugins/Monitors')
| -rw-r--r-- | src/Plugins/Monitors/Batt.hs | 165 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Common.hs | 446 | ||||
| -rw-r--r-- | src/Plugins/Monitors/CoreCommon.hs | 59 | ||||
| -rw-r--r-- | src/Plugins/Monitors/CoreTemp.hs | 41 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Cpu.hs | 53 | ||||
| -rw-r--r-- | src/Plugins/Monitors/CpuFreq.hs | 43 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Disk.hs | 137 | ||||
| -rw-r--r-- | src/Plugins/Monitors/MPD.hs | 115 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Mem.hs | 59 | ||||
| -rw-r--r-- | src/Plugins/Monitors/MultiCpu.hs | 81 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Net.hs | 96 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Swap.hs | 55 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Thermal.hs | 42 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Top.hs | 179 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Uptime.hs | 50 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Weather.hs | 141 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Wireless.hs | 34 | 
17 files changed, 1796 insertions, 0 deletions
| diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs new file mode 100644 index 0000000..11b2d6c --- /dev/null +++ b/src/Plugins/Monitors/Batt.hs @@ -0,0 +1,165 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Batt +-- Copyright   :  (c) Andrea Rossato, 2010 Petr Rockai, 2010 Jose A Ortega +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A battery monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where + +import qualified Data.ByteString.Lazy.Char8 as B +import Plugins.Monitors.Common +import System.Posix.Files (fileExist) +import System.Console.GetOpt + +data BattOpts = BattOpts +  { onString :: String +  , offString :: String +  , posColor :: Maybe String +  , lowWColor :: Maybe String +  , mediumWColor :: Maybe String +  , highWColor :: Maybe String +  , lowThreshold :: Float +  , highThreshold :: Float +  } + +defaultOpts :: BattOpts +defaultOpts = BattOpts +  { onString = "On" +  , offString = "Off" +  , posColor = Nothing +  , lowWColor = Nothing +  , mediumWColor = Nothing +  , highWColor = Nothing +  , lowThreshold = -12 +  , highThreshold = -10 +  } + +options :: [OptDescr (BattOpts -> BattOpts)] +options = +  [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" +  , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") "" +  , Option "p" ["positive"] (ReqArg (\x o -> o { posColor = Just x }) "") "" +  , Option "l" ["low"] (ReqArg (\x o -> o { lowWColor = Just x }) "") "" +  , Option "m" ["medium"] (ReqArg (\x o -> o { mediumWColor = Just x }) "") "" +  , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") "" +  , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") "" +  , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" +  ] + +parseOpts :: [String] -> IO BattOpts +parseOpts argv = +  case getOpt Permute options argv of +    (o, _, []) -> return $ foldr id defaultOpts o +    (_, _, errs) -> ioError . userError $ concat errs + +data Result = Result Float Float Float String | NA + +base :: String +base = "/sys/class/power_supply" + +battConfig :: IO MConfig +battConfig = mkMConfig +       "Batt: <watts>, <left>% / <timeleft>" -- template +       ["leftbar", "left", "acstatus", "timeleft", "watts"] -- replacements + +data Files = Files +  { f_full :: String +  , f_now :: String +  , f_voltage :: String +  , f_current :: String +  } | NoFiles + +data Battery = Battery +  { full :: Float +  , now :: Float +  , voltage :: Float +  , current :: Float +  } + +batteryFiles :: String -> IO Files +batteryFiles bat = +  do is_charge <- fileExist $ prefix ++ "/charge_now" +     is_energy <- fileExist $ prefix ++ "/energy_now" +     return $ case (is_charge, is_energy) of +       (True, _) -> files "/charge" +       (_, True) -> files "/energy" +       _ -> NoFiles +  where prefix = base ++ "/" ++ bat +        files ch = Files { f_full = prefix ++ ch ++ "_full" +                         , f_now = prefix ++ ch ++ "_now" +                         , f_current = prefix ++ "/current_now" +                         , f_voltage = prefix ++ "/voltage_now" } + +haveAc :: IO (Maybe Bool) +haveAc = do know <- fileExist $ base ++ "/AC/online" +            if know +               then do s <- B.unpack `fmap` catRead (base ++ "/AC/online") +                       return $ Just $ s == "1\n" +               else return Nothing + +readBattery :: Files -> IO Battery +readBattery NoFiles = return $ Battery 0 0 0 0 +readBattery files = +    do a <- grab $ f_full files -- microwatthours +       b <- grab $ f_now files +       c <- grab $ f_voltage files -- microvolts +       d <- grab $ f_current files -- microwatts (huh!) +       return $ Battery (3600 * a / 1000000) -- wattseconds +                        (3600 * b / 1000000) -- wattseconds +                        (c / 1000000) -- volts +                        (d / c) -- amperes +    where grab = fmap (read . B.unpack) . catRead + +readBatteries :: BattOpts -> [Files] -> IO Result +readBatteries opts bfs = +    do bats <- mapM readBattery (take 3 bfs) +       ac' <- haveAc +       let ac = (ac' == Just True) +           sign = if ac then 1 else -1 +           left = sum (map now bats) / sum (map full bats) +           watts = sign * sum (map voltage bats) * sum (map current bats) +           time = if watts == 0 then 0 else sum $ map time' bats -- negate sign +           time' b = (if ac then full b - now b else now b) / (sign * watts) +           acstr = case ac' of +             Nothing -> "?" +             Just True -> onString opts +             Just False -> offString opts +       return $ if isNaN left then NA else Result left watts time acstr + +runBatt :: [String] -> Monitor String +runBatt = runBatt' ["BAT0","BAT1","BAT2"] + +runBatt' :: [String] -> [String] -> Monitor String +runBatt' bfs args = do +  opts <- io $ parseOpts args +  c <- io $ readBatteries opts =<< mapM batteryFiles bfs +  case c of +    Result x w t s -> +      do l <- fmtPercent x +         parseTemplate (l ++ s:[fmtTime $ floor t, fmtWatts w opts]) +    NA -> return "N/A" + where fmtPercent :: Float -> Monitor [String] +       fmtPercent x = do +         p <- showPercentWithColors x +         b <- showPercentBar (100 * x) x +         return [b, p] +       fmtWatts x o = color x o $ showDigits 1 x ++ "W" +       fmtTime :: Integer -> String +       fmtTime x = hours ++ ":" ++ if length minutes == 2 +                                   then minutes else '0' : minutes +         where hours = show (x `div` 3600) +               minutes = show ((x `mod` 3600) `div` 60) +       maybeColor Nothing _ = "" +       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) diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs new file mode 100644 index 0000000..cc1a6a7 --- /dev/null +++ b/src/Plugins/Monitors/Common.hs @@ -0,0 +1,446 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Common +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- Utilities for creating monitors for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Common ( +                       -- * Monitors +                       -- $monitor +                         Monitor +                       , MConfig (..) +                       , Opts (..) +                       , setConfigValue +                       , getConfigValue +                       , mkMConfig +                       , runM +                       , io +                       -- * Parsers +                       -- $parsers +                       , runP +                       , skipRestOfLine +                       , getNumbers +                       , getNumbersAsString +                       , getAllBut +                       , getAfterString +                       , skipTillString +                       , parseTemplate +                       -- ** String Manipulation +                       -- $strings +                       , padString +                       , showWithPadding +                       , showWithColors +                       , showWithColors' +                       , showPercentWithColors +                       , showPercentsWithColors +                       , showPercentBar +                       , showLogBar +                       , showWithUnits +                       , takeDigits +                       , showDigits +                       , floatToPercent +                       , parseFloat +                       , parseInt +                       , stringParser +                       -- * Threaded Actions +                       -- $thread +                       , doActionTwiceWithDelay +                       , catRead +                       ) where + + +import Control.Concurrent +import Control.Monad.Reader +import qualified Data.ByteString.Lazy.Char8 as B +import Data.IORef +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 Plugins +-- $monitor + +type Monitor a = ReaderT MConfig IO a + +data MConfig = +    MC { normalColor :: IORef (Maybe String) +       , low         :: IORef Int +       , lowColor    :: IORef (Maybe String) +       , high        :: IORef Int +       , highColor   :: IORef (Maybe String) +       , template    :: IORef String +       , export      :: IORef [String] +       , ppad        :: IORef Int +       , minWidth    :: IORef Int +       , maxWidth    :: IORef Int +       , padChars    :: IORef String +       , padRight    :: IORef Bool +       , barBack     :: IORef String +       , barFore     :: IORef String +       , barWidth    :: IORef Int +       , useSuffix   :: IORef Bool +       } + +-- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' +type Selector a = MConfig -> IORef a + +sel :: Selector a -> Monitor a +sel s = +    do hs <- ask +       liftIO $ readIORef (s hs) + +mods :: Selector a -> (a -> a) -> Monitor () +mods s m = +    do v <- ask +       io $ modifyIORef (s v) m + +setConfigValue :: a -> Selector a -> Monitor () +setConfigValue v s = +       mods s (\_ -> v) + +getConfigValue :: Selector a -> Monitor a +getConfigValue = sel + +mkMConfig :: String +          -> [String] +          -> IO MConfig +mkMConfig tmpl exprts = +    do lc <- newIORef Nothing +       l  <- newIORef 33 +       nc <- newIORef Nothing +       h  <- newIORef 66 +       hc <- newIORef Nothing +       t  <- newIORef tmpl +       e  <- newIORef exprts +       p  <- newIORef 0 +       mn <- newIORef 0 +       mx <- newIORef 0 +       pc <- newIORef " " +       pr <- newIORef False +       bb <- newIORef ":" +       bf <- newIORef "#" +       bw <- newIORef 10 +       up <- newIORef False +       return $ MC nc l lc h hc t e p mn mx pc pr bb bf bw up + +data Opts = HighColor String +          | NormalColor String +          | LowColor String +          | Low String +          | High String +          | Template String +          | PercentPad String +          | MinWidth String +          | MaxWidth String +          | Width String +          | PadChars String +          | PadAlign String +          | BarBack String +          | BarFore String +          | BarWidth String +          | UseSuffix 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 "S"  ["suffix"]   (ReqArg UseSuffix "True/False"      )  "Use % to display percents or other suffixes." +    , 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] +       -> ([String] -> Monitor String) +       -> Monitor String +doArgs args action = +    case getOpt Permute options args of +      (o, n, [])   -> do doConfigOptions o +                         action n +      (_, _, errs) -> return (concat errs) + +doConfigOptions :: [Opts] -> Monitor () +doConfigOptions [] = io $ return () +doConfigOptions (o:oo) = +    do let next = doConfigOptions oo +           nz s = let x = read s in max 0 x +           bool = (`elem` ["True", "true", "Yes", "yes", "On", "on"]) +       (case o of +          High        h -> setConfigValue (read h) high +          Low         l -> setConfigValue (read l) low +          HighColor   c -> setConfigValue (Just c) highColor +          NormalColor c -> setConfigValue (Just c) normalColor +          LowColor    c -> setConfigValue (Just c) lowColor +          Template    t -> setConfigValue t template +          PercentPad  p -> setConfigValue (nz p) ppad +          MinWidth    w -> setConfigValue (nz w) minWidth +          MaxWidth    w -> setConfigValue (nz w) maxWidth +          Width       w -> setConfigValue (nz w) minWidth >> +                           setConfigValue (nz w) maxWidth +          PadChars    s -> setConfigValue s padChars +          PadAlign    a -> setConfigValue ("r" `isPrefixOf` a) padRight +          BarBack     s -> setConfigValue s barBack +          BarFore     s -> setConfigValue s barFore +          BarWidth    w -> setConfigValue (nz w) barWidth +          UseSuffix   u -> setConfigValue (bool u) useSuffix) >> next + +runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int +        -> (String -> IO ()) -> IO () +runM args conf action r cb = handle (cb . showException) loop +  where ac = doArgs args action +        loop = conf >>= runReaderT ac >>= cb >> tenthSeconds r >> loop + +showException :: SomeException -> String +showException = ("error: "++) . show . flip asTypeOf undefined + +io :: IO a -> Monitor a +io = liftIO + +-- $parsers + +runP :: Parser [a] -> String -> IO [a] +runP p i = +    case parse p "" i of +      Left _ -> return [] +      Right x  -> return x + +getAllBut :: String -> Parser String +getAllBut s = +    manyTill (noneOf s) (char $ head s) + +getNumbers :: Parser Float +getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n + +getNumbersAsString :: Parser String +getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n + +skipRestOfLine :: Parser Char +skipRestOfLine = +    do many $ noneOf "\n\r" +       newline + +getAfterString :: String -> Parser String +getAfterString s = +    do { try $ manyTill skipRestOfLine $ string s +       ; manyTill anyChar newline +       } <|> return "" + +skipTillString :: String -> Parser String +skipTillString s = +    manyTill skipRestOfLine $ string s + +-- | Parses the output template string +templateStringParser :: Parser (String,String,String) +templateStringParser = +    do { s <- nonPlaceHolder +       ; com <- templateCommandParser +       ; ss <- nonPlaceHolder +       ; return (s, com, ss) +       } +    where +      nonPlaceHolder = liftM concat . many $ +                       many1 (noneOf "<") <|> colorSpec + +-- | Recognizes color specification and returns it unchanged +colorSpec :: Parser String +colorSpec = try (string "</fc>") <|> try ( +            do string "<fc=" +               s <- many1 (alphaNum <|> char ',' <|> char '#') +               char '>' +               return $ "<fc=" ++ s ++ ">") + +-- | Parses the command part of the template string +templateCommandParser :: Parser String +templateCommandParser = +    do { char '<' +       ; com <- many $ noneOf ">" +       ; char '>' +       ; return com +       } + +-- | Combines the template parsers +templateParser :: Parser [(String,String,String)] +templateParser = many templateStringParser --"%") + +-- | Takes a list of strings that represent the values of the exported +-- keys. The strings are joined with the exported keys to form a map +-- to be combined with 'combine' to the parsed template. Returns the +-- final output of the monitor. +parseTemplate :: [String] -> Monitor String +parseTemplate l = +    do t <- getConfigValue template +       s <- io $ runP templateParser t +       e <- getConfigValue export +       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) = +    s ++ str ++ ss ++ combine m xs +        where str = Map.findWithDefault err ts m +              err = "<" ++ ts ++ " not found!>" + +-- $strings + +type Pos = (Int, Int) + +takeDigits :: Int -> Float -> Float +takeDigits d n = +    fromIntegral (round (n * fact) :: Int) / fact +  where fact = 10 ^ d + +showDigits :: (RealFloat a) => Int -> a -> String +showDigits d n = showFFloat (Just d) n "" + +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 + +parseFloat :: String -> Float +parseFloat s = case readFloat s of +  (v, _):_ -> v +  _ -> 0 + +parseInt :: String -> Int +parseInt s = case readDec s of +  (v, _):_ -> v +  _ -> 0 + +floatToPercent :: Float -> Monitor String +floatToPercent n = +  do pad <- getConfigValue ppad +     pc <- getConfigValue padChars +     pr <- getConfigValue padRight +     up <- getConfigValue useSuffix +     let p = showDigits 0 (n * 100) +         ps = if up then "%" else "" +     return $ padString pad pad pc pr p ++ ps + +stringParser :: Pos -> B.ByteString -> String +stringParser (x,y) = +     B.unpack . li x . B.words . li y . B.lines +    where li i l | length l > i = l !! i +                 | otherwise    = B.empty + +setColor :: String -> Selector (Maybe String) -> Monitor String +setColor str s = +    do a <- getConfigValue s +       case a of +            Nothing -> return str +            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 = showWithPadding (f x) >>= colorizeString x + +showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String +showWithColors' str = showWithColors (const str) + +showPercentsWithColors :: [Float] -> Monitor [String] +showPercentsWithColors fs = +  do fstrs <- mapM floatToPercent fs +     zipWithM (showWithColors . const) fstrs (map (*100) fs) + +showPercentWithColors :: Float -> Monitor String +showPercentWithColors f = liftM head $ showPercentsWithColors [f] + +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 +  l <- fromIntegral `fmap` getConfigValue low +  bw <- fromIntegral `fmap` getConfigValue 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 + +-- $threads + +doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a]) +doActionTwiceWithDelay delay action = +    do v1 <- newMVar [] +       forkIO $! getData action v1 0 +       v2 <- newMVar [] +       forkIO $! getData action v2 delay +       threadDelay (delay `div` 3 * 4) +       a <- readMVar v1 +       b <- readMVar v2 +       return (a,b) + +getData :: IO a -> MVar a -> Int -> IO () +getData action var d = +    do threadDelay d +       s <- action +       modifyMVar_ var (\_ -> return $! s) + +catRead :: FilePath -> IO B.ByteString +catRead file = B.pack `fmap` readProcess "/bin/cat" [file] "" diff --git a/src/Plugins/Monitors/CoreCommon.hs b/src/Plugins/Monitors/CoreCommon.hs new file mode 100644 index 0000000..80e7700 --- /dev/null +++ b/src/Plugins/Monitors/CoreCommon.hs @@ -0,0 +1,59 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.CoreCommon +-- Copyright   :  (c) Juraj Hercek +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- The common part for cpu core monitors (e.g. cpufreq, coretemp) +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.CoreCommon where + +import Plugins.Monitors.Common +import System.Posix.Files (fileExist) +import System.IO (withFile, IOMode(ReadMode), hGetLine) +import System.Directory +import Data.Char (isDigit) +import Data.List (isPrefixOf) + +-- | +-- 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 :: (Num a, Ord a, Show a) => +                        String -> String -> String -> String -> (Double -> a) +                        -> (a -> String) -> Monitor String +checkedDataRetrieval failureMessage dir file pattern trans fmt = do +    exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file] +    case exists of +         False  -> return failureMessage +         True   -> retrieveData dir file pattern trans fmt + +-- | +-- 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) -> (a -> String) -> +                Monitor String +retrieveData dir file pattern trans fmt = do +    count <- io $ dirCount dir pattern +    contents <- io $ mapM getGuts $ files count +    values <- mapM (showWithColors fmt) $ map conversion contents +    parseTemplate values +    where +        getGuts f = withFile f ReadMode hGetLine +        dirCount path str = getDirectoryContents path +                            >>= return . length +                                       . filter (\s -> str `isPrefixOf` s +                                                       && isDigit (last s)) +        files count = map (\i -> concat [dir, "/", pattern, show i, "/", file]) +                          [0 .. count - 1] +        conversion = trans . (read :: String -> Double) + diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs new file mode 100644 index 0000000..a24b284 --- /dev/null +++ b/src/Plugins/Monitors/CoreTemp.hs @@ -0,0 +1,41 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.CoreTemp +-- Copyright   :  (c) Juraj Hercek +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A core temperature monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.CoreTemp where + +import Plugins.Monitors.Common +import Plugins.Monitors.CoreCommon + +-- | +-- Core temperature default configuration. Default template contains only one +-- core temperature, user should specify custom template in order to get more +-- core frequencies. +coreTempConfig :: IO MConfig +coreTempConfig = mkMConfig +       "Temp: <core0>C" -- template +       (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available +                                                               -- replacements + +-- | +-- Function retrieves monitor string holding the core temperature +-- (or temperatures) +runCoreTemp :: [String] -> Monitor String +runCoreTemp _ = do +    let dir = "/sys/bus/platform/devices" +        file = "temp1_input" +        pattern = "coretemp." +        divisor = 1e3 :: Double +        failureMessage = "CoreTemp: N/A" +    checkedDataRetrieval failureMessage dir file pattern (/divisor) show + diff --git a/src/Plugins/Monitors/Cpu.hs b/src/Plugins/Monitors/Cpu.hs new file mode 100644 index 0000000..ab89246 --- /dev/null +++ b/src/Plugins/Monitors/Cpu.hs @@ -0,0 +1,53 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Cpu +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A cpu monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Cpu where + +import Plugins.Monitors.Common +import qualified Data.ByteString.Lazy.Char8 as B + +cpuConfig :: IO MConfig +cpuConfig = mkMConfig +       "Cpu: <total>%" +       ["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 (read . B.unpack) . tail . B.words . head . B.lines + +parseCPU :: IO [Float] +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 [] = return $ repeat "" +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 diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs new file mode 100644 index 0000000..4f01922 --- /dev/null +++ b/src/Plugins/Monitors/CpuFreq.hs @@ -0,0 +1,43 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.CpuFreq +-- Copyright   :  (c) Juraj Hercek +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A cpu frequency monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.CpuFreq where + +import Plugins.Monitors.Common +import Plugins.Monitors.CoreCommon + +-- | +-- Cpu frequency default configuration. Default template contains only one +-- core frequency, user should specify custom template in order to get more +-- cpu frequencies. +cpuFreqConfig :: IO MConfig +cpuFreqConfig = mkMConfig +       "Freq: <cpu0>" -- template +       (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available +                                                              -- replacements + +-- | +-- Function retrieves monitor string holding the cpu frequency (or +-- frequencies) +runCpuFreq :: [String] -> Monitor String +runCpuFreq _ = do +    let dir = "/sys/devices/system/cpu" +        file = "cpufreq/scaling_cur_freq" +        pattern = "cpu" +        divisor = 1e6 :: Double +        failureMessage = "CpuFreq: N/A" +        fmt x | x < 1     = show (round (x * 1000) :: Integer) ++ "MHz" +              | otherwise = showDigits 1 x ++ "GHz" +    checkedDataRetrieval failureMessage dir file pattern (/divisor) fmt + diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs new file mode 100644 index 0000000..f3a7a2a --- /dev/null +++ b/src/Plugins/Monitors/Disk.hs @@ -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 diff --git a/src/Plugins/Monitors/MPD.hs b/src/Plugins/Monitors/MPD.hs new file mode 100644 index 0000000..daf0ed4 --- /dev/null +++ b/src/Plugins/Monitors/MPD.hs @@ -0,0 +1,115 @@ +----------------------------------------------------------------------------- +-- | +-- 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", "remaining", "plength", "ppos", "file" +              , "name", "artist", "composer", "performer" +              , "album", "title", "track", "genre" +              ] + +data MOpts = MOpts +  { mPlaying :: String +  , mStopped :: String +  , mPaused :: String +  , mHost :: String +  , mPort :: Integer +  , mPassword :: String +  } + +defaultOpts :: MOpts +defaultOpts = MOpts +  { mPlaying = ">>" +  , mStopped = "><" +  , mPaused = "||" +  , mHost = "127.0.0.1" +  , mPort = 6600 +  , mPassword = "" +  } + +options :: [OptDescr (MOpts -> MOpts)] +options = +  [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") "" +  , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") "" +  , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") "" +  , Option "h" ["host"] (ReqArg (\x o -> o { mHost = x }) "") "" +  , Option "p" ["port"] (ReqArg (\x o -> o { mPort = read x }) "") "" +  , Option "x" ["password"] (ReqArg (\x o -> o { mPassword = x }) "") "" +  ] + +runMPD :: [String] -> Monitor String +runMPD args = do +  opts <- io $ mopts args +  let mpd = M.withMPDEx (mHost opts) (mPort opts) (mPassword opts) +  status <- io $ mpd M.status +  song <- io $ mpd M.currentSong +  s <- parseMPD status song opts +  parseTemplate 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 +            -> Monitor [String] +parseMPD (Left e) _ _ = return $ show e:repeat "" +parseMPD (Right st) song opts = do +  songData <- parseSong song +  bar <- showPercentBar (100 * b) b +  return $ [bar, 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 +        [lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)] +        b = if t > 0 then realToFrac $ p / fromIntegral t else 0 +        plen = int2str $ M.stPlaylistLength st +        ppos = maybe "" (int2str . (+1)) $ M.stSongPos st + +stateGlyph :: M.State -> MOpts -> String +stateGlyph s o = +  case s of +    M.Playing -> mPlaying o +    M.Paused -> mPaused o +    M.Stopped -> mStopped o + +parseSong :: M.Response (Maybe M.Song) -> Monitor [String] +parseSong (Left _) = return $ repeat "" +parseSong (Right Nothing) = return $ repeat "" +parseSong (Right (Just s)) = +  let join [] = "" +      join (x:xs) = foldl (\a o -> a ++ ", " ++ o) x xs +      str sel = maybe "" join (M.sgGet sel s) +      sels = [ M.Name, M.Artist, M.Composer, M.Performer +             , M.Album, M.Title, M.Track, M.Genre ] +      fields = M.sgFilePath s : map str sels +  in mapM showWithPadding fields + +showTime :: Integer -> String +showTime t = int2str minutes ++ ":" ++ int2str seconds +  where minutes = t `div` 60 +        seconds = t `mod` 60 + +int2str :: (Num a, Ord a) => a -> String +int2str x = if x < 10 then '0':sx else sx where sx = show x diff --git a/src/Plugins/Monitors/Mem.hs b/src/Plugins/Monitors/Mem.hs new file mode 100644 index 0000000..5c55ee2 --- /dev/null +++ b/src/Plugins/Monitors/Mem.hs @@ -0,0 +1,59 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Mem +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A memory monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where + +import Plugins.Monitors.Common + +memConfig :: IO MConfig +memConfig = mkMConfig +       "Mem: <usedratio>% (<cache>M)" -- template +       ["usedbar", "freebar", "usedratio", "total", +        "free", "buffer", "cache", "rest", "used"]  -- available replacements + +fileMEM :: IO String +fileMEM = readFile "/proc/meminfo" + +parseMEM :: IO [Float] +parseMEM = +    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 / 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 (r:xs) = +    do let f = showDigits 0 +           rr = 100 * r +       ub <- showPercentBar rr r +       fb <- showPercentBar (100 - rr) (1 - r) +       rs <- showPercentWithColors r +       s <- mapM (showWithColors f) xs +       return (ub:fb:rs:s) +formatMem _ = return $ replicate 9 "N/A" + +runMem :: [String] -> Monitor String +runMem _ = +    do m <- io parseMEM +       l <- formatMem m +       parseTemplate l diff --git a/src/Plugins/Monitors/MultiCpu.hs b/src/Plugins/Monitors/MultiCpu.hs new file mode 100644 index 0000000..535196a --- /dev/null +++ b/src/Plugins/Monitors/MultiCpu.hs @@ -0,0 +1,81 @@ +----------------------------------------------------------------------------- +-- | +-- 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, transpose, unfoldr) + +multiCpuConfig :: IO MConfig +multiCpuConfig = +  mkMConfig "Cpu: <total>%" $ +            map ("auto" ++) monitors +            ++ [ k ++ n | n <- "" : map show [0 :: Int ..] +                        , k <- monitors] +    where monitors = ["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 [] = return $ repeat "" +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) + +splitEvery :: (Eq a) => Int -> [a] -> [[a]] +splitEvery n = unfoldr (\x -> if x == [] +                              then Nothing +                              else Just $ splitAt n x) + +groupData :: [String] -> [[String]] +groupData = transpose . tail . splitEvery 6 + +formatAutoCpus :: [String] -> Monitor [String] +formatAutoCpus [] = return $ replicate 6 "" +formatAutoCpus xs = return $ map unwords (groupData xs) + +runMultiCpu :: [String] -> Monitor String +runMultiCpu _ = +  do c <- io parseCpuData +     l <- formatMultiCpus c +     a <- formatAutoCpus l +     parseTemplate (a ++ l) diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs new file mode 100644 index 0000000..d9cd534 --- /dev/null +++ b/src/Plugins/Monitors/Net.hs @@ -0,0 +1,96 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Net +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A net device monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Net (netConfig, runNet) where + +import Plugins.Monitors.Common +import qualified Data.ByteString.Lazy.Char8 as B + +data NetDev = NA +            | ND { netDev :: String +                 , netRx :: Float +                 , netTx :: Float +                 } deriving (Eq,Show,Read) + +interval :: Int +interval = 500000 + +netConfig :: IO MConfig +netConfig = mkMConfig +    "<dev>: <rx>KB|<tx>KB"      -- template +    ["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'. +-- +-- > map (wordsBy (`elem` " :")) ["lo:31174097 31174097", "eth0:  43598 88888"] +-- +-- will become @[["lo","31174097","31174097"], ["eth0","43598","88888"]]@ +wordsBy :: (a -> Bool) -> [a] -> [[a]] +wordsBy f s = case dropWhile f s of +    [] -> [] +    s' -> w : wordsBy f s'' where (w, s'') = break f s' + +readNetDev :: [String] -> NetDev +readNetDev [] = NA +readNetDev xs = +    ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2)) +       where r s | s == "" = 0 +                 | otherwise = read s / 1024 + +fileNET :: IO [NetDev] +fileNET = +    do f <- B.readFile "/proc/net/dev" +       return $ netParser f + +netParser :: B.ByteString -> [NetDev] +netParser = +    map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines + +formatNet :: Float -> Monitor (String, String) +formatNet d = do +    s <- getConfigValue useSuffix +    let str = if s then (++"Kb/s") . showDigits 1 else showDigits 1 +    b <- showLogBar 0.9 d +    x <- showWithColors str d +    return (x, b) + +printNet :: NetDev -> Monitor String +printNet nd = +    case nd of +         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] +parseNET nd = +    do (a,b) <- doActionTwiceWithDelay interval fileNET +       let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval) +           diffRate (da,db) = ND (netDev da) +                              (netRate netRx da db) +                              (netRate netTx da db) +       return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b + +runNet :: [String] -> Monitor String +runNet nd = +    do pn <- io $ parseNET $ head nd +       n <- case pn of +              [x] -> return x +              _ -> return NA +       printNet n diff --git a/src/Plugins/Monitors/Swap.hs b/src/Plugins/Monitors/Swap.hs new file mode 100644 index 0000000..e466dbb --- /dev/null +++ b/src/Plugins/Monitors/Swap.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Swap +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A  swap usage monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Swap where + +import Plugins.Monitors.Common + +import qualified Data.ByteString.Lazy.Char8 as B + +swapConfig :: IO MConfig +swapConfig = mkMConfig +        "Swap: <usedratio>%"                    -- template +        ["usedratio", "total", "used", "free"] -- available replacements + +fileMEM :: IO B.ByteString +fileMEM = B.readFile "/proc/meminfo" + +parseMEM :: IO [Float] +parseMEM = +    do file <- fileMEM +       let li i l +               | l /= [] = head l !! i +               | otherwise = B.empty +           fs s l +               | 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 +           free = get_data "SwapFree:" st +       return [(tot - free) / tot, tot, tot - free, free] + +formatSwap :: [Float] -> Monitor [String] +formatSwap (r:xs) = +     do other <- mapM (showWithColors (showDigits 2)) xs +        ratio <- showPercentWithColors r +        return $ ratio:other +formatSwap _ = return $ replicate 4 "N/A" + +runSwap :: [String] -> Monitor String +runSwap _ = +    do m <- io parseMEM +       l <- formatSwap m +       parseTemplate l diff --git a/src/Plugins/Monitors/Thermal.hs b/src/Plugins/Monitors/Thermal.hs new file mode 100644 index 0000000..a3ffe6d --- /dev/null +++ b/src/Plugins/Monitors/Thermal.hs @@ -0,0 +1,42 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Thermal +-- Copyright   :  (c) Juraj Hercek +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A thermal monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Thermal where + +import qualified Data.ByteString.Lazy.Char8 as B +import Plugins.Monitors.Common +import System.Posix.Files (fileExist) + +-- | Default thermal configuration. +thermalConfig :: IO MConfig +thermalConfig = mkMConfig +       "Thm: <temp>C" -- template +       ["temp"]       -- available replacements + +-- | Retrieves thermal information. Argument is name of thermal directory in +-- \/proc\/acpi\/thermal_zone. Returns the monitor string parsed according to +-- template (either default or user specified). +runThermal :: [String] -> Monitor String +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 ] + diff --git a/src/Plugins/Monitors/Top.hs b/src/Plugins/Monitors/Top.hs new file mode 100644 index 0000000..e45210c --- /dev/null +++ b/src/Plugins/Monitors/Top.hs @@ -0,0 +1,179 @@ +----------------------------------------------------------------------------- +-- | +-- 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 Control.Exception (SomeException, handle) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.List (sortBy, foldl') +import Data.Ord (comparing) +import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) +import System.Directory (getDirectoryContents) +import System.FilePath ((</>)) +import System.IO (IOMode(ReadMode), hGetLine, withFile) +import System.Posix.Unistd (SysVar(ClockTick), getSysVar) + +import Foreign.C.Types + +maxEntries :: Int +maxEntries = 10 + +intStrs :: [String] +intStrs = map show [1..maxEntries] + +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 + +processes :: IO [FilePath] +processes = fmap (filter isPid) (getDirectoryContents "/proc") +  where isPid = (`elem` ['0'..'9']) . head + +getProcessData :: FilePath -> IO [String] +getProcessData pidf = +  handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords +  where readWords = fmap words . hGetLine +        ign = const (return []) :: SomeException -> IO [String] + +handleProcesses :: ([String] -> a) -> IO [a] +handleProcesses f = +  fmap (foldl' (\a p -> if length p < 15 then a else f p : a) []) +       (processes >>= mapM getProcessData) + +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] + +processName :: [String] -> String +processName = drop 1 . init . (!!1) + +sortTop :: [(String, Float)] -> [(String, Float)] +sortTop =  sortBy (flip (comparing snd)) + +type MemInfo = (String, Float) + +meminfo :: [String] -> MemInfo +meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) + +meminfos :: IO [MemInfo] +meminfos = handleProcesses meminfo + +showMemInfo :: Float -> MemInfo -> Monitor [String] +showMemInfo scale (nm, rss) = +  showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc) +  where sc = if scale > 0 then scale else 100 + +showMemInfos :: [MemInfo] -> Monitor [[String]] +showMemInfos ms = mapM (showMemInfo tm) ms +  where tm = sum (map snd ms) + +runTopMem :: [String] -> Monitor String +runTopMem _ = do +  mis <- io meminfos +  pstr <- showMemInfos (sortTop mis) +  parseTemplate $ concat pstr + +type Pid = Int +type TimeInfo = (String, Float) +type TimeEntry = (Pid, TimeInfo) +type Times = [TimeEntry] +type TimesRef = IORef (Times, UTCTime) + +timeMemEntry :: [String] -> (TimeEntry, MemInfo) +timeMemEntry fs = ((p, (n, t)), (n, r)) +  where p = parseInt (head fs) +        n = processName fs +        t = parseFloat (fs!!13) + parseFloat (fs!!14) +        (_, r) = meminfo fs + +timeMemEntries :: IO [(TimeEntry, MemInfo)] +timeMemEntries = handleProcesses timeMemEntry + +timeMemInfos :: IO (Times, [MemInfo], Int) +timeMemInfos = fmap res timeMemEntries +  where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) + +combine :: Times -> Times -> Times +combine _ [] = [] +combine [] ts = ts +combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs) +  | p0 == p1 && n0 == n1 = (p0, (n0, t1 - t0)) : combine ls rs +  | p0 <= p1 = combine ls r +  | otherwise = (p1, (n1, t1)) : combine l rs + +take' :: Int -> [a] -> [a] +take' m l = let !r = tk m l in length l `seq` r +  where tk 0 _ = [] +        tk _ [] = [] +        tk n (x:xs) = let !r = tk (n - 1) xs in x : r + +topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo]) +topProcesses tref scale = do +  (t0, c0) <- readIORef tref +  (t1, mis, len) <- timeMemInfos +  c1 <- getCurrentTime +  let scx = realToFrac (diffUTCTime c1 c0) * scale +      !scx' = if scx > 0 then scx else scale +      nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1) +      !t1' = take' (length t1) t1 +      !nts' = take' maxEntries (sortTop nts) +      !mis' = take' maxEntries (sortTop mis) +  writeIORef tref (t1', c1) +  return (len, nts', mis') + +showTimeInfo :: TimeInfo -> Monitor [String] +showTimeInfo (n, t) = showInfo n (showDigits 0 t) t + +showTimeInfos :: [TimeInfo] -> Monitor [[String]] +showTimeInfos = mapM showTimeInfo + +runTop :: TimesRef -> Float -> [String] -> Monitor String +runTop tref scale _ = do +  (no, ps, ms) <- io $ topProcesses tref scale +  pstr <- showTimeInfos ps +  mstr <- showMemInfos ms +  parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat "N/A" + +startTop :: [String] -> Int -> (String -> IO ()) -> IO () +startTop a r cb = do +  cr <- getSysVar ClockTick +  c <- getCurrentTime +  tref <- newIORef ([], c) +  let scale = fromIntegral cr / 100 +  _ <- topProcesses tref scale +  runM a topConfig (runTop tref scale) r cb diff --git a/src/Plugins/Monitors/Uptime.hs b/src/Plugins/Monitors/Uptime.hs new file mode 100644 index 0000000..8524bcc --- /dev/null +++ b/src/Plugins/Monitors/Uptime.hs @@ -0,0 +1,50 @@ +------------------------------------------------------------------------------ +-- | +-- Module      : Plugins.Monitors.Uptime +-- Copyright   : (c) 2010 Jose Antonio Ortega Ruiz +-- License     : BSD3-style (see LICENSE) +-- +-- Maintainer  : jao@gnu.org +-- Stability   : unstable +-- Portability : unportable +-- Created: Sun Dec 12, 2010 20:26 +-- +-- +-- Uptime +-- +------------------------------------------------------------------------------ + + +module Plugins.Monitors.Uptime (uptimeConfig, runUptime) where + +import Plugins.Monitors.Common + +import qualified Data.ByteString.Lazy.Char8 as B + +uptimeConfig :: IO MConfig +uptimeConfig = mkMConfig "Up <days>d <hours>h <minutes>m" +                         ["days", "hours", "minutes", "seconds"] + +readUptime :: IO Float +readUptime = +  fmap (read . B.unpack . head . B.words) (B.readFile "/proc/uptime") + +secsPerDay :: Integer +secsPerDay = 24 * 3600 + +uptime :: Monitor [String] +uptime = do +  t <- io readUptime +  u <- getConfigValue useSuffix +  let tsecs = floor t +      secs = tsecs `mod` secsPerDay +      days = tsecs `quot` secsPerDay +      hours = secs `quot` 3600 +      mins = (secs `mod` 3600) `div` 60 +      ss = secs `mod` 60 +      str x s = if u then show x ++ s else show x +  mapM (`showWithColors'` days) +       [str days "d", str hours "h", str mins "m", str ss "s"] + +runUptime :: [String] -> Monitor String +runUptime _ = uptime >>= parseTemplate diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs new file mode 100644 index 0000000..1277438 --- /dev/null +++ b/src/Plugins/Monitors/Weather.hs @@ -0,0 +1,141 @@ +----------------------------------------------------------------------------- +-- | +-- Module      :  Plugins.Monitors.Weather +-- Copyright   :  (c) Andrea Rossato +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- A weather monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Weather where + +import Plugins.Monitors.Common + +import Control.Monad (when) +import System.Process +import System.Exit +import System.IO + +import Text.ParserCombinators.Parsec + + +weatherConfig :: IO MConfig +weatherConfig = mkMConfig +       "<station>: <tempC>C, rh <rh>% (<hour>)" -- template +       ["station"                               -- available replacements +       , "stationState" +       , "year" +       , "month" +       , "day" +       , "hour" +       , "wind" +       , "visibility" +       , "skyCondition" +       , "tempC" +       , "tempF" +       , "dewPoint" +       , "rh" +       , "pressure" +       ] + +data WeatherInfo = +    WI { stationPlace :: String +       , stationState :: String +       , year         :: String +       , month        :: String +       , day          :: String +       , hour         :: String +       , wind         :: String +       , visibility   :: String +       , skyCondition :: String +       , tempC        :: Int +       , tempF        :: Int +       , dewPoint     :: String +       , humidity     :: Int +       , pressure     :: Int +       } deriving (Show) + +pTime :: Parser (String, String, String, String) +pTime = do y <- getNumbersAsString +           char '.' +           m <- getNumbersAsString +           char '.' +           d <- getNumbersAsString +           char ' ' +           (h:hh:mi:mimi) <- getNumbersAsString +           char ' ' +           return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) + +pTemp :: Parser (Int, Int) +pTemp = do let num = digit <|> char '-' <|> char '.' +           f <- manyTill num $ char ' ' +           manyTill anyChar $ char '(' +           c <- manyTill num $ char ' ' +           skipRestOfLine +           return $ (floor (read c :: Double), floor (read f :: Double)) + +pRh :: Parser Int +pRh = do s <- manyTill digit $ (char '%' <|> char '.') +         return $ read s + +pPressure :: Parser Int +pPressure = do manyTill anyChar $ char '(' +               s <- manyTill digit $ char ' ' +               skipRestOfLine +               return $ read s + +parseData :: Parser [WeatherInfo] +parseData = +    do st <- getAllBut "," +       space +       ss <- getAllBut "(" +       skipRestOfLine >> getAllBut "/" +       (y,m,d,h) <- pTime +       w <- getAfterString "Wind: " +       v <- getAfterString "Visibility: " +       sk <- getAfterString "Sky conditions: " +       skipTillString "Temperature: " +       (tC,tF) <- pTemp +       dp <- getAfterString "Dew Point: " +       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] + +defUrl :: String +defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" + +getData :: String -> IO String +getData url= +        do (i,o,e,p) <- runInteractiveCommand ("curl " ++ defUrl ++ url ++ ".TXT") +           exit <- waitForProcess p +           let closeHandles = do hClose o +                                 hClose i +                                 hClose e +           case exit of +             ExitSuccess -> do str <- hGetContents o +                               when (str == str) $ return () +                               closeHandles +                               return str +             _ -> do closeHandles +                     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)] = +    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 ] +formatWeather _ = return "N/A" + +runWeather :: [String] -> Monitor String +runWeather str = +    do d <- io $ getData $ head str +       i <- io $ runP parseData d +       formatWeather i diff --git a/src/Plugins/Monitors/Wireless.hs b/src/Plugins/Monitors/Wireless.hs new file mode 100644 index 0000000..4ac0c10 --- /dev/null +++ b/src/Plugins/Monitors/Wireless.hs @@ -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 ""
\ No newline at end of file | 
