module Xmobar.Plugins.Monitors.Batt.Linux (readBatteries) where
import Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..)
, Result(..)
, Status(..)
, maybeAlert)
import Control.Monad (unless)
import Control.Exception (SomeException, handle)
import System.FilePath ((</>))
import System.IO (IOMode(ReadMode), hGetLine, withFile)
import System.Posix.Files (fileExist)
import Data.List (sort, sortBy, group)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Text.Read (readMaybe)
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
}
sysDir :: FilePath
sysDir :: String
sysDir = String
"/sys/class/power_supply"
safeFileExist :: String -> String -> IO Bool
safeFileExist :: String -> String -> IO Bool
safeFileExist String
d 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 String
bat =
do Bool
is_charge <- String -> IO Bool
exists String
"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 String
"energy_now"
Bool
is_power <- String -> IO Bool
exists String
"power_now"
Bool
plain <- String -> IO Bool
exists (if Bool
is_charge then String
"charge_full" else String
"energy_full")
let cf :: String
cf = if Bool
is_power then String
"power_now" else String
"current_now"
sf :: String
sf = if Bool
plain then String
"" else String
"_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
(Bool
True, Bool
_) -> String -> String -> String -> Bool -> Files
files String
"charge" String
cf String
sf Bool
is_power
(Bool
_, Bool
True) -> String -> String -> String -> Bool -> Files
files String
"energy" String
cf String
sf Bool
is_power
(Bool, Bool)
_ -> 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 String
ch String
cf String
sf 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]
++ String
"_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]
++ String
"_now"
, fCurrent :: String
fCurrent = String
prefix String -> String -> String
</> String
cf
, fVoltage :: String
fVoltage = String
prefix String -> String -> String
</> String
"voltage_now"
, fStatus :: String
fStatus = String
prefix String -> String -> String
</> String
"status"
, isCurrent :: Bool
isCurrent = Bool -> Bool
not Bool
ip}
haveAc :: FilePath -> IO Bool
haveAc :: String -> IO Bool
haveAc 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
== String
"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 Float
_ Files
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 Float
0 Float
0 Float
0 String
"Unknown"
readBattery Float
sc 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
/ Float
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 (Float
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')
(Float
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 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 (-Float
1)) :: SomeException -> IO Float
grabs :: String -> IO String
grabs 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 String
"Unknown") :: SomeException -> IO String
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn :: (a -> b) -> [a] -> [a]
sortOn 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 (\a
x -> let y :: b
y = a -> b
f a
x in b
y b -> (b, a) -> (b, a)
`seq` (b
y, a
x))
mostCommonDef :: Eq a => a -> [a] -> a
mostCommonDef :: a -> [a] -> a
mostCommonDef a
x [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)
readBatteries :: BattOpts -> [String] -> IO Result
readBatteries :: BattOpts -> [String] -> IO Result
readBatteries BattOpts
opts [String]
bfs =
do [Files]
bfs' <- (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
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 Int
3 [Files]
bfs'')
Bool
ac <- String -> IO Bool
haveAc (BattOpts -> String
onlineFile BattOpts
opts)
let sign :: Float
sign = if Bool
ac then Float
1 else -Float
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
> Float
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 Float
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
== Float
0 then Float
0 else Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
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
== Float
0 then Float
1 else Float
sign Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
watts
time' :: Battery -> Float
time' 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
== Float
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