diff --git a/Monitors/Batt.hs b/Monitors/Batt.hs new file mode 100644 --- /dev/null +++ b/Monitors/Batt.hs @@ -0,0 +1,85 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Monitors.Batt +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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: " + 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 diff --git a/Monitors/Common.hs b/Monitors/Common.hs new file mode 100644 --- /dev/null +++ b/Monitors/Common.hs @@ -0,0 +1,295 @@ +----------------------------------------------------------------------------- +-- | +-- Module : 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 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 $ "" ++ + 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/Monitors/Cpu.hs b/Monitors/Cpu.hs --- a/Monitors/Cpu.hs +++ b/Monitors/Cpu.hs @@ -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: " + 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 = - "" ++ - str ++ "" - -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 diff --git a/Monitors/Mem.hs b/Monitors/Mem.hs --- a/Monitors/Mem.hs +++ b/Monitors/Mem.hs @@ -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: % (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 = - "" ++ - str ++ "" +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 diff --git a/Monitors/Net.hs b/Monitors/Net.hs --- a/Monitors/Net.hs +++ b/Monitors/Net.hs @@ -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 ": |" + 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 = - "" ++ - str ++ "" - -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 diff --git a/Monitors/Swap.hs b/Monitors/Swap.hs new file mode 100644 --- /dev/null +++ b/Monitors/Swap.hs @@ -0,0 +1,64 @@ +----------------------------------------------------------------------------- +-- | +-- Module : 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 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: %" + 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 diff --git a/Monitors/Weather.hs b/Monitors/Weather.hs --- a/Monitors/Weather.hs +++ b/Monitors/Weather.hs @@ -1,95 +1,123 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Monitors.Weather +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 ": C, rh % ()" + 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 = - "" ++ - str ++ "" +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 diff --git a/XMobar.hs b/XMobar.hs --- a/XMobar.hs +++ b/XMobar.hs @@ -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 diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -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 diff --git a/xmobar.config-sample b/xmobar.config-sample --- a/xmobar.config-sample +++ b/xmobar.config-sample @@ -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% | %date%" + , template = "%xmb-cpu% | %xmb-mem% * %xmb-swap% | %xmb-net% | %xmb-weather% | %date%" }