{-# LANGUAGE CPP #-}
module Xmobar.Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where
import System.Process (system)
import Control.Monad (void, unless)
import Xmobar.Plugins.Monitors.Common
import Control.Exception (SomeException, handle)
import System.FilePath ((</>))
import System.IO (IOMode(ReadMode), hGetLine, withFile)
import System.Posix.Files (fileExist)
#ifdef FREEBSD
import System.BSD.Sysctl (sysctlReadInt)
#endif
import System.Console.GetOpt
import Data.List (sort, sortBy, group)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Text.Read (readMaybe)
data BattOpts = BattOpts
{ BattOpts -> String
onString :: String
, BattOpts -> String
offString :: String
, BattOpts -> String
idleString :: String
, BattOpts -> Maybe String
posColor :: Maybe String
, BattOpts -> Maybe String
lowWColor :: Maybe String
, BattOpts -> Maybe String
mediumWColor :: Maybe String
, BattOpts -> Maybe String
highWColor :: Maybe String
, BattOpts -> Float
lowThreshold :: Float
, BattOpts -> Float
highThreshold :: Float
, BattOpts -> Maybe String
onLowAction :: Maybe String
, BattOpts -> Float
actionThreshold :: Float
, BattOpts -> String
onlineFile :: FilePath
, BattOpts -> Float
scale :: Float
, BattOpts -> Maybe IconPattern
onIconPattern :: Maybe IconPattern
, BattOpts -> Maybe IconPattern
offIconPattern :: Maybe IconPattern
, BattOpts -> Maybe IconPattern
idleIconPattern :: Maybe IconPattern
, BattOpts -> String
lowString :: String
, BattOpts -> String
mediumString :: String
, BattOpts -> String
highString :: String
, BattOpts -> Bool
incPerc :: Bool
}
defaultOpts :: BattOpts
defaultOpts :: BattOpts
defaultOpts = BattOpts :: String
-> String
-> String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Float
-> Float
-> Maybe String
-> Float
-> String
-> Float
-> Maybe IconPattern
-> Maybe IconPattern
-> Maybe IconPattern
-> String
-> String
-> String
-> Bool
-> BattOpts
BattOpts
{ onString :: String
onString = "On"
, offString :: String
offString = "Off"
, idleString :: String
idleString = "On"
, posColor :: Maybe String
posColor = Maybe String
forall a. Maybe a
Nothing
, lowWColor :: Maybe String
lowWColor = Maybe String
forall a. Maybe a
Nothing
, mediumWColor :: Maybe String
mediumWColor = Maybe String
forall a. Maybe a
Nothing
, highWColor :: Maybe String
highWColor = Maybe String
forall a. Maybe a
Nothing
, onLowAction :: Maybe String
onLowAction = Maybe String
forall a. Maybe a
Nothing
, actionThreshold :: Float
actionThreshold = 6
, lowThreshold :: Float
lowThreshold = 10
, highThreshold :: Float
highThreshold = 12
, onlineFile :: String
onlineFile = "AC/online"
, scale :: Float
scale = 1e6
, onIconPattern :: Maybe IconPattern
onIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, offIconPattern :: Maybe IconPattern
offIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, idleIconPattern :: Maybe IconPattern
idleIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, lowString :: String
lowString = ""
, mediumString :: String
mediumString = ""
, highString :: String
highString = ""
, incPerc :: Bool
incPerc = Bool
False
}
options :: [OptDescr (BattOpts -> BattOpts)]
options :: [OptDescr (BattOpts -> BattOpts)]
options =
[ String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "O" ["on"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { onString :: String
onString = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "o" ["off"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { offString :: String
offString = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "i" ["idle"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { idleString :: String
idleString = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "p" ["positive"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { posColor :: Maybe String
posColor = String -> Maybe String
forall a. a -> Maybe a
Just String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "l" ["low"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { lowWColor :: Maybe String
lowWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "m" ["medium"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { mediumWColor :: Maybe String
mediumWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "h" ["high"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { highWColor :: Maybe String
highWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "L" ["lowt"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { lowThreshold :: Float
lowThreshold = String -> Float
forall a. Read a => String -> a
read String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "H" ["hight"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { highThreshold :: Float
highThreshold = String -> Float
forall a. Read a => String -> a
read String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "f" ["online"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { onlineFile :: String
onlineFile = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "s" ["scale"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o {scale :: Float
scale = String -> Float
forall a. Read a => String -> a
read String
x}) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "a" ["action"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { onLowAction :: Maybe String
onLowAction = String -> Maybe String
forall a. a -> Maybe a
Just String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "P" ["percent"] ((BattOpts -> BattOpts) -> ArgDescr (BattOpts -> BattOpts)
forall a. a -> ArgDescr a
NoArg (\o :: BattOpts
o -> BattOpts
o {incPerc :: Bool
incPerc = Bool
True})) ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "A" ["action-threshold"]
((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { actionThreshold :: Float
actionThreshold = String -> Float
forall a. Read a => String -> a
read String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["on-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o ->
BattOpts
o { onIconPattern :: Maybe IconPattern
onIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["off-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o ->
BattOpts
o { offIconPattern :: Maybe IconPattern
offIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["idle-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o ->
BattOpts
o { idleIconPattern :: Maybe IconPattern
idleIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["lows"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { lowString :: String
lowString = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["mediums"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { mediumString :: String
mediumString = String
x }) "") ""
, String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "" ["highs"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: BattOpts
o -> BattOpts
o { highString :: String
highString = String
x }) "") ""
]
data Status = Charging | Discharging | Full | Idle | Unknown deriving (ReadPrec [Status]
ReadPrec Status
Int -> ReadS Status
ReadS [Status]
(Int -> ReadS Status)
-> ReadS [Status]
-> ReadPrec Status
-> ReadPrec [Status]
-> Read Status
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Status]
$creadListPrec :: ReadPrec [Status]
readPrec :: ReadPrec Status
$creadPrec :: ReadPrec Status
readList :: ReadS [Status]
$creadList :: ReadS [Status]
readsPrec :: Int -> ReadS Status
$creadsPrec :: Int -> ReadS Status
Read, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq)
data Result = Result Float Float Float Status | NA
sysDir :: FilePath
sysDir :: String
sysDir = "/sys/class/power_supply"
battConfig :: IO MConfig
battConfig :: IO MConfig
battConfig = String -> [String] -> IO MConfig
mkMConfig
"Batt: <watts>, <left>% / <timeleft>"
["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"]
data Files = Files
{ Files -> String
fFull :: String
, Files -> String
fNow :: String
, Files -> String
fVoltage :: String
, Files -> String
fCurrent :: String
, Files -> String
fStatus :: String
, Files -> Bool
isCurrent :: Bool
} | NoFiles deriving Files -> Files -> Bool
(Files -> Files -> Bool) -> (Files -> Files -> Bool) -> Eq Files
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Files -> Files -> Bool
$c/= :: Files -> Files -> Bool
== :: Files -> Files -> Bool
$c== :: Files -> Files -> Bool
Eq
data Battery = Battery
{ Battery -> Float
full :: !Float
, Battery -> Float
now :: !Float
, Battery -> Float
power :: !Float
, Battery -> String
status :: !String
}
data BatteryStatus
= BattHigh
| BattMedium
| BattLow
getBattStatus
:: Float
-> BattOpts
-> BatteryStatus
getBattStatus :: Float -> BattOpts -> BatteryStatus
getBattStatus charge :: Float
charge opts :: BattOpts
opts
| Float
c Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= BattOpts -> Float
highThreshold BattOpts
opts = BatteryStatus
BattHigh
| Float
c Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= BattOpts -> Float
lowThreshold BattOpts
opts = BatteryStatus
BattMedium
| Bool
otherwise = BatteryStatus
BattLow
where
c :: Float
c = 100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
min 1 Float
charge
maybeAlert :: BattOpts -> Float -> IO ()
maybeAlert :: BattOpts -> Float -> IO ()
maybeAlert opts :: BattOpts
opts left :: Float
left =
case BattOpts -> Maybe String
onLowAction BattOpts
opts of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just x :: String
x -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
left Bool -> Bool -> Bool
|| BattOpts -> Float
actionThreshold BattOpts
opts Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
left)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ExitCode
system String
x
#ifdef FREEBSD
battStatusFbsd :: Int -> Status
battStatusFbsd x
| x == 1 = Discharging
| x == 2 = Charging
| otherwise = Unknown
readBatteriesFbsd :: BattOpts -> IO Result
readBatteriesFbsd opts = do
lf <- sysctlReadInt "hw.acpi.battery.life"
rt <- sysctlReadInt "hw.acpi.battery.rate"
tm <- sysctlReadInt "hw.acpi.battery.time"
st <- sysctlReadInt "hw.acpi.battery.state"
acline <- sysctlReadInt "hw.acpi.acline"
let p = fromIntegral lf / 100
w = fromIntegral rt
t = fromIntegral tm * 60
ac = acline == 1
sts = if (w == 0 && ac) then Full else (battStatusFbsd $ fromIntegral st)
unless ac (maybeAlert opts p)
return (Result p w t sts)
#else
safeFileExist :: String -> String -> IO Bool
safeFileExist :: String -> String -> IO Bool
safeFileExist d :: String
d f :: String
f = (SomeException -> IO Bool) -> IO Bool -> IO Bool
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO Bool
noErrors (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
fileExist (String
d String -> String -> String
</> String
f)
where noErrors :: SomeException -> IO Bool
noErrors = IO Bool -> SomeException -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) :: SomeException -> IO Bool
batteryFiles :: String -> IO Files
batteryFiles :: String -> IO Files
batteryFiles bat :: String
bat =
do Bool
is_charge <- String -> IO Bool
exists "charge_now"
Bool
is_energy <- if Bool
is_charge then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else String -> IO Bool
exists "energy_now"
Bool
is_power <- String -> IO Bool
exists "power_now"
Bool
plain <- String -> IO Bool
exists (if Bool
is_charge then "charge_full" else "energy_full")
let cf :: String
cf = if Bool
is_power then "power_now" else "current_now"
sf :: String
sf = if Bool
plain then "" else "_design"
Files -> IO Files
forall (m :: * -> *) a. Monad m => a -> m a
return (Files -> IO Files) -> Files -> IO Files
forall a b. (a -> b) -> a -> b
$ case (Bool
is_charge, Bool
is_energy) of
(True, _) -> String -> String -> String -> Bool -> Files
files "charge" String
cf String
sf Bool
is_power
(_, True) -> String -> String -> String -> Bool -> Files
files "energy" String
cf String
sf Bool
is_power
_ -> Files
NoFiles
where prefix :: String
prefix = String
sysDir String -> String -> String
</> String
bat
exists :: String -> IO Bool
exists = String -> String -> IO Bool
safeFileExist String
prefix
files :: String -> String -> String -> Bool -> Files
files ch :: String
ch cf :: String
cf sf :: String
sf ip :: Bool
ip = Files :: String -> String -> String -> String -> String -> Bool -> Files
Files { fFull :: String
fFull = String
prefix String -> String -> String
</> String
ch String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_full" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sf
, fNow :: String
fNow = String
prefix String -> String -> String
</> String
ch String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_now"
, fCurrent :: String
fCurrent = String
prefix String -> String -> String
</> String
cf
, fVoltage :: String
fVoltage = String
prefix String -> String -> String
</> "voltage_now"
, fStatus :: String
fStatus = String
prefix String -> String -> String
</> "status"
, isCurrent :: Bool
isCurrent = Bool -> Bool
not Bool
ip}
haveAc :: FilePath -> IO Bool
haveAc :: String -> IO Bool
haveAc f :: String
f =
(SomeException -> IO Bool) -> IO Bool -> IO Bool
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO Bool
onError (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (String
sysDir String -> String -> String
</> String
f) IOMode
ReadMode ((String -> Bool) -> IO String -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "1") (IO String -> IO Bool)
-> (Handle -> IO String) -> Handle -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO String
hGetLine)
where onError :: SomeException -> IO Bool
onError = IO Bool -> SomeException -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) :: SomeException -> IO Bool
readBattery :: Float -> Files -> IO Battery
readBattery :: Float -> Files -> IO Battery
readBattery _ NoFiles = Battery -> IO Battery
forall (m :: * -> *) a. Monad m => a -> m a
return (Battery -> IO Battery) -> Battery -> IO Battery
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> String -> Battery
Battery 0 0 0 "Unknown"
readBattery sc :: Float
sc files :: Files
files =
do Float
a <- String -> IO Float
grab (String -> IO Float) -> String -> IO Float
forall a b. (a -> b) -> a -> b
$ Files -> String
fFull Files
files
Float
b <- String -> IO Float
grab (String -> IO Float) -> String -> IO Float
forall a b. (a -> b) -> a -> b
$ Files -> String
fNow Files
files
Float
d <- String -> IO Float
grab (String -> IO Float) -> String -> IO Float
forall a b. (a -> b) -> a -> b
$ Files -> String
fCurrent Files
files
String
s <- String -> IO String
grabs (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Files -> String
fStatus Files
files
let sc' :: Float
sc' = if Files -> Bool
isCurrent Files
files then Float
sc Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 10 else Float
sc
a' :: Float
a' = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
a Float
b
Battery -> IO Battery
forall (m :: * -> *) a. Monad m => a -> m a
return (Battery -> IO Battery) -> Battery -> IO Battery
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> String -> Battery
Battery (3600 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a' Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
sc')
(3600 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
sc')
(Float -> Float
forall a. Num a => a -> a
abs Float
d Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
sc')
String
s
where grab :: String -> IO Float
grab f :: String
f = (SomeException -> IO Float) -> IO Float -> IO Float
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO Float
onError (IO Float -> IO Float) -> IO Float -> IO Float
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO Float) -> IO Float
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
ReadMode ((String -> Float) -> IO String -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Float
forall a. Read a => String -> a
read (IO String -> IO Float)
-> (Handle -> IO String) -> Handle -> IO Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO String
hGetLine)
onError :: SomeException -> IO Float
onError = IO Float -> SomeException -> IO Float
forall a b. a -> b -> a
const (Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)) :: SomeException -> IO Float
grabs :: String -> IO String
grabs f :: String
f = (SomeException -> IO String) -> IO String -> IO String
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO String
onError' (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO String) -> IO String
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
ReadMode Handle -> IO String
hGetLine
onError' :: SomeException -> IO String
onError' = IO String -> SomeException -> IO String
forall a b. a -> b -> a
const (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return "Unknown") :: SomeException -> IO String
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn :: (a -> b) -> [a] -> [a]
sortOn f :: a -> b
f =
((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([a] -> [(b, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Ordering) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: a
x -> let y :: b
y = a -> b
f a
x in b
y b -> (b, a) -> (b, a)
forall a b. a -> b -> b
`seq` (b
y, a
x))
mostCommonDef :: Eq a => a -> [a] -> a
mostCommonDef :: a -> [a] -> a
mostCommonDef x :: a
x xs :: [a]
xs = [a] -> a
forall a. [a] -> a
head ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
last ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [a
x] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> Int) -> [[a]] -> [[a]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group [a]
xs)
readBatteriesLinux :: BattOpts -> [Files] -> IO Result
readBatteriesLinux :: BattOpts -> [Files] -> IO Result
readBatteriesLinux opts :: BattOpts
opts bfs :: [Files]
bfs =
do let bfs' :: [Files]
bfs' = (Files -> Bool) -> [Files] -> [Files]
forall a. (a -> Bool) -> [a] -> [a]
filter (Files -> Files -> Bool
forall a. Eq a => a -> a -> Bool
/= Files
NoFiles) [Files]
bfs
[Battery]
bats <- (Files -> IO Battery) -> [Files] -> IO [Battery]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Float -> Files -> IO Battery
readBattery (BattOpts -> Float
scale BattOpts
opts)) (Int -> [Files] -> [Files]
forall a. Int -> [a] -> [a]
take 3 [Files]
bfs')
Bool
ac <- String -> IO Bool
haveAc (BattOpts -> String
onlineFile BattOpts
opts)
let sign :: Float
sign = if Bool
ac then 1 else -1
ft :: Float
ft = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Battery -> Float) -> [Battery] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Battery -> Float
full [Battery]
bats)
left :: Float
left = if Float
ft Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Battery -> Float) -> [Battery] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Battery -> Float
now [Battery]
bats) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ft else 0
watts :: Float
watts = Float
sign Float -> Float -> Float
forall a. Num a => a -> a -> a
* [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Battery -> Float) -> [Battery] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Battery -> Float
power [Battery]
bats)
time :: Float
time = if Float
watts Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else Float -> Float -> Float
forall a. Ord a => a -> a -> a
max 0 ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float) -> [Float] -> Float
forall a b. (a -> b) -> a -> b
$ (Battery -> Float) -> [Battery] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Battery -> Float
time' [Battery]
bats)
mwatts :: Float
mwatts = if Float
watts Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 1 else Float
sign Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
watts
time' :: Battery -> Float
time' b :: Battery
b = (if Bool
ac then Battery -> Float
full Battery
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Battery -> Float
now Battery
b else Battery -> Float
now Battery
b) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
mwatts
statuses :: [Status]
statuses :: [Status]
statuses = (String -> Status) -> [String] -> [Status]
forall a b. (a -> b) -> [a] -> [b]
map (Status -> Maybe Status -> Status
forall a. a -> Maybe a -> a
fromMaybe Status
Unknown (Maybe Status -> Status)
-> (String -> Maybe Status) -> String -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Status
forall a. Read a => String -> Maybe a
readMaybe)
([String] -> [String]
forall a. Ord a => [a] -> [a]
sort ((Battery -> String) -> [Battery] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Battery -> String
status [Battery]
bats))
acst :: Status
acst = Status -> [Status] -> Status
forall a. Eq a => a -> [a] -> a
mostCommonDef Status
Unknown ([Status] -> Status) -> [Status] -> Status
forall a b. (a -> b) -> a -> b
$ (Status -> Bool) -> [Status] -> [Status]
forall a. (a -> Bool) -> [a] -> [a]
filter (Status
UnknownStatus -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Status]
statuses
racst :: Status
racst | Status
acst Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Unknown = Status
acst
| Float
time Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Status
Idle
| Bool
ac = Status
Charging
| Bool
otherwise = Status
Discharging
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ac (BattOpts -> Float -> IO ()
maybeAlert BattOpts
opts Float
left)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
left then Result
NA else Float -> Float -> Float -> Status -> Result
Result Float
left Float
watts Float
time Status
racst
#endif
runBatt :: [String] -> Monitor String
runBatt :: [String] -> Monitor String
runBatt = [String] -> [String] -> Monitor String
runBatt' ["BAT", "BAT0", "BAT1", "BAT2"]
runBatt' :: [String] -> [String] -> Monitor String
runBatt' :: [String] -> [String] -> Monitor String
runBatt' bfs :: [String]
bfs args :: [String]
args = do
BattOpts
opts <- IO BattOpts -> Monitor BattOpts
forall a. IO a -> Monitor a
io (IO BattOpts -> Monitor BattOpts)
-> IO BattOpts -> Monitor BattOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (BattOpts -> BattOpts)]
-> BattOpts -> [String] -> IO BattOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (BattOpts -> BattOpts)]
options BattOpts
defaultOpts [String]
args
#ifdef FREEBSD
c <- io $ readBatteriesFbsd opts
#else
Result
c <- IO Result -> Monitor Result
forall a. IO a -> Monitor a
io (IO Result -> Monitor Result) -> IO Result -> Monitor Result
forall a b. (a -> b) -> a -> b
$ BattOpts -> [Files] -> IO Result
readBatteriesLinux BattOpts
opts ([Files] -> IO Result) -> IO [Files] -> IO Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> IO Files) -> [String] -> IO [Files]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Files
batteryFiles [String]
bfs
#endif
Result -> BattOpts -> Monitor String
formatResult Result
c BattOpts
opts
formatResult :: Result -> BattOpts -> Monitor String
formatResult :: Result -> BattOpts -> Monitor String
formatResult res :: Result
res bopt :: BattOpts
bopt = do
let sp :: Bool
sp = BattOpts -> Bool
incPerc BattOpts
bopt
Bool
suffix <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
useSuffix
Int
d <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
decDigits
String
nas <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString
case Result
res of
Result x :: Float
x w :: Float
w t :: Float
t s :: Status
s ->
do [String]
l <- Float -> Bool -> Monitor [String]
fmtPercent Float
x Bool
sp
String
ws <- Float -> BattOpts -> Bool -> Int -> Monitor String
fmtWatts Float
w BattOpts
bopt Bool
suffix Int
d
String
si <- BattOpts -> Status -> Float -> Monitor String
getIconPattern BattOpts
bopt Status
s Float
x
String
st <- String -> Float -> Monitor String
forall a. (Num a, Ord a) => String -> a -> Monitor String
showWithColors'
(BattOpts -> Status -> String -> BatteryStatus -> String
fmtStatus BattOpts
bopt Status
s String
nas (Float -> BattOpts -> BatteryStatus
getBattStatus Float
x BattOpts
bopt))
(100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
[String] -> Monitor String
parseTemplate ([String]
l [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
st, Integer -> String
fmtTime (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
t, String
ws, String
si])
NA -> Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString
where fmtPercent :: Float -> Bool -> Monitor [String]
fmtPercent :: Float -> Bool -> Monitor [String]
fmtPercent x :: Float
x sp :: Bool
sp = do
let x' :: Float
x' = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [1, Float
x]
String
pc <- if Bool
sp then Float -> String -> Monitor String
forall a. (Num a, Ord a) => a -> String -> Monitor String
colorizeString (100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x') "%" else String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
String
p <- Float -> Monitor String
showPercentWithColors Float
x'
String
b <- Float -> Float -> Monitor String
showPercentBar (100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x') Float
x'
String
vb <- Float -> Float -> Monitor String
showVerticalBar (100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x') Float
x'
[String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
b, String
vb, String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pc]
fmtWatts :: Float -> BattOpts -> Bool -> Int -> Monitor String
fmtWatts x :: Float
x o :: BattOpts
o s :: Bool
s d :: Int
d = do
String
ws <- String -> Monitor String
showWithPadding (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
d Float
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
s then "W" else "")
String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ Float -> BattOpts -> String -> String
color Float
x BattOpts
o String
ws
fmtTime :: Integer -> String
fmtTime :: Integer -> String
fmtTime x :: Integer
x = String
hours String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
minutes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
then String
minutes else '0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
minutes
where hours :: String
hours = Integer -> String
forall a. Show a => a -> String
show (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 3600)
minutes :: String
minutes = Integer -> String
forall a. Show a => a -> String
show ((Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 3600) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 60)
fmtStatus
:: BattOpts
-> Status
-> String
-> BatteryStatus
-> String
fmtStatus :: BattOpts -> Status -> String -> BatteryStatus -> String
fmtStatus opts :: BattOpts
opts Idle _ _ = BattOpts -> String
idleString BattOpts
opts
fmtStatus _ Unknown na :: String
na _ = String
na
fmtStatus opts :: BattOpts
opts Full _ _ = BattOpts -> String
idleString BattOpts
opts
fmtStatus opts :: BattOpts
opts Charging _ _ = BattOpts -> String
onString BattOpts
opts
fmtStatus opts :: BattOpts
opts Discharging _ battStatus :: BatteryStatus
battStatus =
(case BatteryStatus
battStatus of
BattHigh -> BattOpts -> String
highString
BattMedium -> BattOpts -> String
mediumString
BattLow -> BattOpts -> String
lowString) BattOpts
opts String -> String -> String
forall a. [a] -> [a] -> [a]
++ BattOpts -> String
offString BattOpts
opts
maybeColor :: Maybe String -> String -> String
maybeColor Nothing str :: String
str = String
str
maybeColor (Just c :: String
c) str :: String
str = "<fc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ "</fc>"
color :: Float -> BattOpts -> String -> String
color x :: Float
x o :: BattOpts
o | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Maybe String -> String -> String
maybeColor (BattOpts -> Maybe String
posColor BattOpts
o)
| -Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= BattOpts -> Float
highThreshold BattOpts
o = Maybe String -> String -> String
maybeColor (BattOpts -> Maybe String
highWColor BattOpts
o)
| -Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= BattOpts -> Float
lowThreshold BattOpts
o = Maybe String -> String -> String
maybeColor (BattOpts -> Maybe String
mediumWColor BattOpts
o)
| Bool
otherwise = Maybe String -> String -> String
maybeColor (BattOpts -> Maybe String
lowWColor BattOpts
o)
getIconPattern :: BattOpts -> Status -> Float -> Monitor String
getIconPattern opts :: BattOpts
opts st :: Status
st x :: Float
x = do
let x' :: Float
x' = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [1, Float
x]
case Status
st of
Unknown -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
offIconPattern BattOpts
opts) Float
x'
Idle -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
idleIconPattern BattOpts
opts) Float
x'
Full -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
idleIconPattern BattOpts
opts) Float
x'
Charging -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
onIconPattern BattOpts
opts) Float
x'
Discharging -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
offIconPattern BattOpts
opts) Float
x'