xmobar 0.3.1 → 0.4
raw patch · 10 files changed
+705/−319 lines, 10 filesnew-component:exe:xmb-battnew-component:exe:xmb-swap
Files
- Monitors/Batt.hs +85/−0
- Monitors/Common.hs +295/−0
- Monitors/Cpu.hs +40/−78
- Monitors/Mem.hs +32/−66
- Monitors/Net.hs +47/−86
- Monitors/Swap.hs +64/−0
- Monitors/Weather.hs +116/−77
- XMobar.hs +10/−6
- xmobar.cabal +14/−4
- xmobar.config-sample +2/−2
+ Monitors/Batt.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- 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 Main where++import Data.IORef+import qualified Data.ByteString.Lazy.Char8 as B+import System.Posix.Files++import Monitors.Common++monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#FF0000"+ l <- newIORef 25+ nc <- newIORef "#FF0000"+ h <- newIORef 75+ hc <- newIORef "#00FF00"+ t <- newIORef "Batt: <left>"+ p <- newIORef package+ u <- newIORef ""+ a <- newIORef []+ e <- newIORef ["left"]+ return $ MC nc l lc h hc t p u a e++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]++package :: String+package = "xmb-batt"++runBatt :: [String] -> Monitor String+runBatt _ =+ do c <- io $ parseBATT+ l <- formatBatt c+ parseTemplate l + +main :: IO ()+main =+ do let af = runBatt []+ runMonitor monitorConfig af runBatt
+ Monitors/Common.hs view
@@ -0,0 +1,295 @@+-----------------------------------------------------------------------------+-- |+-- 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+ , runMonitor+ , io+ -- * Parsers+ -- $parsers+ , runP+ , skipRestOfLine+ , getNumbers+ , getNumbersAsString+ , getAllBut+ , 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+import System.Environment+import System.Exit++-- $monitor++type Monitor a = ReaderT MConfig IO a++data MConfig =+ MC { normalColor :: IORef String+ , low :: IORef Int+ , lowColor :: IORef String+ , high :: IORef Int+ , highColor :: IORef String+ , template :: IORef String+ , packageName :: IORef String+ , usageTail :: IORef String+ , addedArgs :: IORef [OptDescr Opts]+ , 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+++data Opts = Help+ | Version+ | HighColor String+ | NormalColor String+ | LowColor String+ | Low String+ | High String+ | Template String+ | Others String++options :: Monitor [OptDescr Opts]+options =+ do t <- getConfigValue export+ ao <- getConfigValue addedArgs + tmpl <- getConfigValue template+ return $ [ Option ['h'] ["help"] (NoArg Help) "Show this help"+ , Option ['V'] ["version"] (NoArg Version) "Show version information"+ , Option ['H'] ["High"] (ReqArg High "number") "The high threshold"+ , Option ['L'] ["Low"] (ReqArg Low "number") "The low threshold"+ , Option [] ["high"] (ReqArg HighColor "color number") "Color for the high threshold: es \"#FF0000\""+ , Option [] ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: es \"#00FF00\""+ , Option [] ["low"] (ReqArg LowColor "color number") "Color for the low threshold: es \"#0000FF\""+ , Option ['t'] ["template"] (ReqArg Template "output template") + ("Output template.\nAvaliable variables: " ++ show t ++ "\nDefault template: " ++ show tmpl)+ ] ++ ao++usage :: Monitor ()+usage =+ do pn <- io $ getProgName+ u <- getConfigValue usageTail+ opts <- options+ io $ putStr $ usageInfo ("Usage: " ++ pn ++ " [OPTIONS...] " ++ u) opts++version :: String+version = "0.4"++versinfo :: String -> String -> IO ()+versinfo p v = putStrLn $ p ++" " ++ v++doArgs :: [String] + -> Monitor String + -> ([String] -> Monitor String)+ -> Monitor String+doArgs args actionFail action =+ do opts <- options+ case (getOpt Permute opts args) of+ (o, n, []) -> do+ doConfigOptions o+ case n of+ [] -> actionFail+ nd -> action nd+ (_, _, errs) -> io $ error (concat errs)++doConfigOptions :: [Opts] -> Monitor ()+doConfigOptions [] = io $ return ()+doConfigOptions (o:oo) =+ do pn <- getConfigValue packageName+ let next = doConfigOptions oo+ case o of+ Help -> usage >> io (exitWith ExitSuccess)+ Version -> io $ versinfo pn version >> exitWith ExitSuccess+ High h -> setConfigValue (read h) high >> next+ Low l -> setConfigValue (read l) low >> next+ HighColor hc -> setConfigValue hc highColor >> next+ NormalColor nc -> setConfigValue nc normalColor >> next+ LowColor lc -> setConfigValue lc lowColor >> next+ Template t -> setConfigValue t template >> next+ _ -> next++runMonitor :: IO MConfig -> Monitor String -> ([String] -> Monitor String) -> IO ()+runMonitor conf actionFail action =+ do c <- conf+ args <- getArgs+ let ac = doArgs args actionFail action+ putStrLn =<< 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+++-- | 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 = + read $ showFFloat (Just d) n ""++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 String -> Monitor String+setColor str s =+ do a <- getConfigValue s+ return $ "<fc=" ++ a ++ ">" +++ 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)
Monitors/Cpu.hs view
@@ -14,96 +14,58 @@ module Main where -import Numeric-import Control.Concurrent-import Text.ParserCombinators.Parsec---data Config = - Config { intervall :: Int- , cpuNormal :: Integer- , cpuNormalColor :: String- , cpuCritical :: Integer- , cpuCriticalColor :: String- }--defaultConfig :: Config-defaultConfig = - Config { intervall = 500000- , cpuNormal = 2- , cpuNormalColor = "#00FF00" - , cpuCritical = 60- , cpuCriticalColor = "#FF0000" - }--config :: Config-config = defaultConfig---- Utilities--interSec :: IO ()-interSec = threadDelay (intervall config)--takeDigits :: Int -> Float -> Float-takeDigits d n = - read $ showFFloat (Just d) n ""--floatToPercent :: Float -> String-floatToPercent n = - showFFloat (Just 2) (n*100) "%" ---run :: Parser [a] -> IO String -> IO [a]-run p input- = do a <- input- case (parse p "" a) of- Left _ -> return []- Right x -> return x--fileCPU :: IO String-fileCPU = readFile "/proc/stat"+import Monitors.Common+import qualified Data.ByteString.Lazy.Char8 as B+import Data.IORef +monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#BFBFBF"+ l <- newIORef 2+ nc <- newIORef "#00FF00"+ h <- newIORef 60+ hc <- newIORef "#FF0000"+ t <- newIORef "Cpu: <total>"+ p <- newIORef package+ u <- newIORef ""+ a <- newIORef []+ e <- newIORef ["total","user","nice","system","idle"]+ return $ MC nc l lc h hc t p u a e -getNumbers :: Parser Float-getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n+cpuData :: IO [Float]+cpuData = do s <- B.readFile "/proc/stat"+ return $ cpuParser s -parserCPU :: Parser [Float]-parserCPU = string "cpu" >> count 4 getNumbers+cpuParser :: B.ByteString -> [Float]+cpuParser =+ map read . map B.unpack . tail . B.words . flip (!!) 0 . B.lines parseCPU :: IO [Float] parseCPU = - do a <- run parserCPU fileCPU- interSec- b <- run parserCPU fileCPU+ do (a,b) <- doActionTwiceWithDelay 750000 cpuData let dif = zipWith (-) b a tot = foldr (+) 0 dif percent = map (/ tot) dif return percent -formatCpu :: [Float] -> String -formatCpu [] = ""-formatCpu (us:ni:sy:_)- | x >= c = setColor z cpuCriticalColor- | x >= n = setColor z cpuNormalColor- | otherwise = floatToPercent y- where x = (us * 100) + (sy * 100) + (ni * 100)- y = us + sy + ni- z = floatToPercent y- c = fromInteger (cpuCritical config)- n = fromInteger (cpuNormal config)-formatCpu _ = ""+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 -setColor :: String -> (Config -> String) -> String-setColor str ty =- "<fc=" ++ ty config ++ ">" ++- str ++ "</fc>"- -cpu :: IO String-cpu = - do l <- parseCPU- return $ "Cpu: " ++ formatCpu l+package :: String+package = "xmb-cpu" +runCpu :: [String] -> Monitor String+runCpu _ =+ do c <- io $ parseCPU+ l <- formatCpu c+ parseTemplate l + main :: IO () main =- do c <- cpu- putStrLn c+ do let af = runCpu []+ runMonitor monitorConfig af runCpu
Monitors/Mem.hs view
@@ -14,86 +14,52 @@ module Main where -import Numeric--data Config = - Config { memNormal :: Integer- , memNormalColor :: String- , memCritical :: Integer- , memCriticalColor :: String- , swapNormal :: Integer- , swapNormalColor :: String- , swapCritical :: Integer- , swapCriticalColor :: String- }--defaultConfig :: Config-defaultConfig = - Config { memNormal = 80- , memNormalColor = "#00FF00" - , memCritical = 90- , memCriticalColor = "#FF0000"- , swapNormal = 15- , swapNormalColor = "#00FF00" - , swapCritical = 50- , swapCriticalColor = "#FF0000" - }-config :: Config-config = defaultConfig---- Utilities+import Monitors.Common -takeDigits :: Int -> Float -> Float-takeDigits d n = - read $ showFFloat (Just d) n ""+import Data.IORef -floatToPercent :: Float -> String-floatToPercent n = - showFFloat (Just 2) (n*100) "%" +monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#BFBFBF"+ l <- newIORef 300+ nc <- newIORef "#00FF00"+ h <- newIORef 500+ hc <- newIORef "#FF0000"+ t <- newIORef "Mem: <usedratio>% (<cache>M)"+ p <- newIORef package+ u <- newIORef ""+ a <- newIORef []+ e <- newIORef ["total", "free", "buffer", "cache", "rest", "used", "usedratio"]+ return $ MC nc l lc h hc t p u a e fileMEM :: IO String fileMEM = readFile "/proc/meminfo" parseMEM :: IO [Float]-parseMEM = +parseMEM = do file <- fileMEM - let content = map words $ take 13 $ lines file- [total, free, buffer, cache,_,_,_,_,_,_,_,swapTotal,swapFree] = map (\line -> (read $ line !! 1 :: Float) / 1024) content+ 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- swapRatio = 100 - (swapFree / swapTotal * 100)- return [total, free, buffer, cache, rest, used, usedratio, swapFree, swapRatio]+ 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 -formatMem :: [Float] -> String -formatMem [] = ""-formatMem (total:_:buffer:cach:_:used:_:_:swapRatio:_) =- "Ram: " ++ ram ++ " cached: " ++ cache ++ " Swap: " ++ swap- where (memN,memC,swapN,swapC) = (fromIntegral $ memNormal config,fromIntegral $ memCritical config- , fromIntegral $ swapNormal config, fromIntegral $ swapCritical config)- m = floatToPercent ((used + buffer + cach) / total)- sw = show (takeDigits 2 swapRatio) ++ "%"- cache = show (takeDigits 2 cach) ++ "Mb"- ram | (used / total * 100) >= memC = setColor m memCriticalColor- | (used / total * 100) >= memN = setColor m memNormalColor- | otherwise = floatToPercent (used / total)- swap | swapRatio >= swapC = setColor sw swapCriticalColor- | swapRatio >= swapN = setColor sw swapNormalColor- | otherwise = sw-formatMem _ = ""+package :: String+package = "xmb-mem" -setColor :: String -> (Config -> String) -> String-setColor str ty =- "<fc=" ++ ty config ++ ">" ++- str ++ "</fc>"+runMem :: [String] -> Monitor String+runMem _ =+ do m <- io $ parseMEM+ l <- formatMem m+ parseTemplate l -mem :: IO String-mem =- do m <- parseMEM- return $ formatMem m- main :: IO () main =- do m <- mem- putStrLn m+ do let af = runMem []+ runMonitor monitorConfig af runMem
Monitors/Net.hs view
@@ -14,82 +14,51 @@ module Main where -import Numeric-import Control.Concurrent-import Text.ParserCombinators.Parsec-import System.Environment--data Config = - Config { intervall :: Int- , netDevice :: String- , netNormal :: Integer- , netNormalColor :: String- , netCritical :: Integer- , netCriticalColor :: String- }--defaultConfig :: Config-defaultConfig = - Config { intervall = 500000- , netDevice = "eth1"- , netNormal = 0- , netNormalColor = "#00FF00" - , netCritical = 50- , netCriticalColor = "#FF0000" - }--config :: Config-config = defaultConfig---- Utilities--interSec :: IO ()-interSec = threadDelay (intervall config)+import Monitors.Common -takeDigits :: Int -> Float -> Float-takeDigits d n = - read $ showFFloat (Just d) n ""+import Data.IORef+import Text.ParserCombinators.Parsec -floatToPercent :: Float -> String-floatToPercent n = - showFFloat (Just 2) (n*100) "%" +data NetDev = NA+ | ND { netDev :: String+ , netRx :: Float+ , netTx :: Float+ } deriving (Eq,Show,Read) +interval :: Int+interval = 500000 -run :: Parser [a] -> IO String -> IO [a]-run p input- = do a <- input- case (parse p "" a) of- Left _ -> return []- Right x -> return x+monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#BFBFBF"+ l <- newIORef 0+ nc <- newIORef "#00FF00"+ h <- newIORef 32+ hc <- newIORef "#FF0000"+ t <- newIORef "<dev>: <rx>|<tx>"+ p <- newIORef package+ u <- newIORef "dev"+ a <- newIORef []+ e <- newIORef ["dev", "rx", "tx"]+ return $ MC nc l lc h hc t p u a e fileNET :: IO String fileNET = do f <- readFile "/proc/net/dev" return $ unlines $ drop 2 $ lines f --- CPU--getNumbers :: Parser Float-getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n---- Net Devices--data NetDev = NA- | ND { netDev :: String- , netRx :: Float- , netTx :: Float- } deriving (Eq,Read)--instance Show NetDev where- show NA = "N/A"- show (ND nd rx tx) =- nd ++ ": " ++ (formatNet rx) ++ "|" ++ formatNet tx +formatNet :: Float -> Monitor String+formatNet d =+ showWithColors f d+ where f s = show s ++ "Kb" -formatNet :: Float -> String-formatNet d | d > fromInteger (netCritical config) = setColor str netCriticalColor - | d > fromInteger (netNormal config) = setColor str netNormalColor- | otherwise = str- where str = show d ++ "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" pNetDev :: Parser NetDev pNetDev = @@ -108,35 +77,27 @@ parseNET :: String -> IO [NetDev] parseNET nd = - do a <- run parserNet fileNET- interSec- b <- run parserNet fileNET- let netRate f da db = takeDigits 2 $ ((f db) - (f da)) * fromIntegral (1000000 `div` (intervall config))+ do (a',b') <- doActionTwiceWithDelay interval fileNET+ a <- runP parserNet a'+ b <- runP parserNet b'+ 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 --- Formattings--setColor :: String -> (Config -> String) -> String-setColor str ty =- "<fc=" ++ ty config ++ ">" ++- str ++ "</fc>"- -net :: String -> IO String-net nd = - do pn <- parseNET nd+runNet :: [String] -> Monitor String+runNet nd = + do pn <- io $ parseNET $ head nd n <- case pn of [x] -> return x _ -> return $ NA- return $ show n+ printNet n +package :: String+package = "xmb-net"+ main :: IO () main =- do args <- getArgs- n <-- if length args /= 1- then error "No device specified.\nUsage: net dev"- else net (args!!0)- putStrLn n+ do let f = return "No device specified"+ runMonitor monitorConfig f runNet
+ Monitors/Swap.hs view
@@ -0,0 +1,64 @@+-----------------------------------------------------------------------------+-- |+-- 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 Main where++import Monitors.Common++import Data.IORef+import qualified Data.ByteString.Lazy.Char8 as B++monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#BFBFBF"+ l <- newIORef 30+ nc <- newIORef "#00FF00"+ h <- newIORef 75+ hc <- newIORef "#FF0000"+ t <- newIORef "Swap: <usedratio>%"+ p <- newIORef package+ u <- newIORef ""+ a <- newIORef []+ e <- newIORef ["total", "used", "free", "usedratio"]+ return $ MC nc l lc h hc t p u a e++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, free / tot * 100]++formatMem :: [Float] -> Monitor [String] +formatMem x =+ do let f n = show (takeDigits 2 n)+ mapM (showWithColors f) x++package :: String+package = "xmb-swap"++runMem :: [String] -> Monitor String+runMem _ =+ do m <- io $ parseMEM+ l <- formatMem m+ parseTemplate l + +main :: IO ()+main =+ do let af = runMem []+ runMonitor monitorConfig af runMem
Monitors/Weather.hs view
@@ -1,95 +1,123 @@+-----------------------------------------------------------------------------+-- |+-- 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 Main where -import Text.ParserCombinators.Parsec-import System.Environment+import Monitors.Common +import Data.IORef+ import System.Process import System.Exit import System.IO +import Text.ParserCombinators.Parsec -data Config = - Config { weatherNormal :: Integer- , weatherNormalColor :: String- , weatherCritical :: Integer- , weatherCriticalColor :: String- }+monitorConfig :: IO MConfig+monitorConfig = + do lc <- newIORef "#BFBFBF"+ l <- newIORef 15+ nc <- newIORef "#00FF00"+ h <- newIORef 27+ hc <- newIORef "#FF0000"+ t <- newIORef "<station>: <tempC>C, rh <rh>% (<hour>)"+ p <- newIORef package+ u <- newIORef "station ID"+ a <- newIORef []+ e <- newIORef ["station"+ , "stationState"+ , "year"+ , "month"+ , "day"+ , "hour"+ , "wind"+ , "visibility"+ , "skyCondition"+ , "tempC"+ , "tempF"+ , "dewPoint"+ , "rh"+ ,"pressure"+ ]+ return $ MC nc l lc h hc t p u a e -defaultConfig :: Config-defaultConfig = - Config { weatherNormal = 0- , weatherNormalColor = "#00FF00" - , weatherCritical = 50- , weatherCriticalColor = "#FF0000" - } -config :: Config-config = defaultConfig+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) -data WeatherInfo = Fail String- | WI { station :: String- , time :: String- , temperature :: Int- , humidity :: Int- } - -instance Show WeatherInfo where- show (Fail _) = "N/A"- show (WI st t temp rh) =- st ++ ": " ++ (formatWeather temp) ++ "C, rh " ++ formatWeather rh ++- "% (" ++ t ++ ")" -parseData :: Parser WeatherInfo-parseData = - do { st <- manyTill anyChar $ char '('- ; pNL- ; manyTill anyChar $ char '/'- ; space- ; t <- manyTill anyChar newline- ; manyTill pNL (string "Temperature")- ; temp <- pTemp- ; manyTill pNL (string "Relative Humidity")- ; rh <- pRh- ; manyTill pNL eof- ; return $ WI st t temp rh- } +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+pTemp :: Parser Float pTemp = do string ": " manyTill anyChar $ char '(' s <- manyTill digit $ (char ' ' <|> char '.')- pNL+ skipRestOfLine return $read s -pRh :: Parser Int+pRh :: Parser Float pRh = do string ": " s <- manyTill digit $ (char '%' <|> char '.')- return $read s--pNL :: Parser Char-pNL = do many $ noneOf "\n\r"- newline---runP :: Parser WeatherInfo -> String -> IO WeatherInfo-runP p i =- do case (parse p "" i) of- Left err -> return $ Fail $ show err- Right x -> return x--formatWeather :: Int -> String-formatWeather d | d > fromInteger (weatherCritical config) = setColor str weatherCriticalColor - | d > fromInteger (weatherNormal config) = setColor str weatherNormalColor- | otherwise = str- where str = show d-+ return $ read s -setColor :: String -> (Config -> String) -> String-setColor str ty =- "<fc=" ++ ty config ++ ">" ++- str ++ "</fc>"+parseData :: Parser [WeatherInfo]+parseData = + do st <- getAllBut "," + space+ ss <- getAllBut "("+ skipRestOfLine >> getAllBut "/"+ (y,m,d,h) <- pTime+ skipRestOfLine >> string "Wind: "+ w <- manyTill anyChar $ newline + manyTill skipRestOfLine $ string "Visibility: "+ v <- manyTill anyChar $ newline+ manyTill skipRestOfLine $ string "Sky conditions: "+ sk <- manyTill anyChar $ newline+ manyTill skipRestOfLine $ string "Temperature"+ temp <- pTemp+ manyTill skipRestOfLine $ string "Dew Point: "+ dp <- manyTill anyChar $ newline+ manyTill skipRestOfLine $ string "Relative Humidity"+ rh <- pRh+ manyTill skipRestOfLine $ string "Pressure (altimeter): "+ p <- manyTill anyChar $ newline+ 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/"@@ -107,13 +135,24 @@ _ -> 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++package :: String+package = "xmb-weather"+ main :: IO () main =- do args <- getArgs- str <- if length args /= 1- then error $ "No Station ID specified.\nUsage: weather STATION_ID" ++- "\nExample: xmb-weather LIPB"- else getData (args !! 0)- i <- runP parseData str - putStrLn $ show i- + do let af = return "No station ID specified"+ runMonitor monitorConfig af runWeather
XMobar.hs view
@@ -144,7 +144,7 @@ valign = (fromIntegral (hight config) + fromIntegral asc) `div` 2 offset = case (align config) of "center" -> (fromIntegral (width config) - fromIntegral totSLen) `div` 2- "right" -> fromIntegral (width config) - fromIntegral totSLen+ "right" -> fromIntegral (width config) - fromIntegral totSLen - 1 "left" -> offs _ -> offs color <- io $ initColor (display st) c@@ -163,7 +163,7 @@ [(_,_,opts)] -> opts _ -> [] --- | Gets the command options set in configuration.+-- | Gets the refresh rate set in configuration for a given command. getRefRate :: Config -> String -> Int getRefRate c com = let l = commands c@@ -261,8 +261,12 @@ io :: IO a -> Xbar a io = liftIO +-- | Work arount to the Int max bound: since threadDelay takes an Int, it+-- is not possible to set a thread delay grater than about 45 minutes.+-- With a little recursion we solve the problem. tenthSeconds :: Int -> IO ()-tenthSeconds s =- threadDelay n- where n | (maxBound :: Int) `div` 100000 <= s = (maxBound :: Int)- | otherwise = s * 100000+tenthSeconds s | s >= x = do threadDelay y+ tenthSeconds (x - s)+ | otherwise = threadDelay (s * 100000)+ where y = (maxBound :: Int)+ x = y `div` 100000
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.3.1+version: 0.4 homepage: http://gorgias.mine.nu/repos/xmobar/ synopsis: A Statusbar for the XMonad Window Manager description: Xmobar is a minimal status bar for the XMonad Window Manager.@@ -15,13 +15,13 @@ executable: xmobar main-is: Main.hs Hs-Source-Dirs: ./-Other-Modules: XMobar, Config, Parsers +Other-Modules: XMobar, Config, Parsers, Monitors.Common ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded ghc-prof-options: -prof -auto-all executable: xmb-cpu main-is: Monitors/Cpu.hs-ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded ghc-prof-options: -prof -auto-all executable: xmb-mem@@ -29,12 +29,22 @@ ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s ghc-prof-options: -prof -auto-all +executable: xmb-swap+main-is: Monitors/Swap.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all+ executable: xmb-net main-is: Monitors/Net.hs-ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded ghc-prof-options: -prof -auto-all executable: xmb-weather main-is: Monitors/Weather.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all++executable: xmb-batt+main-is: Monitors/Batt.hs ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s ghc-prof-options: -prof -auto-all
xmobar.config-sample view
@@ -7,7 +7,7 @@ , hight = 15 , align = "right" , refresh = 10- , commands = [("xmb-weather", 36000, ["EGPF"]), ("xmb-net", 10, ["eth1"])]+ , commands = [("xmb-weather", 36000, ["EGPF"]), ("xmb-net", 10, ["eth0"])] , sepChar = "%"- , template = "%xmb-cpu% %xmb-mem% %xmb-net% | %xmb-weather% | <fc=#ee9a00>%date%</fc>"+ , template = "%xmb-cpu% | %xmb-mem% * %xmb-swap% | %xmb-net% | %xmb-weather% | <fc=#ee9a00>%date%</fc>" }