New Monitor option to specify minimum percentage width

Ignore-this: 5e0413c218f257c0db06f83665bd2e5
The new option, -p, is a number specifying how many characters the numerical part
of percentages should take. Padding consists of whitespace.
E.g. -p 3 makes '3%' appear as '  3%'. The default value is 0, which means padding
is disabled.

darcs-hash:20100120215608-40885-2c2ac6718af740971dad491eea92947bae840163.gz

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