diff options
Diffstat (limited to 'src/Plugins/Monitors/Common.hs')
| -rw-r--r-- | src/Plugins/Monitors/Common.hs | 146 |
1 files changed, 113 insertions, 33 deletions
diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs index 973c5f9..7d11258 100644 --- a/src/Plugins/Monitors/Common.hs +++ b/src/Plugins/Monitors/Common.hs @@ -23,7 +23,9 @@ module Plugins.Monitors.Common ( , getConfigValue , mkMConfig , runM + , runMD , runMB + , runMBD , io -- * Parsers -- $parsers @@ -38,6 +40,8 @@ module Plugins.Monitors.Common ( , parseTemplate' -- ** String Manipulation -- $strings + , IconPattern + , parseIconPattern , padString , showWithPadding , showWithColors @@ -45,7 +49,11 @@ module Plugins.Monitors.Common ( , showPercentWithColors , showPercentsWithColors , showPercentBar + , showVerticalBar + , showIconPattern , showLogBar + , showLogVBar + , showLogIconPattern , showWithUnits , takeDigits , showDigits @@ -56,11 +64,13 @@ module Plugins.Monitors.Common ( ) where +import Control.Applicative ((<$>)) import Control.Monad.Reader import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef import qualified Data.Map as Map import Data.List +import Data.Char import Numeric import Text.ParserCombinators.Parsec import System.Console.GetOpt @@ -89,6 +99,7 @@ data MConfig = , barFore :: IORef String , barWidth :: IORef Int , useSuffix :: IORef Bool + , naString :: IORef String } -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' @@ -106,7 +117,7 @@ mods s m = setConfigValue :: a -> Selector a -> Monitor () setConfigValue v s = - mods s (\_ -> v) + mods s (const v) getConfigValue :: Selector a -> Monitor a getConfigValue = sel @@ -132,7 +143,8 @@ mkMConfig tmpl exprts = bf <- newIORef "#" bw <- newIORef 10 up <- newIORef False - return $ MC nc l lc h hc t e p d mn mx pc pr bb bf bw up + na <- newIORef "N/A" + return $ MC nc l lc h hc t e p d mn mx pc pr bb bf bw up na data Opts = HighColor String | NormalColor String @@ -151,34 +163,39 @@ data Opts = HighColor String | BarFore String | BarWidth String | UseSuffix String + | NAString 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." - , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes." - , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display." - , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." - , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width" - , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width" - , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width" - , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding" - , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" - , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds" - , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds" - , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width" + 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." + , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes." + , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display." + , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." + , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width" + , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width" + , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width" + , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding" + , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" + , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds" + , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds" + , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width" + , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available" ] -doArgs :: [String] -> ([String] -> Monitor String) -> Monitor String -doArgs args action = +doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String +doArgs args action detect = case getOpt Permute options args of (o, n, []) -> do doConfigOptions o - action n + ready <- detect n + if ready + then action n + else return "<Waiting...>" (_, _, errs) -> return (concat errs) doConfigOptions :: [Opts] -> Monitor () @@ -205,16 +222,25 @@ doConfigOptions (o:oo) = BarBack s -> setConfigValue s barBack BarFore s -> setConfigValue s barFore BarWidth w -> setConfigValue (nz w) barWidth - UseSuffix u -> setConfigValue (bool u) useSuffix) >> next + UseSuffix u -> setConfigValue (bool u) useSuffix + NAString s -> setConfigValue s naString) >> next runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO () runM args conf action r = runMB args conf action (tenthSeconds r) -runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) - -> IO () -> (String -> IO ()) -> IO () -runMB args conf action wait cb = handle (cb . showException) loop - where ac = doArgs args action +runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int + -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () +runMD args conf action r = runMBD args conf action (tenthSeconds r) + +runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () + -> (String -> IO ()) -> IO () +runMB args conf action wait = runMBD args conf action wait (\_ -> return True) + +runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () + -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () +runMBD args conf action wait detect cb = handle (cb . showException) loop + where ac = doArgs args action detect loop = conf >>= runReaderT ac >>= cb >> wait >> loop showException :: SomeException -> String @@ -319,13 +345,25 @@ combine :: Map.Map String String -> [(String, String, String)] -> Monitor String combine _ [] = return [] combine m ((s,ts,ss):xs) = do next <- combine m xs - let str = Map.findWithDefault err ts m - err = "<" ++ ts ++ " not found!>" - nstr <- parseTemplate' str m - return $ s ++ (if null nstr then str else nstr) ++ ss ++ next + str <- case Map.lookup ts m of + Nothing -> return $ "<" ++ ts ++ ">" + Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m + return $ s ++ str ++ ss ++ next -- $strings +type IconPattern = Int -> String + +parseIconPattern :: String -> IconPattern +parseIconPattern path = + let spl = splitOnPercent path + in \i -> concat $ intersperse (show i) spl + where splitOnPercent [] = [[]] + splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs + splitOnPercent (x:xs) = + let rest = splitOnPercent xs + in (x : head rest) : tail rest + type Pos = (Int, Int) takeDigits :: Int -> Float -> Float @@ -431,8 +469,50 @@ showPercentBar v x = do s <- colorizeString v (take len $ cycle bf) return $ s ++ take (bw - len) (cycle bb) +showIconPattern :: Maybe IconPattern -> Float -> Monitor String +showIconPattern Nothing _ = return "" +showIconPattern (Just str) x = return $ str $ convert $ 100 * x + where convert val + | t <= 0 = 0 + | t > 8 = 8 + | otherwise = t + where t = round val `div` 12 + +showVerticalBar :: Float -> Float -> Monitor String +showVerticalBar v x = colorizeString v [convert $ 100 * x] + where convert :: Float -> Char + convert val + | t <= 9600 = ' ' + | t > 9608 = chr 9608 + | otherwise = chr t + where t = 9600 + (round val `div` 12) + showLogBar :: Float -> Float -> Monitor String -showLogBar f v = do +showLogBar f v = + let intConfig c = fromIntegral `fmap` getConfigValue c + in do + h <- intConfig high + l <- intConfig low + bw <- intConfig barWidth + let [ll, hh] = sort [l, h] + choose x | x == 0.0 = 0 + | x <= ll = 1 / bw + | otherwise = f + logBase 2 (x / hh) / bw + showPercentBar v $ choose v + +showLogVBar :: Float -> Float -> Monitor String +showLogVBar f v = do + h <- fromIntegral `fmap` getConfigValue high + l <- fromIntegral `fmap` getConfigValue low + bw <- fromIntegral `fmap` getConfigValue barWidth + let [ll, hh] = sort [l, h] + choose x | x == 0.0 = 0 + | x <= ll = 1 / bw + | otherwise = f + logBase 2 (x / hh) / bw + showVerticalBar v $ choose v + +showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String +showLogIconPattern str f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth @@ -440,4 +520,4 @@ showLogBar f v = do choose x | x == 0.0 = 0 | x <= ll = 1 / bw | otherwise = f + logBase 2 (x / hh) / bw - showPercentBar v $ choose v + showIconPattern str $ choose v |