summaryrefslogtreecommitdiffhomepage
path: root/Plugins/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'Plugins/Monitors')
-rw-r--r--Plugins/Monitors/Batt.hs5
-rw-r--r--Plugins/Monitors/Common.hs58
-rw-r--r--Plugins/Monitors/Cpu.hs14
-rw-r--r--Plugins/Monitors/MultiCpu.hs16
-rw-r--r--Plugins/Monitors/Swap.hs11
5 files changed, 53 insertions, 51 deletions
diff --git a/Plugins/Monitors/Batt.hs b/Plugins/Monitors/Batt.hs
index 03becaa..6ea62a9 100644
--- a/Plugins/Monitors/Batt.hs
+++ b/Plugins/Monitors/Batt.hs
@@ -61,10 +61,7 @@ parseBATT bfs =
return $ if isNaN left then NA else Batt left c0
formatBatt :: Float -> Monitor [String]
-formatBatt x =
- do let f s = floatToPercent (s / 100)
- l <- showWithColors f (x * 100)
- return [l]
+formatBatt x = showPercentsWithColors [x]
runBatt :: [String] -> Monitor String
runBatt = runBatt' ["BAT0","BAT1","BAT2"]
diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs
index 46543e1..2538917 100644
--- a/Plugins/Monitors/Common.hs
+++ b/Plugins/Monitors/Common.hs
@@ -3,7 +3,7 @@
-- Module : Plugins.Monitors.Common
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
---
+--
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
@@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
-module Plugins.Monitors.Common (
+module Plugins.Monitors.Common (
-- * Monitors
-- $monitor
Monitor
@@ -36,6 +36,7 @@ module Plugins.Monitors.Common (
-- ** String Manipulation
-- $strings
, showWithColors
+ , showPercentsWithColors
, takeDigits
, showDigits
, floatToPercent
@@ -49,9 +50,10 @@ module Plugins.Monitors.Common (
import Control.Concurrent
import Control.Monad.Reader
+import Control.Monad (zipWithM)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.IORef
-import qualified Data.Map as Map
+import qualified Data.Map as Map
import Data.List
import Numeric
import Text.ParserCombinators.Parsec
@@ -72,18 +74,19 @@ data MConfig =
, highColor :: IORef (Maybe String)
, template :: IORef String
, export :: IORef [String]
- }
+ , ppad :: IORef Int
+ }
-- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState'
type Selector a = MConfig -> IORef a
sel :: Selector a -> Monitor a
-sel s =
+sel s =
do hs <- ask
liftIO $ readIORef (s hs)
mods :: Selector a -> (a -> a) -> Monitor ()
-mods s m =
+mods s m =
do v <- ask
io $ modifyIORef (s v) m
@@ -106,7 +109,8 @@ mkMConfig tmpl exprts =
hc <- newIORef Nothing
t <- newIORef tmpl
e <- newIORef exprts
- return $ MC nc l lc h hc t e
+ p <- newIORef 0
+ return $ MC nc l lc h hc t e p
data Opts = HighColor String
| NormalColor String
@@ -114,6 +118,7 @@ data Opts = HighColor String
| Low String
| High String
| Template String
+ | PercentPad String
options :: [OptDescr Opts]
options =
@@ -123,9 +128,10 @@ options =
, 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."
+ , Option ['p'] ["ppad"] (ReqArg PercentPad "percent padding" ) "Minimum percentage width."
]
-doArgs :: [String]
+doArgs :: [String]
-> ([String] -> Monitor String)
-> Monitor String
doArgs args action =
@@ -145,6 +151,7 @@ doConfigOptions (o:oo) =
NormalColor nc -> setConfigValue (Just nc) normalColor >> next
LowColor lc -> setConfigValue (Just lc) lowColor >> next
Template t -> setConfigValue t template >> next
+ PercentPad p -> setConfigValue (read p) ppad >> next
runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO ()
runM args conf action r cb = do go
@@ -165,7 +172,7 @@ io = liftIO
-- $parsers
runP :: Parser [a] -> String -> IO [a]
-runP p i =
+runP p i =
do case (parse p "" i) of
Left _ -> return []
Right x -> return x
@@ -193,7 +200,7 @@ getAfterString s =
} <|> return ("<" ++ s ++ " not found!>")
skipTillString :: String -> Parser String
-skipTillString s =
+skipTillString s =
manyTill skipRestOfLine $ string s
-- | Parses the output template string
@@ -203,7 +210,7 @@ templateStringParser =
; com <- templateCommandParser
; ss <- nonPlaceHolder
; return (s, com, ss)
- }
+ }
where
nonPlaceHolder = liftM concat . many $
(many1 $ noneOf "<") <|> colorSpec
@@ -238,14 +245,14 @@ 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
+ 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) =
+combine m ((s,ts,ss):xs) =
s ++ str ++ ss ++ combine m xs
where str = Map.findWithDefault err ts m
err = "<" ++ ts ++ " not found!>"
@@ -255,7 +262,7 @@ combine m ((s,ts,ss):xs) =
type Pos = (Int, Int)
takeDigits :: Int -> Float -> Float
-takeDigits d n =
+takeDigits d n =
fromIntegral ((round (n * fact)) :: Int) / fact
where fact = 10 ^ d
@@ -263,13 +270,17 @@ showDigits :: Int -> Float -> String
showDigits d n =
showFFloat (Just d) n ""
-floatToPercent :: Float -> String
-floatToPercent n =
- showDigits 0 (n * 100) ++ "%"
+floatToPercent :: Float -> Monitor String
+floatToPercent n =
+ do pad <- getConfigValue ppad
+ let p = showDigits 0 (n * 100) ++ "%"
+ plen = length p
+ pstr x = if x > 0 then replicate x ' ' else ""
+ return $ pstr (1 + pad - plen) ++ p
stringParser :: Pos -> B.ByteString -> String
stringParser (x,y) =
- B.unpack . li x . B.words . li y . B.lines
+ B.unpack . li x . B.words . li y . B.lines
where li i l | length l > i = l !! i
| otherwise = B.empty
@@ -286,15 +297,20 @@ showWithColors f x =
do h <- getConfigValue high
l <- getConfigValue low
let col = setColor $ f x
- [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low
+ [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low
head $ [col highColor | x > hh ] ++
[col normalColor | x > ll ] ++
[col lowColor | True]
+showPercentsWithColors :: [Float] -> Monitor [String]
+showPercentsWithColors fs =
+ do fstrs <- mapM floatToPercent fs
+ zipWithM (showWithColors . const) fstrs (map (*100) fs)
+
-- $threads
doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])
-doActionTwiceWithDelay delay action =
+doActionTwiceWithDelay delay action =
do v1 <- newMVar []
forkIO $! getData action v1 0
v2 <- newMVar []
diff --git a/Plugins/Monitors/Cpu.hs b/Plugins/Monitors/Cpu.hs
index 9ab6d8f..e813713 100644
--- a/Plugins/Monitors/Cpu.hs
+++ b/Plugins/Monitors/Cpu.hs
@@ -3,7 +3,7 @@
-- Module : Plugins.Monitors.Cpu
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
---
+--
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
@@ -31,23 +31,19 @@ cpuParser =
map read . map B.unpack . tail . B.words . flip (!!) 0 . B.lines
parseCPU :: IO [Float]
-parseCPU =
+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 :: [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
+formatCpu xs = showPercentsWithColors $ (foldr (+) 0 $ take 3 xs) : xs
runCpu :: [String] -> Monitor String
runCpu _ =
do c <- io $ parseCPU
l <- formatCpu c
- parseTemplate l
+ parseTemplate l
diff --git a/Plugins/Monitors/MultiCpu.hs b/Plugins/Monitors/MultiCpu.hs
index 1c89a76..360671b 100644
--- a/Plugins/Monitors/MultiCpu.hs
+++ b/Plugins/Monitors/MultiCpu.hs
@@ -16,7 +16,7 @@ module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where
import Plugins.Monitors.Common
import qualified Data.ByteString.Lazy.Char8 as B
-import Data.List(isPrefixOf)
+import Data.List (isPrefixOf)
multiCpuConfig :: IO MConfig
multiCpuConfig = mkMConfig
@@ -47,20 +47,14 @@ percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0]
where dif = zipWith (-) b a
tot = foldr (+) 0 dif
-emptyPercs :: [String]
-emptyPercs = repeat " 0%"
-
formatMultiCpus :: [[Float]] -> Monitor [String]
-formatMultiCpus [] = return $ take 15 emptyPercs
+formatMultiCpus [] = showPercentsWithColors $ replicate 15 0.0
formatMultiCpus xs = fmap concat $ mapM formatCpu xs
formatCpu :: [Float] -> Monitor [String]
-formatCpu x
- | length x < 4 = return $ take 5 emptyPercs
- | otherwise = mapM (showWithColors f . (* 100)) (t:x)
- where f = pad . floatToPercent . (/ 100)
- t = foldr (+) 0 $ take 3 x
- pad s = take (4 - length s) " " ++ s
+formatCpu xs
+ | length xs < 4 = showPercentsWithColors $ replicate 5 0.0
+ | otherwise = showPercentsWithColors $ (foldr (+) 0 $ take 3 xs) : xs
runMultiCpu :: [String] -> Monitor String
runMultiCpu _ =
diff --git a/Plugins/Monitors/Swap.hs b/Plugins/Monitors/Swap.hs
index 40c21ed..02acb45 100644
--- a/Plugins/Monitors/Swap.hs
+++ b/Plugins/Monitors/Swap.hs
@@ -3,7 +3,7 @@
-- Module : Plugins.Monitors.Swap
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
---
+--
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
@@ -30,7 +30,7 @@ parseMEM :: IO [Float]
parseMEM =
do file <- fileMEM
let li i l
- | l /= [] = (head l) !! i
+ | l /= [] = (head l) !! i
| otherwise = B.empty
fs s l
| l == [] = False
@@ -41,17 +41,16 @@ parseMEM =
free = get_data "SwapFree:" st
return [tot, (tot - free), free, (tot - free) / tot]
-formatSwap :: [Float] -> Monitor [String]
+formatSwap :: [Float] -> Monitor [String]
formatSwap x =
do let f1 n = showDigits 2 n
- f2 n = floatToPercent n
(hd, tl) = splitAt 3 x
firsts <- mapM (showWithColors f1) hd
- lasts <- mapM (showWithColors f2) tl
+ lasts <- showPercentsWithColors (map (/100) tl)
return $ firsts ++ lasts
runSwap :: [String] -> Monitor String
runSwap _ =
do m <- io $ parseMEM
l <- formatSwap m
- parseTemplate l
+ parseTemplate l