summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/Monitors/Common.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Plugins/Monitors/Common.hs')
-rw-r--r--src/Plugins/Monitors/Common.hs146
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 23:57:40 +0000