diff options
| -rw-r--r-- | Plugins/Monitors/Batt.hs | 5 | ||||
| -rw-r--r-- | Plugins/Monitors/Common.hs | 58 | ||||
| -rw-r--r-- | Plugins/Monitors/Cpu.hs | 14 | ||||
| -rw-r--r-- | Plugins/Monitors/MultiCpu.hs | 16 | ||||
| -rw-r--r-- | Plugins/Monitors/Swap.hs | 11 |
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 |