added some monitors with output formatted for xmobar

darcs-hash:20070622125152-d6583-d613d976577d9380b6390d7a47910148dcdfba56.gz

3 files changed, 350 insertions, 0 deletions

diff --git a/Monitors/Cpu.hs b/Monitors/Cpu.hs
new file mode 100644
index 0000000..b67f772
--- /dev/null
+++ b/Monitors/Cpu.hs
@@ -0,0 +1,109 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 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"
+
+
+getNumbers :: Parser Float
+getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n
+
+parserCPU :: Parser [Float]
+parserCPU = string "cpu" >> count 4 getNumbers
+
+parseCPU :: IO [Float]
+parseCPU = 
+    do a <- run parserCPU fileCPU
+       interSec
+       b <- run parserCPU fileCPU
+       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 _ = ""
+
+setColor :: String -> (Config -> String) -> String
+setColor str ty =
+    "<fc=" ++ ty config ++ ">" ++
+    str ++ "</fc>"
+    
+cpu :: IO String
+cpu = 
+    do l <- parseCPU
+       return $ "Cpu: " ++ formatCpu l
+
+main :: IO ()
+main =
+    do c <- cpu
+       putStrLn c
diff --git a/Monitors/Mem.hs b/Monitors/Mem.hs
new file mode 100644
index 0000000..d8bd601
--- /dev/null
+++ b/Monitors/Mem.hs
@@ -0,0 +1,99 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 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
+
+takeDigits :: Int -> Float -> Float
+takeDigits d n = 
+    read $ showFFloat (Just d) n ""
+
+floatToPercent :: Float -> String
+floatToPercent n = 
+    showFFloat (Just 2) (n*100) "%" 
+
+fileMEM :: IO String
+fileMEM = readFile "/proc/meminfo"
+
+parseMEM :: IO [Float]
+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
+           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]
+
+
+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 _ = ""
+
+setColor :: String -> (Config -> String) -> String
+setColor str ty =
+    "<fc=" ++ ty config ++ ">" ++
+    str ++ "</fc>"
+    
+mem :: IO String
+mem =
+    do m <- parseMEM
+       return $ formatMem m
+
+main :: IO ()
+main =
+    do m <- mem
+       putStrLn m
\ No newline at end of file
diff --git a/Monitors/Net.hs b/Monitors/Net.hs
new file mode 100644
index 0000000..7554c56
--- /dev/null
+++ b/Monitors/Net.hs
@@ -0,0 +1,142 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Monitors.Cpu
+-- 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 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)
+
+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
+
+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 -> String
+formatNet d | d > fromInteger (netCritical config) = setColor str netCriticalColor 
+            | d > fromInteger (netNormal config) = setColor str netNormalColor
+            | otherwise = str
+            where str = show d ++ "Kb"
+
+pNetDev :: Parser NetDev
+pNetDev = 
+    do { skipMany1 space
+       ; dn <- manyTill alphaNum $ char ':'
+       ; [rx] <- count 1 getNumbers
+       ; _ <- count 7 getNumbers
+       ; [tx] <- count 1 getNumbers
+       ; _ <- count 7 getNumbers
+       ; char '\n'
+       ; return $ ND dn (rx / 1024) (tx / 1024)
+       } 
+
+parserNet :: Parser [NetDev]
+parserNet = manyTill pNetDev eof
+
+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))
+           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
+       n <- case pn of
+              [x] -> return x
+              _ -> return $ NA
+       return $ show n
+
+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