summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'src/Plugins/Monitors')
-rw-r--r--src/Plugins/Monitors/Batt.hs39
-rw-r--r--src/Plugins/Monitors/Bright.hs40
-rw-r--r--src/Plugins/Monitors/CatInt.hs2
-rw-r--r--src/Plugins/Monitors/Common.hs55
-rw-r--r--src/Plugins/Monitors/CoreTemp.hs6
-rw-r--r--src/Plugins/Monitors/Cpu.hs48
-rw-r--r--src/Plugins/Monitors/CpuFreq.hs8
-rw-r--r--src/Plugins/Monitors/Disk.hs89
-rw-r--r--src/Plugins/Monitors/MPD.hs16
-rw-r--r--src/Plugins/Monitors/Mem.hs71
-rw-r--r--src/Plugins/Monitors/Mpris.hs19
-rw-r--r--src/Plugins/Monitors/MultiCpu.hs55
-rw-r--r--src/Plugins/Monitors/Net.hs89
-rw-r--r--src/Plugins/Monitors/Swap.hs4
-rw-r--r--src/Plugins/Monitors/Thermal.hs13
-rw-r--r--src/Plugins/Monitors/Top.hs4
-rw-r--r--src/Plugins/Monitors/Volume.hs13
-rw-r--r--src/Plugins/Monitors/Weather.hs72
-rw-r--r--src/Plugins/Monitors/Wireless.hs34
19 files changed, 512 insertions, 165 deletions
diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs
index 3eb2051..f7b31e4 100644
--- a/src/Plugins/Monitors/Batt.hs
+++ b/src/Plugins/Monitors/Batt.hs
@@ -34,6 +34,9 @@ data BattOpts = BattOpts
, highThreshold :: Float
, onlineFile :: FilePath
, scale :: Float
+ , onIconPattern :: Maybe IconPattern
+ , offIconPattern :: Maybe IconPattern
+ , idleIconPattern :: Maybe IconPattern
}
defaultOpts :: BattOpts
@@ -49,6 +52,9 @@ defaultOpts = BattOpts
, highThreshold = -10
, onlineFile = "AC/online"
, scale = 1e6
+ , onIconPattern = Nothing
+ , offIconPattern = Nothing
+ , idleIconPattern = Nothing
}
options :: [OptDescr (BattOpts -> BattOpts)]
@@ -64,6 +70,12 @@ options =
, Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") ""
, Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") ""
, Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") ""
+ , Option "" ["on-icon-pattern"] (ReqArg (\x o ->
+ o { onIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["off-icon-pattern"] (ReqArg (\x o ->
+ o { offIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["idle-icon-pattern"] (ReqArg (\x o ->
+ o { idleIconPattern = Just $ parseIconPattern x }) "") ""
]
parseOpts :: [String] -> IO BattOpts
@@ -72,7 +84,9 @@ parseOpts argv =
(o, _, []) -> return $ foldr id defaultOpts o
(_, _, errs) -> ioError . userError $ concat errs
-data Result = Result Float Float Float String | NA
+data Status = Charging | Discharging | Idle
+
+data Result = Result Float Float Float Status | NA
sysDir :: FilePath
sysDir = "/sys/class/power_supply"
@@ -80,7 +94,7 @@ sysDir = "/sys/class/power_supply"
battConfig :: IO MConfig
battConfig = mkMConfig
"Batt: <watts>, <left>% / <timeleft>" -- template
- ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts"] -- replacements
+ ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements
data Files = Files
{ fFull :: String
@@ -105,7 +119,7 @@ batteryFiles bat =
do is_charge <- exists "charge_now"
is_energy <- if is_charge then return False else exists "energy_now"
is_power <- exists "power_now"
- plain <- if is_charge then exists "charge_full" else exists "energy_full"
+ plain <- exists (if is_charge then "charge_full" else "energy_full")
let cf = if is_power then "power_now" else "current_now"
sf = if plain then "" else "_design"
return $ case (is_charge, is_energy) of
@@ -150,9 +164,10 @@ readBatteries opts bfs =
time = if idle then 0 else sum $ map time' bats
mwatts = if idle then 1 else sign * watts
time' b = (if ac then full b - now b else now b) / mwatts
- acstr = if idle then idleString opts else
- if ac then onString opts else offString opts
- return $ if isNaN left then NA else Result left watts time acstr
+ acst | idle = Idle
+ | ac = Charging
+ | otherwise = Discharging
+ return $ if isNaN left then NA else Result left watts time acst
runBatt :: [String] -> Monitor String
runBatt = runBatt' ["BAT0","BAT1","BAT2"]
@@ -167,7 +182,8 @@ runBatt' bfs args = do
Result x w t s ->
do l <- fmtPercent x
ws <- fmtWatts w opts suffix d
- parseTemplate (l ++ [s, fmtTime $ floor t, ws])
+ si <- getIconPattern opts s x
+ parseTemplate (l ++ [fmtStatus opts s, fmtTime $ floor t, ws, si])
NA -> getConfigValue naString
where fmtPercent :: Float -> Monitor [String]
fmtPercent x = do
@@ -184,9 +200,18 @@ runBatt' bfs args = do
then minutes else '0' : minutes
where hours = show (x `div` 3600)
minutes = show ((x `mod` 3600) `div` 60)
+ fmtStatus opts Idle = idleString opts
+ fmtStatus opts Charging = onString opts
+ fmtStatus opts Discharging = offString opts
maybeColor Nothing str = str
maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>"
color x o | x >= 0 = maybeColor (posColor o)
| -x >= highThreshold o = maybeColor (highWColor o)
| -x >= lowThreshold o = maybeColor (mediumWColor o)
| otherwise = maybeColor (lowWColor o)
+ getIconPattern opts status x = do
+ let x' = minimum [1, x]
+ case status of
+ Idle -> showIconPattern (idleIconPattern opts) x'
+ Charging -> showIconPattern (onIconPattern opts) x'
+ Discharging -> showIconPattern (offIconPattern opts) x'
diff --git a/src/Plugins/Monitors/Bright.hs b/src/Plugins/Monitors/Bright.hs
index 1c4cc01..cb510f6 100644
--- a/src/Plugins/Monitors/Bright.hs
+++ b/src/Plugins/Monitors/Bright.hs
@@ -14,6 +14,7 @@
module Plugins.Monitors.Bright (brightConfig, runBright) where
+import Control.Applicative ((<$>))
import Control.Exception (SomeException, handle)
import qualified Data.ByteString.Lazy.Char8 as B
import System.FilePath ((</>))
@@ -25,18 +26,22 @@ import Plugins.Monitors.Common
data BrightOpts = BrightOpts { subDir :: String
, currBright :: String
, maxBright :: String
+ , curBrightIconPattern :: Maybe IconPattern
}
defaultOpts :: BrightOpts
defaultOpts = BrightOpts { subDir = "acpi_video0"
, currBright = "actual_brightness"
, maxBright = "max_brightness"
+ , curBrightIconPattern = Nothing
}
options :: [OptDescr (BrightOpts -> BrightOpts)]
options = [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") ""
, Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") ""
, Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") ""
+ , Option "" ["brightness-icon-pattern"] (ReqArg (\x o ->
+ o { curBrightIconPattern = Just $ parseIconPattern x }) "") ""
]
-- from Batt.hs
@@ -51,7 +56,7 @@ sysDir = "/sys/class/backlight/"
brightConfig :: IO MConfig
brightConfig = mkMConfig "<percent>" -- template
- ["vbar", "percent", "bar"] -- replacements
+ ["vbar", "percent", "bar", "ipat"] -- replacements
data Files = Files { fCurr :: String
, fMax :: String
@@ -60,12 +65,12 @@ data Files = Files { fCurr :: String
brightFiles :: BrightOpts -> IO Files
brightFiles opts = do
- is_curr <- fileExist $ (fCurr files)
- is_max <- fileExist $ (fCurr files)
- if is_curr && is_max then return files else return NoFiles
- where prefix = sysDir </> (subDir opts)
- files = Files { fCurr = prefix </> (currBright opts)
- , fMax = prefix </> (maxBright opts)
+ is_curr <- fileExist $ fCurr files
+ is_max <- fileExist $ fCurr files
+ return (if is_curr && is_max then files else NoFiles)
+ where prefix = sysDir </> subDir opts
+ files = Files { fCurr = prefix </> currBright opts
+ , fMax = prefix </> maxBright opts
}
runBright :: [String] -> Monitor String
@@ -75,19 +80,20 @@ runBright args = do
c <- io $ readBright f
case f of
NoFiles -> return "hurz"
- _ -> fmtPercent c >>= parseTemplate
- where fmtPercent :: Float -> Monitor [String]
- fmtPercent c = do r <- showVerticalBar (100 * c) c
- s <- showPercentWithColors c
- t <- showPercentBar (100 * c) c
- return [r,s,t]
+ _ -> fmtPercent opts c >>= parseTemplate
+ where fmtPercent :: BrightOpts -> Float -> Monitor [String]
+ fmtPercent opts c = do r <- showVerticalBar (100 * c) c
+ s <- showPercentWithColors c
+ t <- showPercentBar (100 * c) c
+ d <- showIconPattern (curBrightIconPattern opts) c
+ return [r,s,t,d]
readBright :: Files -> IO Float
readBright NoFiles = return 0
readBright files = do
- currVal<- grab $ (fCurr files)
- maxVal <- grab $ (fMax files)
- return $ (currVal / maxVal)
- where grab f = handle handler (fmap (read . B.unpack) $ B.readFile f)
+ currVal<- grab $ fCurr files
+ maxVal <- grab $ fMax files
+ return (currVal / maxVal)
+ where grab f = handle handler (read . B.unpack <$> B.readFile f)
handler = const (return 0) :: SomeException -> IO Float
diff --git a/src/Plugins/Monitors/CatInt.hs b/src/Plugins/Monitors/CatInt.hs
index 3d19270..aacbd71 100644
--- a/src/Plugins/Monitors/CatInt.hs
+++ b/src/Plugins/Monitors/CatInt.hs
@@ -20,6 +20,6 @@ catIntConfig = mkMConfig "<v>" ["v"]
runCatInt :: FilePath -> [String] -> Monitor String
runCatInt p _ =
- let failureMessage = "Cannot read: " ++ (show p)
+ let failureMessage = "Cannot read: " ++ show p
fmt x = show (truncate x :: Int)
in checkedDataRetrieval failureMessage [[p]] Nothing id fmt
diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs
index 70f1b5f..7d11258 100644
--- a/src/Plugins/Monitors/Common.hs
+++ b/src/Plugins/Monitors/Common.hs
@@ -40,6 +40,8 @@ module Plugins.Monitors.Common (
, parseTemplate'
-- ** String Manipulation
-- $strings
+ , IconPattern
+ , parseIconPattern
, padString
, showWithPadding
, showWithColors
@@ -48,8 +50,10 @@ module Plugins.Monitors.Common (
, showPercentsWithColors
, showPercentBar
, showVerticalBar
+ , showIconPattern
, showLogBar
, showLogVBar
+ , showLogIconPattern
, showWithUnits
, takeDigits
, showDigits
@@ -60,6 +64,7 @@ module Plugins.Monitors.Common (
) where
+import Control.Applicative ((<$>))
import Control.Monad.Reader
import qualified Data.ByteString.Lazy.Char8 as B
import Data.IORef
@@ -112,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
@@ -342,11 +347,23 @@ combine m ((s,ts,ss):xs) =
do next <- combine m xs
str <- case Map.lookup ts m of
Nothing -> return $ "<" ++ ts ++ ">"
- Just r -> let f "" = r; f n = n; in fmap f $ parseTemplate' r m
+ 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
@@ -452,6 +469,15 @@ 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
@@ -459,10 +485,23 @@ showVerticalBar v x = colorizeString v [convert $ 100 * x]
| t <= 9600 = ' '
| t > 9608 = chr 9608
| otherwise = chr t
- where t = 9600 + ((round val) `div` 12)
+ 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
@@ -470,10 +509,10 @@ 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
+ showVerticalBar v $ choose v
-showLogVBar :: Float -> Float -> Monitor String
-showLogVBar f v = do
+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
@@ -481,4 +520,4 @@ showLogVBar f v = do
choose x | x == 0.0 = 0
| x <= ll = 1 / bw
| otherwise = f + logBase 2 (x / hh) / bw
- showVerticalBar v $ choose v
+ showIconPattern str $ choose v
diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs
index bfe9aca..e19baf0 100644
--- a/src/Plugins/Monitors/CoreTemp.hs
+++ b/src/Plugins/Monitors/CoreTemp.hs
@@ -27,8 +27,8 @@ import Data.Char (isDigit)
coreTempConfig :: IO MConfig
coreTempConfig = mkMConfig
"Temp: <core0>C" -- template
- (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available
- -- replacements
+ (map ((++) "core" . show) [0 :: Int ..]) -- available
+ -- replacements
-- |
-- Function retrieves monitor string holding the core temperature
@@ -39,7 +39,7 @@ runCoreTemp _ = do
failureMessage <- getConfigValue naString
let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"]
path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"]
- lbl = Just ("_label", read . (dropWhile (not . isDigit)))
+ lbl = Just ("_label", read . dropWhile (not . isDigit))
divisor = 1e3 :: Double
show' = showDigits (max 0 dn)
checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show'
diff --git a/src/Plugins/Monitors/Cpu.hs b/src/Plugins/Monitors/Cpu.hs
index 6e83c67..7fed989 100644
--- a/src/Plugins/Monitors/Cpu.hs
+++ b/src/Plugins/Monitors/Cpu.hs
@@ -18,18 +18,40 @@ module Plugins.Monitors.Cpu (startCpu) where
import Plugins.Monitors.Common
import qualified Data.ByteString.Lazy.Char8 as B
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import System.Console.GetOpt
+
+data CpuOpts = CpuOpts
+ { loadIconPattern :: Maybe IconPattern
+ }
+
+defaultOpts :: CpuOpts
+defaultOpts = CpuOpts
+ { loadIconPattern = Nothing
+ }
+
+options :: [OptDescr (CpuOpts -> CpuOpts)]
+options =
+ [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->
+ o { loadIconPattern = Just $ parseIconPattern x }) "") ""
+ ]
+
+parseOpts :: [String] -> IO CpuOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
cpuConfig :: IO MConfig
cpuConfig = mkMConfig
"Cpu: <total>%"
- ["bar","vbar","total","user","nice","system","idle","iowait"]
+ ["bar","vbar","ipat","total","user","nice","system","idle","iowait"]
-type CpuDataRef = IORef [Float]
+type CpuDataRef = IORef [Int]
-cpuData :: IO [Float]
+cpuData :: IO [Int]
cpuData = cpuParser `fmap` B.readFile "/proc/stat"
-cpuParser :: B.ByteString -> [Float]
+cpuParser :: B.ByteString -> [Int]
cpuParser = map (read . B.unpack) . tail . B.words . head . B.lines
parseCpu :: CpuDataRef -> IO [Float]
@@ -38,23 +60,25 @@ parseCpu cref =
b <- cpuData
writeIORef cref b
let dif = zipWith (-) b a
- tot = foldr (+) 0 dif
- percent = map (/ tot) dif
+ tot = fromIntegral $ sum dif
+ percent = map ((/ tot) . fromIntegral) dif
return percent
-formatCpu :: [Float] -> Monitor [String]
-formatCpu [] = return $ replicate 8 ""
-formatCpu xs = do
+formatCpu :: CpuOpts -> [Float] -> Monitor [String]
+formatCpu _ [] = return $ replicate 8 ""
+formatCpu opts xs = do
let t = sum $ take 3 xs
b <- showPercentBar (100 * t) t
v <- showVerticalBar (100 * t) t
+ d <- showIconPattern (loadIconPattern opts) t
ps <- showPercentsWithColors (t:xs)
- return (b:v:ps)
+ return (b:v:d:ps)
runCpu :: CpuDataRef -> [String] -> Monitor String
-runCpu cref _ =
+runCpu cref argv =
do c <- io (parseCpu cref)
- l <- formatCpu c
+ opts <- io $ parseOpts argv
+ l <- formatCpu opts c
parseTemplate l
startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs
index 3fe2577..d3ecf89 100644
--- a/src/Plugins/Monitors/CpuFreq.hs
+++ b/src/Plugins/Monitors/CpuFreq.hs
@@ -24,8 +24,8 @@ import Plugins.Monitors.CoreCommon
cpuFreqConfig :: IO MConfig
cpuFreqConfig = mkMConfig
"Freq: <cpu0>" -- template
- (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available
- -- replacements
+ (map ((++) "cpu" . show) [0 :: Int ..]) -- available
+ -- replacements
-- |
-- Function retrieves monitor string holding the cpu frequency (or frequencies)
@@ -33,7 +33,7 @@ runCpuFreq :: [String] -> Monitor String
runCpuFreq _ = do
let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"]
divisor = 1e6 :: Double
- fmt x | x < 1 = (show (round (x * 1000) :: Integer)) ++ "MHz"
- | otherwise = (show x) ++ "GHz"
+ fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz"
+ | otherwise = show x ++ "GHz"
failureMessage <- getConfigValue naString
checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt
diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs
index e0a7886..0019c1a 100644
--- a/src/Plugins/Monitors/Disk.hs
+++ b/src/Plugins/Monitors/Disk.hs
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Disk
--- Copyright : (c) 2010, 2011, 2012 Jose A Ortega Ruiz
+-- Copyright : (c) 2010, 2011, 2012, 2014 Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
@@ -25,16 +25,67 @@ import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find)
import Data.Maybe (catMaybes)
import System.Directory (canonicalizePath, doesFileExist)
+import System.Console.GetOpt
+
+data DiskIOOpts = DiskIOOpts
+ { totalIconPattern :: Maybe IconPattern
+ , writeIconPattern :: Maybe IconPattern
+ , readIconPattern :: Maybe IconPattern
+ }
+
+parseDiskIOOpts :: [String] -> IO DiskIOOpts
+parseDiskIOOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
+ where defaultOpts = DiskIOOpts
+ { totalIconPattern = Nothing
+ , writeIconPattern = Nothing
+ , readIconPattern = Nothing
+ }
+ options =
+ [ Option "" ["total-icon-pattern"] (ReqArg (\x o ->
+ o { totalIconPattern = Just $ parseIconPattern x}) "") ""
+ , Option "" ["write-icon-pattern"] (ReqArg (\x o ->
+ o { writeIconPattern = Just $ parseIconPattern x}) "") ""
+ , Option "" ["read-icon-pattern"] (ReqArg (\x o ->
+ o { readIconPattern = Just $ parseIconPattern x}) "") ""
+ ]
diskIOConfig :: IO MConfig
diskIOConfig = mkMConfig "" ["total", "read", "write"
,"totalbar", "readbar", "writebar"
,"totalvbar", "readvbar", "writevbar"
+ ,"totalipat", "readipat", "writeipat"
]
+data DiskUOpts = DiskUOpts
+ { freeIconPattern :: Maybe IconPattern
+ , usedIconPattern :: Maybe IconPattern
+ }
+
+parseDiskUOpts :: [String] -> IO DiskUOpts
+parseDiskUOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
+ where defaultOpts = DiskUOpts
+ { freeIconPattern = Nothing
+ , usedIconPattern = Nothing
+ }
+ options =
+ [ Option "" ["free-icon-pattern"] (ReqArg (\x o ->
+ o { freeIconPattern = Just $ parseIconPattern x}) "") ""
+ , Option "" ["used-icon-pattern"] (ReqArg (\x o ->
+ o { usedIconPattern = Just $ parseIconPattern x}) "") ""
+ ]
+
diskUConfig :: IO MConfig
diskUConfig = mkMConfig ""
- ["size", "free", "used", "freep", "usedp", "freebar", "freevbar", "usedbar", "usedvbar"]
+ [ "size", "free", "used", "freep", "usedp"
+ , "freebar", "freevbar", "freeipat"
+ , "usedbar", "usedvbar", "usedipat"
+ ]
type DevName = String
type Path = String
@@ -63,10 +114,10 @@ diskDevices req = do
s <- B.readFile "/proc/diskstats"
parse `fmap` mapM canon (devs s)
where
- canon (d, p) = do {d' <- canonicalizePath (d); return (d', p)}
+ canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
devs = map (third . B.words) . B.lines
parse = map undev . filter isReq
- third (_:_:c:_) = ("/dev/" ++ (B.unpack c), B.unpack c)
+ third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c)
third _ = ("", "")
isReq (d, p) = p `elem` req || drop 5 d `elem` req
undev (d, f) = (drop 5 d, f)
@@ -127,19 +178,22 @@ devTemplates disks mounted dat =
Nothing -> [0, 0, 0]
Just (_, xs) -> xs
-runDiskIO' :: (String, [Float]) -> Monitor String
-runDiskIO' (tmp, xs) = do
+runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String
+runDiskIO' opts (tmp, xs) = do
s <- mapM (showWithColors speedToStr) xs
b <- mapM (showLogBar 0.8) xs
vb <- mapM (showLogVBar 0.8) xs
+ ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v)
+ $ zip [totalIconPattern, readIconPattern, writeIconPattern] xs
setConfigValue tmp template
- parseTemplate $ s ++ b ++ vb
+ parseTemplate $ s ++ b ++ vb ++ ipat
runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
-runDiskIO dref disks _ = do
+runDiskIO dref disks argv = do
+ opts <- io $ parseDiskIOOpts argv
dev <- io $ mountedOrDiskDevices (map fst disks)
dat <- io $ mountedData dref (map fst dev)
- strs <- mapM runDiskIO' $ devTemplates disks dev dat
+ strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat
return $ unwords strs
startDiskIO :: [(String, String)] ->
@@ -160,25 +214,28 @@ fsStats path = do
used = fsStatBytesUsed f
in return [tot, free, used]
-runDiskU' :: String -> String -> Monitor String
-runDiskU' tmp path = do
+runDiskU' :: DiskUOpts -> String -> String -> Monitor String
+runDiskU' opts tmp path = do
setConfigValue tmp template
[total, free, diff] <- io (handle ign $ fsStats path)
- let strs = map sizeToStr [total, free, diff]
+ let strs = map sizeToStr [free, diff]
freep = if total > 0 then free * 100 `div` total else 0
fr = fromIntegral freep / 100
- s <- zipWithM showWithColors' strs [100, freep, 100 - freep]
+ s <- zipWithM showWithColors' strs [freep, 100 - freep]
sp <- showPercentsWithColors [fr, 1 - fr]
fb <- showPercentBar (fromIntegral freep) fr
fvb <- showVerticalBar (fromIntegral freep) fr
+ fipat <- showIconPattern (freeIconPattern opts) fr
ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr)
uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr)
- parseTemplate $ s ++ sp ++ [fb,fvb,ub,uvb]
+ uipat <- showIconPattern (usedIconPattern opts) (1 - fr)
+ parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat]
where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer]
runDiskU :: [(String, String)] -> [String] -> Monitor String
-runDiskU disks _ = do
+runDiskU disks argv = do
devs <- io $ mountedDevices (map fst disks)
- strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs
+ opts <- io $ parseDiskUOpts argv
+ strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs
return $ unwords strs
diff --git a/src/Plugins/Monitors/MPD.hs b/src/Plugins/Monitors/MPD.hs
index ac976f2..5e02587 100644
--- a/src/Plugins/Monitors/MPD.hs
+++ b/src/Plugins/Monitors/MPD.hs
@@ -15,6 +15,7 @@
module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where
import Data.List
+import Data.Maybe (fromMaybe)
import Plugins.Monitors.Common
import System.Console.GetOpt
import qualified Network.MPD as M
@@ -22,7 +23,7 @@ import Control.Concurrent (threadDelay)
mpdConfig :: IO MConfig
mpdConfig = mkMConfig "MPD: <state>"
- [ "bar", "vbar", "state", "statei", "volume", "length"
+ [ "bar", "vbar", "ipat", "state", "statei", "volume", "length"
, "lapsed", "remaining", "plength", "ppos", "file"
, "name", "artist", "composer", "performer"
, "album", "title", "track", "genre"
@@ -32,6 +33,7 @@ data MOpts = MOpts
{ mPlaying :: String
, mStopped :: String
, mPaused :: String
+ , mLapsedIconPattern :: Maybe IconPattern
}
defaultOpts :: MOpts
@@ -39,6 +41,7 @@ defaultOpts = MOpts
{ mPlaying = ">>"
, mStopped = "><"
, mPaused = "||"
+ , mLapsedIconPattern = Nothing
}
options :: [OptDescr (MOpts -> MOpts)]
@@ -46,6 +49,8 @@ options =
[ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""
, Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""
, Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""
+ , Option "" ["lapsed-icon-pattern"] (ReqArg (\x o ->
+ o { mLapsedIconPattern = Just $ parseIconPattern x }) "") ""
]
runMPD :: [String] -> Monitor String
@@ -71,7 +76,7 @@ mpdReady _ = do
-- Only cases where MPD isn't responding is an issue; bogus information at
-- least won't hold xmobar up.
Left M.NoMPD -> return False
- Left M.TimedOut -> return False
+ Left (M.ConnectionError _) -> return False
Left _ -> return True
mopts :: [String] -> IO MOpts
@@ -87,12 +92,13 @@ parseMPD (Right st) song opts = do
songData <- parseSong song
bar <- showPercentBar (100 * b) b
vbar <- showVerticalBar (100 * b) b
- return $ [bar, vbar, ss, si, vol, len, lap, remain, plen, ppos] ++ songData
+ ipat <- showIconPattern (mLapsedIconPattern opts) b
+ return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos] ++ songData
where s = M.stState st
ss = show s
si = stateGlyph s opts
- vol = int2str $ M.stVolume st
- (p, t) = M.stTime st
+ vol = int2str $ fromMaybe 0 (M.stVolume st)
+ (p, t) = fromMaybe (0, 0) (M.stTime st)
[lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)]
b = if t > 0 then realToFrac $ p / fromIntegral t else 0
plen = int2str $ M.stPlaylistLength st
diff --git a/src/Plugins/Monitors/Mem.hs b/src/Plugins/Monitors/Mem.hs
index e409095..403fa43 100644
--- a/src/Plugins/Monitors/Mem.hs
+++ b/src/Plugins/Monitors/Mem.hs
@@ -16,12 +16,44 @@ module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where
import Plugins.Monitors.Common
import qualified Data.Map as M
+import System.Console.GetOpt
+
+data MemOpts = MemOpts
+ { usedIconPattern :: Maybe IconPattern
+ , freeIconPattern :: Maybe IconPattern
+ , availableIconPattern :: Maybe IconPattern
+ }
+
+defaultOpts :: MemOpts
+defaultOpts = MemOpts
+ { usedIconPattern = Nothing
+ , freeIconPattern = Nothing
+ , availableIconPattern = Nothing
+ }
+
+options :: [OptDescr (MemOpts -> MemOpts)]
+options =
+ [ Option "" ["used-icon-pattern"] (ReqArg (\x o ->
+ o { usedIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["free-icon-pattern"] (ReqArg (\x o ->
+ o { freeIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["available-icon-pattern"] (ReqArg (\x o ->
+ o { availableIconPattern = Just $ parseIconPattern x }) "") ""
+ ]
+
+parseOpts :: [String] -> IO MemOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
memConfig :: IO MConfig
memConfig = mkMConfig
"Mem: <usedratio>% (<cache>M)" -- template
- ["usedbar", "usedvbar", "freebar", "freevbar", "usedratio", "freeratio", "total",
- "free", "buffer", "cache", "rest", "used"] -- available replacements
+ ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat",
+ "availablebar", "availablevbar", "availableipat",
+ "usedratio", "freeratio", "availableratio",
+ "total", "free", "buffer", "cache", "available", "used"] -- available replacements
fileMEM :: IO String
fileMEM = readFile "/proc/meminfo"
@@ -30,13 +62,14 @@ parseMEM :: IO [Float]
parseMEM =
do file <- fileMEM
let content = map words $ take 8 $ lines file
- info = M.fromList $ map (\line -> (line !! 0, (read $ line !! 1 :: Float) / 1024)) content
+ info = M.fromList $ map (\line -> (head line, (read $ line !! 1 :: Float) / 1024)) content
[total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"]
- rest = free + buffer + cache
- used = total - (M.findWithDefault rest "MemAvailable:" info)
+ available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info
+ used = total - available
usedratio = used / total
freeratio = free / total
- return [usedratio, freeratio, total, free, buffer, cache, rest, used, freeratio]
+ availableratio = available / total
+ return [usedratio, freeratio, availableratio, total, free, buffer, cache, available, used]
totalMem :: IO Float
totalMem = fmap ((*1024) . (!!1)) parseMEM
@@ -44,22 +77,20 @@ totalMem = fmap ((*1024) . (!!1)) parseMEM
usedMem :: IO Float
usedMem = fmap ((*1024) . (!!6)) parseMEM
-formatMem :: [Float] -> Monitor [String]
-formatMem (r:fr:xs) =
+formatMem :: MemOpts -> [Float] -> Monitor [String]
+formatMem opts (r:fr:ar:xs) =
do let f = showDigits 0
- rr = 100 * r
- ub <- showPercentBar rr r
- uvb <- showVerticalBar rr r
- fb <- showPercentBar (100 - rr) (1 - r)
- fvb <- showVerticalBar (100 - rr) ( 1 - r)
- rs <- showPercentWithColors r
- fs <- showPercentWithColors fr
- s <- mapM (showWithColors f) xs
- return (ub:uvb:fb:fvb:rs:fs:s)
-formatMem _ = replicate 10 `fmap` getConfigValue naString
+ mon i x = [showPercentBar (100 * x) x, showVerticalBar (100 * x) x, showIconPattern i x]
+ sequence $ mon (usedIconPattern opts) r
+ ++ mon (freeIconPattern opts) fr
+ ++ mon (availableIconPattern opts) ar
+ ++ map showPercentWithColors [r, fr, ar]
+ ++ map (showWithColors f) xs
+formatMem _ _ = replicate 10 `fmap` getConfigValue naString
runMem :: [String] -> Monitor String
-runMem _ =
+runMem argv =
do m <- io parseMEM
- l <- formatMem m
+ opts <- io $ parseOpts argv
+ l <- formatMem opts m
parseTemplate l
diff --git a/src/Plugins/Monitors/Mpris.hs b/src/Plugins/Monitors/Mpris.hs
index 98b4c0f..245c0df 100644
--- a/src/Plugins/Monitors/Mpris.hs
+++ b/src/Plugins/Monitors/Mpris.hs
@@ -25,6 +25,7 @@ import Text.Printf (printf)
import DBus
import qualified DBus.Client as DC
+import Control.Arrow ((***))
import Data.Maybe ( fromJust )
import Data.Int ( Int32, Int64 )
import System.IO.Unsafe (unsafePerformIO)
@@ -43,10 +44,10 @@ instance MprisVersion MprisVersion1 where
{ methodCallDestination = Just busName
}
where
- busName = busName_ $ "org.mpris." ++ p
- objectPath = objectPath_ $ "/Player"
- interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer"
- memberName = memberName_ $ "GetMetadata"
+ busName = busName_ $ "org.mpris." ++ p
+ objectPath = objectPath_ "/Player"
+ interfaceName = interfaceName_ "org.freedesktop.MediaPlayer"
+ memberName = memberName_ "GetMetadata"
fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title"
, "tracknumber" ]
@@ -58,10 +59,10 @@ instance MprisVersion MprisVersion2 where
, methodCallBody = arguments
}
where
- busName = busName_ $ "org.mpris.MediaPlayer2." ++ p
- objectPath = objectPath_ $ "/org/mpris/MediaPlayer2"
- interfaceName = interfaceName_ $ "org.freedesktop.DBus.Properties"
- memberName = memberName_ $ "Get"
+ busName = busName_ $ "org.mpris.MediaPlayer2." ++ p
+ objectPath = objectPath_ "/org/mpris/MediaPlayer2"
+ interfaceName = interfaceName_ "org.freedesktop.DBus.Properties"
+ memberName = memberName_ "Get"
arguments = map (toVariant::String -> Variant)
["org.mpris.MediaPlayer2.Player", "Metadata"]
@@ -98,7 +99,7 @@ fromVar = fromJust . fromVariant
unpackMetadata :: [Variant] -> [(String, Variant)]
unpackMetadata [] = []
-unpackMetadata xs = ((map (\(k, v) -> (fromVar k, fromVar v))) . unpack . head) xs where
+unpackMetadata xs = (map (fromVar *** fromVar) . unpack . head) xs where
unpack v = case variantType v of
TypeDictionary _ _ -> dictionaryItems $ fromVar v
TypeVariant -> unpack $ fromVar v
diff --git a/src/Plugins/Monitors/MultiCpu.hs b/src/Plugins/Monitors/MultiCpu.hs
index 429c38a..eab21da 100644
--- a/src/Plugins/Monitors/MultiCpu.hs
+++ b/src/Plugins/Monitors/MultiCpu.hs
@@ -15,12 +15,39 @@
module Plugins.Monitors.MultiCpu (startMultiCpu) where
import Plugins.Monitors.Common
+import Control.Applicative ((<$>))
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, transpose, unfoldr)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import System.Console.GetOpt
+
+data MultiCpuOpts = MultiCpuOpts
+ { loadIconPatterns :: [IconPattern]
+ , loadIconPattern :: Maybe IconPattern
+ }
+
+defaultOpts :: MultiCpuOpts
+defaultOpts = MultiCpuOpts
+ { loadIconPatterns = []
+ , loadIconPattern = Nothing
+ }
+
+options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
+options =
+ [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->
+ o { loadIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["load-icon-patterns"] (ReqArg (\x o ->
+ o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") ""
+ ]
+
+parseOpts :: [String] -> IO MultiCpuOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
variables :: [String]
-variables = ["bar", "vbar","total","user","nice","system","idle"]
+variables = ["bar", "vbar","ipat","total","user","nice","system","idle"]
vNum :: Int
vNum = length variables
@@ -52,20 +79,25 @@ parseCpuData cref =
percent :: [Float] -> [Float] -> [Float]
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
+ tot = sum dif
-formatMultiCpus :: [[Float]] -> Monitor [String]
-formatMultiCpus [] = return []
-formatMultiCpus xs = fmap concat $ mapM formatCpu xs
+formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String]
+formatMultiCpus _ [] = return []
+formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs)
-formatCpu :: [Float] -> Monitor [String]
-formatCpu xs
+formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String]
+formatCpu opts i xs
| length xs < 4 = showPercentsWithColors $ replicate vNum 0.0
- | otherwise = let t = foldr (+) 0 $ take 3 xs
+ | otherwise = let t = sum $ take 3 xs
in do b <- showPercentBar (100 * t) t
h <- showVerticalBar (100 * t) t
+ d <- showIconPattern tryString t
ps <- showPercentsWithColors (t:xs)
- return (b:h:ps)
+ return (b:h:d:ps)
+ where tryString
+ | i == 0 = loadIconPattern opts
+ | i <= length (loadIconPatterns opts) = Just $ (loadIconPatterns opts) !! (i - 1)
+ | otherwise = Nothing
splitEvery :: (Eq a) => Int -> [a] -> [[a]]
splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x)
@@ -78,9 +110,10 @@ formatAutoCpus [] = return $ replicate vNum ""
formatAutoCpus xs = return $ map unwords (groupData xs)
runMultiCpu :: CpuDataRef -> [String] -> Monitor String
-runMultiCpu cref _ =
+runMultiCpu cref argv =
do c <- io $ parseCpuData cref
- l <- formatMultiCpus c
+ opts <- io $ parseOpts argv
+ l <- formatMultiCpus opts c
a <- formatAutoCpus l
parseTemplate $ a ++ l
diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs
index e49d1aa..5954a77 100644
--- a/src/Plugins/Monitors/Net.hs
+++ b/src/Plugins/Monitors/Net.hs
@@ -22,12 +22,47 @@ import Plugins.Monitors.Common
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
-import Control.Monad (forM, filterM)
+import Control.Monad (forM, filterM, liftM)
import System.Directory (getDirectoryContents, doesFileExist)
import System.FilePath ((</>))
+import System.Console.GetOpt
import qualified Data.ByteString.Lazy.Char8 as B
+data NetOpts = NetOpts
+ { rxIconPattern :: Maybe IconPattern
+ , txIconPattern :: Maybe IconPattern
+ }
+
+defaultOpts :: NetOpts
+defaultOpts = NetOpts
+ { rxIconPattern = Nothing
+ , txIconPattern = Nothing
+ }
+
+options :: [OptDescr (NetOpts -> NetOpts)]
+options =
+ [ Option "" ["rx-icon-pattern"] (ReqArg (\x o ->
+ o { rxIconPattern = Just $ parseIconPattern x }) "") ""
+ , Option "" ["tx-icon-pattern"] (ReqArg (\x o ->
+ o { txIconPattern = Just $ parseIconPattern x }) "") ""
+ ]
+
+parseOpts :: [String] -> IO NetOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
+
+data UnitPerSec = Bs | KBs | MBs | GBs deriving (Eq,Enum,Ord)
+data NetValue = NetValue Float UnitPerSec deriving (Eq,Show)
+
+instance Show UnitPerSec where
+ show Bs = "B/s"
+ show KBs = "KB/s"
+ show MBs = "MB/s"
+ show GBs = "GB/s"
+
data NetDev = NA
| NI String
| ND String Float Float deriving (Eq,Show,Read)
@@ -42,8 +77,8 @@ instance Ord NetDev where
compare NA _ = LT
compare _ NA = GT
compare (NI _) (NI _) = EQ
- compare (NI _) (ND _ _ _) = LT
- compare (ND _ _ _) (NI _) = GT
+ compare (NI _) (ND {}) = LT
+ compare (ND {}) (NI _) = GT
compare (ND _ x1 y1) (ND _ x2 y2) =
if downcmp /= EQ
then downcmp
@@ -53,7 +88,7 @@ instance Ord NetDev where
netConfig :: IO MConfig
netConfig = mkMConfig
"<dev>: <rx>KB|<tx>KB" -- template
- ["dev", "rx", "tx", "rxbar", "rxvbar", "txbar", "txvbar"] -- available replacements
+ ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"] -- available replacements
operstateDir :: String -> FilePath
operstateDir d = "/sys/class/net" </> d </> "operstate"
@@ -74,7 +109,7 @@ readNetDev (d:x:y:_) = do
up <- isUp d
return (if up then ND d (r x) (r y) else NI d)
where r s | s == "" = 0
- | otherwise = read s / 1024
+ | otherwise = read s
readNetDev _ = return NA
@@ -97,23 +132,26 @@ findNetDev dev = do
isDev (NI d) = d == dev
isDev NA = False
-formatNet :: Float -> Monitor (String, String, String)
-formatNet d = do
+formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String)
+formatNet mipat d = do
s <- getConfigValue useSuffix
dd <- getConfigValue decDigits
- let str = if s then (++"Kb/s") . showDigits dd else showDigits dd
+ let str True v = showDigits dd d' ++ show u
+ where (NetValue d' u) = byteNetVal v
+ str False v = showDigits dd $ v / 1024
b <- showLogBar 0.9 d
vb <- showLogVBar 0.9 d
- x <- showWithColors str d
- return (x, b, vb)
+ ipat <- showLogIconPattern mipat 0.9 d
+ x <- showWithColors (str s) d
+ return (x, b, vb, ipat)
-printNet :: NetDev -> Monitor String
-printNet nd =
+printNet :: NetOpts -> NetDev -> Monitor String
+printNet opts nd =
case nd of
ND d r t -> do
- (rx, rb, rvb) <- formatNet r
- (tx, tb, tvb) <- formatNet t
- parseTemplate [d,rx,tx,rb,rvb,tb,tvb]
+ (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r
+ (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t
+ parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat]
NI _ -> return ""
NA -> getConfigValue naString
@@ -133,14 +171,20 @@ parseNet nref nd = do
return $ diffRate n0 n1
runNet :: NetDevRef -> String -> [String] -> Monitor String
-runNet nref i _ = io (parseNet nref i) >>= printNet
+runNet nref i argv = do
+ dev <- io $ parseNet nref i
+ opts <- io $ parseOpts argv
+ printNet opts dev
parseNets :: [(NetDevRef, String)] -> IO [NetDev]
-parseNets = mapM $ \(ref, i) -> parseNet ref i
+parseNets = mapM $ uncurry parseNet
runNets :: [(NetDevRef, String)] -> [String] -> Monitor String
-runNets refs _ = io (parseActive refs) >>= printNet
- where parseActive refs' = parseNets refs' >>= return . selectActive
+runNets refs argv = do
+ dev <- io $ parseActive refs
+ opts <- io $ parseOpts argv
+ printNet opts dev
+ where parseActive refs' = liftM selectActive (parseNets refs')
selectActive = maximum
startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
@@ -159,3 +203,10 @@ startDynNet a r cb = do
_ <- parseNet nref d
return (nref, d)
runM a netConfig (runNets refs) r cb
+
+byteNetVal :: Float -> NetValue
+byteNetVal v
+ | v < 1024**1 = NetValue v Bs
+ | v < 1024**2 = NetValue (v/1024**1) KBs
+ | v < 1024**3 = NetValue (v/1024**2) MBs
+ | otherwise = NetValue (v/1024**3) GBs
diff --git a/src/Plugins/Monitors/Swap.hs b/src/Plugins/Monitors/Swap.hs
index 107eb1e..b6c5019 100644
--- a/src/Plugins/Monitors/Swap.hs
+++ b/src/Plugins/Monitors/Swap.hs
@@ -33,8 +33,8 @@ parseMEM =
| l /= [] = head l !! i
| otherwise = B.empty
fs s l
- | l == [] = False
- | otherwise = head l == B.pack s
+ | null l = False
+ | otherwise = head l == B.pack s
get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s)
st = map B.words . B.lines $ file
tot = get_data "SwapTotal:" st
diff --git a/src/Plugins/Monitors/Thermal.hs b/src/Plugins/Monitors/Thermal.hs
index a3ffe6d..6013511 100644
--- a/src/Plugins/Monitors/Thermal.hs
+++ b/src/Plugins/Monitors/Thermal.hs
@@ -14,6 +14,7 @@
module Plugins.Monitors.Thermal where
+import Control.Monad (liftM)
import qualified Data.ByteString.Lazy.Char8 as B
import Plugins.Monitors.Common
import System.Posix.Files (fileExist)
@@ -32,11 +33,9 @@ runThermal args = do
let zone = head args
file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature"
exists <- io $ fileExist file
- case exists of
- False -> return $ "Thermal (" ++ zone ++ "): N/A"
- True -> do number <- io $ B.readFile file
- >>= return . (read :: String -> Int)
- . stringParser (1, 0)
- thermal <- showWithColors show number
- parseTemplate [ thermal ]
+ if exists
+ then do number <- io $ liftM ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file)
+ thermal <- showWithColors show number
+ parseTemplate [ thermal ]
+ else return $ "Thermal (" ++ zone ++ "): N/A"
diff --git a/src/Plugins/Monitors/Top.hs b/src/Plugins/Monitors/Top.hs
index 6be3c1c..3d246ff 100644
--- a/src/Plugins/Monitors/Top.hs
+++ b/src/Plugins/Monitors/Top.hs
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Top
--- Copyright : (c) Jose A Ortega Ruiz
+-- Copyright : (c) 2010, 2011, 2012, 2013, 2014 Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
@@ -101,7 +101,7 @@ meminfos = handleProcesses meminfo
showMemInfo :: Float -> MemInfo -> Monitor [String]
showMemInfo scale (nm, rss) =
- showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc)
+ showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc)
where sc = if scale > 0 then scale else 100
showMemInfos :: [MemInfo] -> Monitor [[String]]
diff --git a/src/Plugins/Monitors/Volume.hs b/src/Plugins/Monitors/Volume.hs
index 22b7f6c..8c39b9f 100644
--- a/src/Plugins/Monitors/Volume.hs
+++ b/src/Plugins/Monitors/Volume.hs
@@ -24,7 +24,7 @@ import System.Console.GetOpt
volumeConfig :: IO MConfig
volumeConfig = mkMConfig "Vol: <volume>% <status>"
- ["volume", "volumebar", "volumevbar", "dB","status"]
+ ["volume", "volumebar", "volumevbar", "dB","status", "volumeipat"]
data VolumeOpts = VolumeOpts
@@ -34,6 +34,7 @@ data VolumeOpts = VolumeOpts
, offColor :: Maybe String
, highDbThresh :: Float
, lowDbThresh :: Float
+ , volumeIconPattern :: Maybe IconPattern
}
defaultOpts :: VolumeOpts
@@ -44,6 +45,7 @@ defaultOpts = VolumeOpts
, offColor = Just "red"
, highDbThresh = -5.0
, lowDbThresh = -30.0
+ , volumeIconPattern = Nothing
}
options :: [OptDescr (VolumeOpts -> VolumeOpts)]
@@ -54,6 +56,8 @@ options =
, Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") ""
, Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") ""
, Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") ""
+ , Option "" ["volume-icon-pattern"] (ReqArg (\x o ->
+ o { volumeIconPattern = Just $ parseIconPattern x }) "") ""
]
parseOpts :: [String] -> IO VolumeOpts
@@ -80,6 +84,10 @@ formatVolVBar :: Integer -> Integer -> Integer -> Monitor String
formatVolVBar lo hi v =
showVerticalBar (100 * x) x where x = percent v lo hi
+formatVolDStr :: Maybe IconPattern -> Integer -> Integer -> Integer -> Monitor String
+formatVolDStr ipat lo hi v =
+ showIconPattern ipat $ percent v lo hi
+
switchHelper :: VolumeOpts
-> (VolumeOpts -> Maybe String)
-> (VolumeOpts -> String)
@@ -126,7 +134,8 @@ runVolume mixerName controlName argv = do
v <- liftMonitor $ liftM3 formatVolVBar lo hi val
d <- getFormatDB opts db
s <- getFormatSwitch opts sw
- parseTemplate [p, b, v, d, s]
+ ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val
+ parseTemplate [p, b, v, d, s, ipat]
where
diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs
index dfc421e..3cfbc74 100644
--- a/src/Plugins/Monitors/Weather.hs
+++ b/src/Plugins/Monitors/Weather.hs
@@ -22,7 +22,6 @@ import Network.HTTP
import Text.ParserCombinators.Parsec
-
weatherConfig :: IO MConfig
weatherConfig = mkMConfig
"<station>: <tempC>C, rh <rh>% (<hour>)" -- template
@@ -32,12 +31,16 @@ weatherConfig = mkMConfig
, "month"
, "day"
, "hour"
- , "wind"
+ , "windCardinal"
+ , "windAzimuth"
+ , "windMph"
+ , "windKnots"
, "visibility"
, "skyCondition"
, "tempC"
, "tempF"
- , "dewPoint"
+ , "dewPointC"
+ , "dewPointF"
, "rh"
, "pressure"
]
@@ -49,12 +52,16 @@ data WeatherInfo =
, month :: String
, day :: String
, hour :: String
- , wind :: String
+ , windCardinal :: String
+ , windAzimuth :: String
+ , windMph :: String
+ , windKnots :: String
, visibility :: String
, skyCondition :: String
, tempC :: Int
, tempF :: Int
- , dewPoint :: String
+ , dewPointC :: Int
+ , dewPointF :: Int
, humidity :: Int
, pressure :: Int
} deriving (Show)
@@ -68,7 +75,41 @@ pTime = do y <- getNumbersAsString
char ' '
(h:hh:mi:mimi) <- getNumbersAsString
char ' '
- return (y, m, d ,([h]++[hh]++":"++[mi]++mimi))
+ return (y, m, d ,h:hh:":"++mi:mimi)
+
+-- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0"
+pWind0 ::
+ (
+ String -- cardinal direction
+ , String -- azimuth direction
+ , String -- speed (MPH)
+ , String -- speed (knot)
+ )
+pWind0 =
+ ("μ", "μ", "0", "0")
+
+pWind ::
+ Parser (
+ String -- cardinal direction
+ , String -- azimuth direction
+ , String -- speed (MPH)
+ , String -- speed (knot)
+ )
+pWind =
+ let tospace = manyTill anyChar (char ' ')
+ wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0")
+ return pWind0
+ wind = do manyTill skipRestOfLine (string "Wind: from the ")
+ cardinal <- tospace
+ char '('
+ azimuth <- tospace
+ string "degrees) at "
+ mph <- tospace
+ string "MPH ("
+ knot <- tospace
+ manyTill anyChar newline
+ return (cardinal, azimuth, mph, knot)
+ in try wind0 <|> wind
pTemp :: Parser (Int, Int)
pTemp = do let num = digit <|> char '-' <|> char '.'
@@ -76,10 +117,10 @@ pTemp = do let num = digit <|> char '-' <|> char '.'
manyTill anyChar $ char '('
c <- manyTill num $ char ' '
skipRestOfLine
- return $ (floor (read c :: Double), floor (read f :: Double))
+ return (floor (read c :: Double), floor (read f :: Double))
pRh :: Parser Int
-pRh = do s <- manyTill digit $ (char '%' <|> char '.')
+pRh = do s <- manyTill digit (char '%' <|> char '.')
return $ read s
pPressure :: Parser Int
@@ -112,18 +153,19 @@ parseData =
)
skipRestOfLine >> getAllBut "/"
(y,m,d,h) <- pTime
- w <- getAfterString "Wind: "
+ (wc, wa, wm, wk) <- pWind
v <- getAfterString "Visibility: "
sk <- getAfterString "Sky conditions: "
skipTillString "Temperature: "
(tC,tF) <- pTemp
- dp <- getAfterString "Dew Point: "
+ skipTillString "Dew Point: "
+ (dC, dF) <- pTemp
skipTillString "Relative Humidity: "
rh <- pRh
skipTillString "Pressure (altimeter): "
p <- pPressure
manyTill skipRestOfLine eof
- return $ [WI st ss y m d h w v sk tC tF dp rh p]
+ return [WI st ss y m d h wc wa wm wk v sk tC tF dC dF rh p]
defUrl :: String
defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"
@@ -139,10 +181,10 @@ getData station = do
errHandler _ = return "<Could not retrieve data>"
formatWeather :: [WeatherInfo] -> Monitor String
-formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] =
+formatWeather [WI st ss y m d h wc wa wm wk v sk tC tF dC dF r p] =
do cel <- showWithColors show tC
far <- showWithColors show tF
- parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ]
+ parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, v, sk, cel, far, show dC, show dF, show r , show p ]
formatWeather _ = getConfigValue naString
runWeather :: [String] -> Monitor String
@@ -158,10 +200,10 @@ weatherReady str = do
io $ CE.catch (simpleHTTP request >>= checkResult) errHandler
where errHandler :: CE.IOException -> IO Bool
errHandler _ = return False
- checkResult result = do
+ checkResult result =
case result of
Left _ -> return False
- Right response -> do
+ Right response ->
case rspCode response of
-- Permission or network errors are failures; anything
-- else is recoverable.
diff --git a/src/Plugins/Monitors/Wireless.hs b/src/Plugins/Monitors/Wireless.hs
index c6e6b44..b1e3c7e 100644
--- a/src/Plugins/Monitors/Wireless.hs
+++ b/src/Plugins/Monitors/Wireless.hs
@@ -14,15 +14,39 @@
module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where
+import System.Console.GetOpt
+
import Plugins.Monitors.Common
import IWlib
+data WirelessOpts = WirelessOpts
+ { qualityIconPattern :: Maybe IconPattern
+ }
+
+defaultOpts :: WirelessOpts
+defaultOpts = WirelessOpts
+ { qualityIconPattern = Nothing
+ }
+
+options :: [OptDescr (WirelessOpts -> WirelessOpts)]
+options =
+ [ Option "" ["quality-icon-pattern"] (ReqArg (\d opts ->
+ opts { qualityIconPattern = Just $ parseIconPattern d }) "") ""
+ ]
+
+parseOpts :: [String] -> IO WirelessOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
+
wirelessConfig :: IO MConfig
wirelessConfig =
- mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar"]
+ mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar", "qualityvbar", "qualityipat"]
-runWireless :: [String] -> Monitor String
-runWireless (iface:_) = do
+runWireless :: String -> [String] -> Monitor String
+runWireless iface args = do
+ opts <- io $ parseOpts args
wi <- io $ getWirelessInfo iface
na <- getConfigValue naString
let essid = wiEssid wi
@@ -34,5 +58,5 @@ runWireless (iface:_) = do
else showWithPadding ""
qb <- showPercentBar qlty (qlty / 100)
qvb <- showVerticalBar qlty (qlty / 100)
- parseTemplate [ep, q, qb, qvb]
-runWireless _ = getConfigValue naString
+ qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100)
+ parseTemplate [ep, q, qb, qvb, qipat]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 04:51:52 +0000