From a8653d8712c2d218adf3f70cef7e511060bed695 Mon Sep 17 00:00:00 2001 From: Andrea Rossato Date: Wed, 18 Jul 2007 17:12:11 +0200 Subject: Monitors are now a Plugin that can be removed from Config.hs darcs-hash:20070718151211-d6583-7e0e49c22d07feda72d03370fd592c196dfcc9c1.gz --- Plugins/Monitors/Batt.hs | 67 +++++++++++ Plugins/Monitors/Common.hs | 286 ++++++++++++++++++++++++++++++++++++++++++++ Plugins/Monitors/Cpu.hs | 53 ++++++++ Plugins/Monitors/Mem.hs | 47 ++++++++ Plugins/Monitors/Net.hs | 99 +++++++++++++++ Plugins/Monitors/Swap.hs | 50 ++++++++ Plugins/Monitors/Weather.hs | 129 ++++++++++++++++++++ 7 files changed, 731 insertions(+) create mode 100644 Plugins/Monitors/Batt.hs create mode 100644 Plugins/Monitors/Common.hs create mode 100644 Plugins/Monitors/Cpu.hs create mode 100644 Plugins/Monitors/Mem.hs create mode 100644 Plugins/Monitors/Net.hs create mode 100644 Plugins/Monitors/Swap.hs create mode 100644 Plugins/Monitors/Weather.hs (limited to 'Plugins') diff --git a/Plugins/Monitors/Batt.hs b/Plugins/Monitors/Batt.hs new file mode 100644 index 0000000..79c0015 --- /dev/null +++ b/Plugins/Monitors/Batt.hs @@ -0,0 +1,67 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Batt +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A battery monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Batt where + +import qualified Data.ByteString.Lazy.Char8 as B +import System.Posix.Files + +import Plugins.Monitors.Common + +battConfig :: IO MConfig +battConfig = mkMConfig + "Batt: " -- template + ["left"] -- available replacements + +fileB1 :: (String, String) +fileB1 = ("/proc/acpi/battery/BAT1/info", "/proc/acpi/battery/BAT1/state") + +fileB2 :: (String, String) +fileB2 = ("/proc/acpi/battery/BAT2/info", "/proc/acpi/battery/BAT2/state") + +checkFileBatt :: (String, String) -> IO Bool +checkFileBatt (i,_) = + fileExist i + +readFileBatt :: (String, String) -> IO (B.ByteString, B.ByteString) +readFileBatt (i,s) = + do a <- B.readFile i + b <- B.readFile s + return (a,b) + +parseBATT :: IO Float +parseBATT = + do (a1,b1) <- readFileBatt fileB1 + c <- checkFileBatt fileB2 + let sp p s = read $ stringParser p s + (fu, pr) = (sp (3,2) a1, sp (2,4) b1) + case c of + True -> do (a2,b2) <- readFileBatt fileB1 + let full = fu + (sp (3,2) a2) + present = pr + (sp (2,4) b2) + return $ present / full + _ -> return $ pr / fu + + +formatBatt :: Float -> Monitor [String] +formatBatt x = + do let f s = floatToPercent (s / 100) + l <- showWithColors f (x * 100) + return [l] + +runBatt :: [String] -> Monitor String +runBatt _ = + do c <- io $ parseBATT + l <- formatBatt c + parseTemplate l diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs new file mode 100644 index 0000000..26b6289 --- /dev/null +++ b/Plugins/Monitors/Common.hs @@ -0,0 +1,286 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Common +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 + , showWithColors + , takeDigits + , floatToPercent + , stringParser + -- * Threaded Actions + -- $thread + , doActionTwiceWithDelay + ) 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 Numeric + +import Text.ParserCombinators.Parsec + +import System.Console.GetOpt + +-- $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] + } + +-- | 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 s = + sel s + +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 + return $ MC nc l lc h hc t e + +data Opts = HighColor String + | NormalColor String + | LowColor String + | Low String + | High String + | Template 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." + ] + +doArgs :: [String] + -> ([String] -> Monitor String) + -> Monitor String +doArgs args action = + do 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 + case o of + High h -> setConfigValue (read h) high >> next + Low l -> setConfigValue (read l) low >> next + HighColor hc -> setConfigValue (Just hc) highColor >> next + NormalColor nc -> setConfigValue (Just nc) normalColor >> next + LowColor lc -> setConfigValue (Just lc) lowColor >> next + Template t -> setConfigValue t template >> next + +runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO String +runM args conf action = + do c <- conf + let ac = doArgs args action + runReaderT ac c + +io :: IO a -> Monitor a +io = liftIO + + + +-- $parsers + +runP :: Parser [a] -> String -> IO [a] +runP p i = + do 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 + ; v <- manyTill anyChar $ newline + ; return v + } <|> return ("<" ++ s ++ " not found!>") + +skipTillString :: String -> Parser String +skipTillString s = + manyTill skipRestOfLine $ string s + +-- | Parses the output template string +templateStringParser :: Parser (String,String,String) +templateStringParser = + do{ s <- many $ noneOf "<" + ; (_,com,_) <- templateCommandParser + ; ss <- many $ noneOf "<" + ; return (s, com, ss) + } + +-- | Parses the command part of the template string +templateCommandParser :: Parser (String,String,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 + +floatToPercent :: Float -> String +floatToPercent n = + showFFloat (Just 2) (n*100) "%" + +stringParser :: Pos -> B.ByteString -> String +stringParser (x,y) = + flip (!!) x . map B.unpack . B.words . flip (!!) y . B.lines + +setColor :: String -> Selector (Maybe String) -> Monitor String +setColor str s = + do a <- getConfigValue s + case a of + Nothing -> return str + Just c -> return $ + "" ++ str ++ "" + +showWithColors :: (Float -> String) -> Float -> Monitor String +showWithColors f x = + do h <- getConfigValue high + l <- getConfigValue low + let col = setColor $ f x + head $ [col highColor | x > fromIntegral h ] ++ + [col normalColor | x > fromIntegral l ] ++ + [col lowColor | True] + +-- $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) diff --git a/Plugins/Monitors/Cpu.hs b/Plugins/Monitors/Cpu.hs new file mode 100644 index 0000000..9ab6d8f --- /dev/null +++ b/Plugins/Monitors/Cpu.hs @@ -0,0 +1,53 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Cpu +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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: " -- template + ["total","user","nice","system","idle"] -- available replacements + +cpuData :: IO [Float] +cpuData = do s <- B.readFile "/proc/stat" + return $ cpuParser s + +cpuParser :: B.ByteString -> [Float] +cpuParser = + map read . map B.unpack . tail . B.words . flip (!!) 0 . 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 [""] +formatCpu x = + do let f s = floatToPercent (s / 100) + t = foldr (+) 0 $ take 3 x + list = t:x + mapM (showWithColors f) . map (* 100) $ list + +runCpu :: [String] -> Monitor String +runCpu _ = + do c <- io $ parseCPU + l <- formatCpu c + parseTemplate l diff --git a/Plugins/Monitors/Mem.hs b/Plugins/Monitors/Mem.hs new file mode 100644 index 0000000..56639f2 --- /dev/null +++ b/Plugins/Monitors/Mem.hs @@ -0,0 +1,47 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Mem +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A memory monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Mem where + +import Plugins.Monitors.Common + +memConfig :: IO MConfig +memConfig = mkMConfig + "Mem: % (M)" -- template + ["total", "free", "buffer", -- available replacements + "cache", "rest", "used", "usedratio"] + +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 * 100 / total + return [total, free, buffer, cache, rest, used, usedratio] + +formatMem :: [Float] -> Monitor [String] +formatMem x = + do let f n = show (takeDigits 2 n) + mapM (showWithColors f) x + +runMem :: [String] -> Monitor String +runMem _ = + do m <- io $ parseMEM + l <- formatMem m + parseTemplate l diff --git a/Plugins/Monitors/Net.hs b/Plugins/Monitors/Net.hs new file mode 100644 index 0000000..8534a2a --- /dev/null +++ b/Plugins/Monitors/Net.hs @@ -0,0 +1,99 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Net +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A net device monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Net 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 + ": |" -- template + ["dev", "rx", "tx"] -- available replacements + + +-- takes two elements of a list given their indexes +getTwoElementsAt :: Int -> Int -> [a] -> [a] +getTwoElementsAt x y xs = + z : [zz] + where z = xs !! x + zz = xs !! y + +-- split a list of strings returning a list with: 1. the first part of +-- the split; 2. the second part of the split without the Char; 3. the +-- rest of the list. For instance: +-- +-- > splitAtChar ':' ["lo:31174097","31174097"] +-- +-- will become ["lo","31174097","31174097"] +splitAtChar :: Char -> [String] -> [String] +splitAtChar c xs = + first : (rest xs) + where rest = map $ \x -> if (c `elem` x) then (tail $ dropWhile (/= c) x) else x + first = head $ map (takeWhile (/= c)) . filter (\x -> (c `elem` x)) $ xs + +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 . map (splitAtChar ':') . map (getTwoElementsAt 0 8) . map (words . B.unpack) . drop 2 . B.lines + +formatNet :: Float -> Monitor String +formatNet d = + showWithColors f d + where f s = show s ++ "Kb" + +printNet :: NetDev -> Monitor String +printNet nd = + do case nd of + ND d r t -> do rx <- formatNet r + tx <- formatNet t + parseTemplate [d,rx,tx] + 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/Plugins/Monitors/Swap.hs b/Plugins/Monitors/Swap.hs new file mode 100644 index 0000000..fbddaae --- /dev/null +++ b/Plugins/Monitors/Swap.hs @@ -0,0 +1,50 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Swap +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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: " -- template + ["total", "used", "free", "usedratio"] -- available replacements + +fileMEM :: IO B.ByteString +fileMEM = B.readFile "/proc/meminfo" + +parseMEM :: IO [Float] +parseMEM = + do file <- fileMEM + let p x y = flip (/) 1024 . read . stringParser x $ y + tot = p (1,11) file + free = p (1,12) file + return [tot, (tot - free), free, (tot - free) / tot] + +formatSwap :: [Float] -> Monitor [String] +formatSwap x = + do let f1 n = show (takeDigits 2 n) + f2 n = floatToPercent n + (hd, tl) = splitAt 3 x + firsts <- mapM (showWithColors f1) hd + lasts <- mapM (showWithColors f2) tl + return $ firsts ++ lasts + +runSwap :: [String] -> Monitor String +runSwap _ = + do m <- io $ parseMEM + l <- formatSwap m + parseTemplate l diff --git a/Plugins/Monitors/Weather.hs b/Plugins/Monitors/Weather.hs new file mode 100644 index 0000000..ec5606e --- /dev/null +++ b/Plugins/Monitors/Weather.hs @@ -0,0 +1,129 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Weather +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A weather monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.Weather where + +import Plugins.Monitors.Common + +import System.Process +import System.Exit +import System.IO + +import Text.ParserCombinators.Parsec + + +weatherConfig :: IO MConfig +weatherConfig = mkMConfig + ": C, rh % ()" -- 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 + , temperature :: Float + , dewPoint :: String + , humidity :: Float + , pressure :: String + } 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 Float +pTemp = do manyTill anyChar $ char '(' + s <- manyTill digit $ (char ' ' <|> char '.') + skipRestOfLine + return $read s + +pRh :: Parser Float +pRh = do s <- manyTill digit $ (char '%' <|> char '.') + 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: " + temp <- pTemp + dp <- getAfterString "Dew Point: " + skipTillString "Relative Humidity: " + rh <- pRh + p <- getAfterString "Pressure (altimeter): " + manyTill skipRestOfLine eof + return $ [WI st ss y m d h w v sk temp 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 + return str + _ -> do closeHandles + return "Could not retrieve data" + +formatWeather :: [WeatherInfo] -> Monitor String +formatWeather [(WI st ss y m d h w v sk temp dp r p)] = + do cel <- showWithColors show temp + far <- showWithColors (show . takeDigits 1) (((9 / 5) * temp) + 32) + rh <- showWithColors show r + parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, rh , p ] +formatWeather _ = return "N/A" + +runWeather :: [String] -> Monitor String +runWeather str = + do d <- io $ getData $ head str + i <- io $ runP parseData d + formatWeather i -- cgit v1.2.3