diff options
Diffstat (limited to 'Monitors')
| -rw-r--r-- | Monitors/Batt.hs | 67 | ||||
| -rw-r--r-- | Monitors/Common.hs | 286 | ||||
| -rw-r--r-- | Monitors/Cpu.hs | 53 | ||||
| -rw-r--r-- | Monitors/Mem.hs | 47 | ||||
| -rw-r--r-- | Monitors/Net.hs | 99 | ||||
| -rw-r--r-- | Monitors/Swap.hs | 50 | ||||
| -rw-r--r-- | Monitors/Weather.hs | 129 |
7 files changed, 0 insertions, 731 deletions
diff --git a/Monitors/Batt.hs b/Monitors/Batt.hs deleted file mode 100644 index 57e9f6f..0000000 --- a/Monitors/Batt.hs +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Batt --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A battery monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Batt where - -import qualified Data.ByteString.Lazy.Char8 as B -import System.Posix.Files - -import Monitors.Common - -battConfig :: IO MConfig -battConfig = mkMConfig - "Batt: <left>" -- 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/Monitors/Common.hs b/Monitors/Common.hs deleted file mode 100644 index 9928946..0000000 --- a/Monitors/Common.hs +++ /dev/null @@ -1,286 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Common --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- Utilities for creating monitors for Xmobar --- ------------------------------------------------------------------------------ - -module 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 $ - "<fc=" ++ c ++ ">" ++ str ++ "</fc>" - -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/Monitors/Cpu.hs b/Monitors/Cpu.hs deleted file mode 100644 index 14acffb..0000000 --- a/Monitors/Cpu.hs +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Cpu --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A cpu monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Cpu where - -import Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B - -cpuConfig :: IO MConfig -cpuConfig = mkMConfig - "Cpu: <total>" -- 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/Monitors/Mem.hs b/Monitors/Mem.hs deleted file mode 100644 index 04e12f5..0000000 --- a/Monitors/Mem.hs +++ /dev/null @@ -1,47 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Mem --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A memory monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Mem where - -import Monitors.Common - -memConfig :: IO MConfig -memConfig = mkMConfig - "Mem: <usedratio>% (<cache>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/Monitors/Net.hs b/Monitors/Net.hs deleted file mode 100644 index 1f2343d..0000000 --- a/Monitors/Net.hs +++ /dev/null @@ -1,99 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Net --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A net device monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Net where - -import 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>|<tx>" -- 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/Monitors/Swap.hs b/Monitors/Swap.hs deleted file mode 100644 index 5460a19..0000000 --- a/Monitors/Swap.hs +++ /dev/null @@ -1,50 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Swap --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A swap usage monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Swap where - -import Monitors.Common - -import qualified Data.ByteString.Lazy.Char8 as B - -swapConfig :: IO MConfig -swapConfig = mkMConfig - "Swap: <usedratio>" -- 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/Monitors/Weather.hs b/Monitors/Weather.hs deleted file mode 100644 index 6a9b829..0000000 --- a/Monitors/Weather.hs +++ /dev/null @@ -1,129 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Monitors.Weather --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it> --- Stability : unstable --- Portability : unportable --- --- A weather monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Monitors.Weather where - -import Monitors.Common - -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 - , 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 |