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