summaryrefslogtreecommitdiffhomepage
path: root/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'Monitors')
-rw-r--r--Monitors/Batt.hs67
-rw-r--r--Monitors/Common.hs286
-rw-r--r--Monitors/Cpu.hs53
-rw-r--r--Monitors/Mem.hs47
-rw-r--r--Monitors/Net.hs99
-rw-r--r--Monitors/Swap.hs50
-rw-r--r--Monitors/Weather.hs129
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