1{-# LANGUAGE CPP #-} 2 3----------------------------------------------------------------------------- 4-- | 5-- Module : Plugins.Monitors.Batt 6-- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega 7-- (c) 2010 Andrea Rossato, Petr Rockai 8-- License : BSD-style (see LICENSE) 9-- 10-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> 11-- Stability : unstable 12-- Portability : unportable 13-- 14-- A battery monitor for Xmobar 15-- 16----------------------------------------------------------------------------- 17 18module Xmobar.Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where 19 20import System.Process (system) 21import Control.Monad (void, unless) 22import Xmobar.Plugins.Monitors.Common 23import Control.Exception (SomeException, handle) 24import System.FilePath ((</>)) 25import System.IO (IOMode(ReadMode), hGetLine, withFile) 26import System.Posix.Files (fileExist) 27#ifdef FREEBSD 28import System.BSD.Sysctl (sysctlReadInt) 29#endif 30import System.Console.GetOpt 31import Data.List (sort, sortBy, group) 32import Data.Maybe (fromMaybe) 33import Data.Ord (comparing) 34import Text.Read (readMaybe) 35 36data BattOpts = BattOpts 37 { onString :: String 38 , offString :: String 39 , idleString :: String 40 , posColor :: Maybe String 41 , lowWColor :: Maybe String 42 , mediumWColor :: Maybe String 43 , highWColor :: Maybe String 44 , lowThreshold :: Float 45 , highThreshold :: Float 46 , onLowAction :: Maybe String 47 , actionThreshold :: Float 48 , onlineFile :: FilePath 49 , scale :: Float 50 , onIconPattern :: Maybe IconPattern 51 , offIconPattern :: Maybe IconPattern 52 , idleIconPattern :: Maybe IconPattern 53 , lowString :: String 54 , mediumString :: String 55 , highString :: String 56 , incPerc :: Bool 57 } 58 59defaultOpts :: BattOpts 60defaultOpts = BattOpts 61 { onString = "On" 62 , offString = "Off" 63 , idleString = "On" 64 , posColor = Nothing 65 , lowWColor = Nothing 66 , mediumWColor = Nothing 67 , highWColor = Nothing 68 , onLowAction = Nothing 69 , actionThreshold = 6 70 , lowThreshold = 10 71 , highThreshold = 12 72 , onlineFile = "AC/online" 73 , scale = 1e6 74 , onIconPattern = Nothing 75 , offIconPattern = Nothing 76 , idleIconPattern = Nothing 77 , lowString = "" 78 , mediumString = "" 79 , highString = "" 80 , incPerc = False 81 } 82 83options :: [OptDescr (BattOpts -> BattOpts)] 84options = 85 [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" 86 , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") "" 87 , Option "i" ["idle"] (ReqArg (\x o -> o { idleString = x }) "") "" 88 , Option "p" ["positive"] (ReqArg (\x o -> o { posColor = Just x }) "") "" 89 , Option "l" ["low"] (ReqArg (\x o -> o { lowWColor = Just x }) "") "" 90 , Option "m" ["medium"] (ReqArg (\x o -> o { mediumWColor = Just x }) "") "" 91 , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") "" 92 , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") "" 93 , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" 94 , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") "" 95 , Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") "" 96 , Option "a" ["action"] (ReqArg (\x o -> o { onLowAction = Just x }) "") "" 97 , Option "P" ["percent"] (NoArg (\o -> o {incPerc = True})) "" 98 , Option "A" ["action-threshold"] 99 (ReqArg (\x o -> o { actionThreshold = read x }) "") "" 100 , Option "" ["on-icon-pattern"] (ReqArg (\x o -> 101 o { onIconPattern = Just $ parseIconPattern x }) "") "" 102 , Option "" ["off-icon-pattern"] (ReqArg (\x o -> 103 o { offIconPattern = Just $ parseIconPattern x }) "") "" 104 , Option "" ["idle-icon-pattern"] (ReqArg (\x o -> 105 o { idleIconPattern = Just $ parseIconPattern x }) "") "" 106 , Option "" ["lows"] (ReqArg (\x o -> o { lowString = x }) "") "" 107 , Option "" ["mediums"] (ReqArg (\x o -> o { mediumString = x }) "") "" 108 , Option "" ["highs"] (ReqArg (\x o -> o { highString = x }) "") "" 109 ] 110 111data Status = Charging | Discharging | Full | Idle | Unknown deriving (Read, Eq) 112-- Result perc watts time-seconds Status 113data Result = Result Float Float Float Status | NA 114 115sysDir :: FilePath 116sysDir = "/sys/class/power_supply" 117 118battConfig :: IO MConfig 119battConfig = mkMConfig 120 "Batt: <watts>, <left>% / <timeleft>" -- template 121 ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements 122 123data Files = Files 124 { fFull :: String 125 , fNow :: String 126 , fVoltage :: String 127 , fCurrent :: String 128 , fStatus :: String 129 , isCurrent :: Bool 130 } | NoFiles deriving Eq 131 132data Battery = Battery 133 { full :: !Float 134 , now :: !Float 135 , power :: !Float 136 , status :: !String 137 } 138 139data BatteryStatus 140 = BattHigh 141 | BattMedium 142 | BattLow 143 144-- | Convert the current battery charge into a 'BatteryStatus' 145getBattStatus 146 :: Float -- ^ Current battery charge, assumed to be in [0,1] 147 -> BattOpts -- ^ Battery options, including high/low thresholds 148 -> BatteryStatus 149getBattStatus charge opts 150 | c >= highThreshold opts = BattHigh 151 | c >= lowThreshold opts = BattMedium 152 | otherwise = BattLow 153 where 154 c = 100 * min 1 charge 155 156maybeAlert :: BattOpts -> Float -> IO () 157maybeAlert opts left = 158 case onLowAction opts of 159 Nothing -> return () 160 Just x -> unless (isNaN left || actionThreshold opts < 100 * left) 161 $ void $ system x 162 163-- | FreeBSD battery query 164#ifdef FREEBSD 165battStatusFbsd :: Int -> Status 166battStatusFbsd x 167 | x == 1 = Discharging 168 | x == 2 = Charging 169 | otherwise = Unknown 170 171readBatteriesFbsd :: BattOpts -> IO Result 172readBatteriesFbsd opts = do 173 lf <- sysctlReadInt "hw.acpi.battery.life" 174 rt <- sysctlReadInt "hw.acpi.battery.rate" 175 tm <- sysctlReadInt "hw.acpi.battery.time" 176 st <- sysctlReadInt "hw.acpi.battery.state" 177 acline <- sysctlReadInt "hw.acpi.acline" 178 let p = fromIntegral lf / 100 179 w = fromIntegral rt 180 t = fromIntegral tm * 60 181 ac = acline == 1 182 -- battery full when rate is 0 and on ac. 183 sts = if (w == 0 && ac) then Full else (battStatusFbsd $ fromIntegral st) 184 unless ac (maybeAlert opts p) 185 return (Result p w t sts) 186 187#else 188-- | query linux battery 189safeFileExist :: String -> String -> IO Bool 190safeFileExist d f = handle noErrors $ fileExist (d </> f) 191 where noErrors = const (return False) :: SomeException -> IO Bool 192 193batteryFiles :: String -> IO Files 194batteryFiles bat = 195 do is_charge <- exists "charge_now" 196 is_energy <- if is_charge then return False else exists "energy_now" 197 is_power <- exists "power_now" 198 plain <- exists (if is_charge then "charge_full" else "energy_full") 199 let cf = if is_power then "power_now" else "current_now" 200 sf = if plain then "" else "_design" 201 return $ case (is_charge, is_energy) of 202 (True, _) -> files "charge" cf sf is_power 203 (_, True) -> files "energy" cf sf is_power 204 _ -> NoFiles 205 where prefix = sysDir </> bat 206 exists = safeFileExist prefix 207 files ch cf sf ip = Files { fFull = prefix </> ch ++ "_full" ++ sf 208 , fNow = prefix </> ch ++ "_now" 209 , fCurrent = prefix </> cf 210 , fVoltage = prefix </> "voltage_now" 211 , fStatus = prefix </> "status" 212 , isCurrent = not ip} 213 214haveAc :: FilePath -> IO Bool 215haveAc f = 216 handle onError $ withFile (sysDir </> f) ReadMode (fmap (== "1") . hGetLine) 217 where onError = const (return False) :: SomeException -> IO Bool 218 219readBattery :: Float -> Files -> IO Battery 220readBattery _ NoFiles = return $ Battery 0 0 0 "Unknown" 221readBattery sc files = 222 do a <- grab $ fFull files 223 b <- grab $ fNow files 224 d <- grab $ fCurrent files 225 s <- grabs $ fStatus files 226 let sc' = if isCurrent files then sc / 10 else sc 227 a' = max a b -- sometimes the reported max charge is lower than 228 return $ Battery (3600 * a' / sc') -- wattseconds 229 (3600 * b / sc') -- wattseconds 230 (abs d / sc') -- watts 231 s -- string: Discharging/Charging/Full 232 where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine) 233 onError = const (return (-1)) :: SomeException -> IO Float 234 grabs f = handle onError' $ withFile f ReadMode hGetLine 235 onError' = const (return "Unknown") :: SomeException -> IO String 236 237-- sortOn is only available starting at ghc 7.10 238sortOn :: Ord b => (a -> b) -> [a] -> [a] 239sortOn f = 240 map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) 241 242mostCommonDef :: Eq a => a -> [a] -> a 243mostCommonDef x xs = head $ last $ [x] : sortOn length (group xs) 244 245readBatteriesLinux :: BattOpts -> [Files] -> IO Result 246readBatteriesLinux opts bfs = 247 do let bfs' = filter (/= NoFiles) bfs 248 bats <- mapM (readBattery (scale opts)) (take 3 bfs') 249 ac <- haveAc (onlineFile opts) 250 let sign = if ac then 1 else -1 251 ft = sum (map full bats) 252 left = if ft > 0 then sum (map now bats) / ft else 0 253 watts = sign * sum (map power bats) 254 time = if watts == 0 then 0 else max 0 (sum $ map time' bats) 255 mwatts = if watts == 0 then 1 else sign * watts 256 time' b = (if ac then full b - now b else now b) / mwatts 257 statuses :: [Status] 258 statuses = map (fromMaybe Unknown . readMaybe) 259 (sort (map status bats)) 260 acst = mostCommonDef Unknown $ filter (Unknown/=) statuses 261 racst | acst /= Unknown = acst 262 | time == 0 = Idle 263 | ac = Charging 264 | otherwise = Discharging 265 unless ac (maybeAlert opts left) 266 return $ if isNaN left then NA else Result left watts time racst 267#endif 268 269runBatt :: [String] -> Monitor String 270runBatt = runBatt' ["BAT", "BAT0", "BAT1", "BAT2"] 271 272runBatt' :: [String] -> [String] -> Monitor String 273runBatt' bfs args = do 274 opts <- io $ parseOptsWith options defaultOpts args 275#ifdef FREEBSD 276 c <- io $ readBatteriesFbsd opts 277#else 278 c <- io $ readBatteriesLinux opts =<< mapM batteryFiles bfs 279#endif 280 formatResult c opts 281 282formatResult :: Result -> BattOpts -> Monitor String 283formatResult res bopt = do 284 let sp = incPerc bopt 285 suffix <- getConfigValue useSuffix 286 d <- getConfigValue decDigits 287 nas <- getConfigValue naString 288 case res of 289 Result x w t s -> 290 do l <- fmtPercent x sp 291 ws <- fmtWatts w bopt suffix d 292 si <- getIconPattern bopt s x 293 st <- showWithColors' 294 (fmtStatus bopt s nas (getBattStatus x bopt)) 295 (100 * x) 296 parseTemplate (l ++ [st, fmtTime $ floor t, ws, si]) 297 NA -> getConfigValue naString 298 where fmtPercent :: Float -> Bool -> Monitor [String] 299 fmtPercent x sp = do 300 let x' = minimum [1, x] 301 pc <- if sp then colorizeString (100 * x') "%" else return "" 302 p <- showPercentWithColors x' 303 b <- showPercentBar (100 * x') x' 304 vb <- showVerticalBar (100 * x') x' 305 return [b, vb, p ++ pc] 306 fmtWatts x o s d = do 307 ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "") 308 return $ color x o ws 309 fmtTime :: Integer -> String 310 fmtTime x = hours ++ ":" ++ if length minutes == 2 311 then minutes else '0' : minutes 312 where hours = show (x `div` 3600) 313 minutes = show ((x `mod` 3600) `div` 60) 314 fmtStatus 315 :: BattOpts 316 -> Status 317 -> String -- ^ What to in case battery status is unknown 318 -> BatteryStatus 319 -> String 320 fmtStatus opts Idle _ _ = idleString opts 321 fmtStatus _ Unknown na _ = na 322 fmtStatus opts Full _ _ = idleString opts 323 fmtStatus opts Charging _ _ = onString opts 324 fmtStatus opts Discharging _ battStatus = 325 (case battStatus of 326 BattHigh -> highString 327 BattMedium -> mediumString 328 BattLow -> lowString) opts ++ offString opts 329 maybeColor Nothing str = str 330 maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" 331 color x o | x >= 0 = maybeColor (posColor o) 332 | -x >= highThreshold o = maybeColor (highWColor o) 333 | -x >= lowThreshold o = maybeColor (mediumWColor o) 334 | otherwise = maybeColor (lowWColor o) 335 getIconPattern opts st x = do 336 let x' = minimum [1, x] 337 case st of 338 Unknown -> showIconPattern (offIconPattern opts) x' 339 Idle -> showIconPattern (idleIconPattern opts) x' 340 Full -> showIconPattern (idleIconPattern opts) x' 341 Charging -> showIconPattern (onIconPattern opts) x' 342 Discharging -> showIconPattern (offIconPattern opts) x' 343