diff options
Diffstat (limited to 'src/Plugins/Monitors/Batt.hs')
| -rw-r--r-- | src/Plugins/Monitors/Batt.hs | 75 |
1 files changed, 53 insertions, 22 deletions
diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs index 4c0232f..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,13 +94,14 @@ sysDir = "/sys/class/power_supply" battConfig :: IO MConfig battConfig = mkMConfig "Batt: <watts>, <left>% / <timeleft>" -- template - ["leftbar", "left", "acstatus", "timeleft", "watts"] -- replacements + ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements data Files = Files { fFull :: String , fNow :: String , fVoltage :: String , fCurrent :: String + , isCurrent :: Bool } | NoFiles data Battery = Battery @@ -103,20 +118,21 @@ batteryFiles :: String -> IO Files batteryFiles bat = do is_charge <- exists "charge_now" is_energy <- if is_charge then return False else exists "energy_now" - is_current <- exists "current_now" - plain <- if is_charge then exists "charge_full" else exists "energy_full" - let cf = if is_current then "current_now" else "power_now" + is_power <- exists "power_now" + 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 - (True, _) -> files "charge" cf sf - (_, True) -> files "energy" cf sf + (True, _) -> files "charge" cf sf is_power + (_, True) -> files "energy" cf sf is_power _ -> NoFiles where prefix = sysDir </> bat exists = safeFileExist prefix - files ch cf sf = Files { fFull = prefix </> ch ++ "_full" ++ sf - , fNow = prefix </> ch ++ "_now" - , fCurrent = prefix </> cf - , fVoltage = prefix </> "voltage_now" } + files ch cf sf ip = Files { fFull = prefix </> ch ++ "_full" ++ sf + , fNow = prefix </> ch ++ "_now" + , fCurrent = prefix </> cf + , fVoltage = prefix </> "voltage_now" + , isCurrent = not ip} haveAc :: FilePath -> IO Bool haveAc f = @@ -129,9 +145,10 @@ readBattery sc files = do a <- grab $ fFull files b <- grab $ fNow files d <- grab $ fCurrent files - return $ Battery (3600 * a / sc) -- wattseconds - (3600 * b / sc) -- wattseconds - (d / sc) -- watts + let sc' = if isCurrent files then sc / 10 else sc + return $ Battery (3600 * a / sc') -- wattseconds + (3600 * b / sc') -- wattseconds + (d / sc') -- watts where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine) onError = const (return (-1)) :: SomeException -> IO Float @@ -147,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"] @@ -163,24 +181,37 @@ runBatt' bfs args = do case c of Result x w t s -> do l <- fmtPercent x - let ts = [fmtTime $ floor t, fmtWatts w opts suffix d] - parseTemplate (l ++ s:ts) - NA -> return "N/A" + ws <- fmtWatts w opts suffix d + 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 let x' = minimum [1, x] p <- showPercentWithColors x' b <- showPercentBar (100 * x') x' - return [b, p] - fmtWatts x o s d = color x o $ showDigits d x ++ (if s then "W" else "") + vb <- showVerticalBar (100 * x') x' + return [b, vb, p] + fmtWatts x o s d = do + ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "") + return $ color x o ws fmtTime :: Integer -> String fmtTime x = hours ++ ":" ++ if length minutes == 2 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' |