{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Batt
-- Copyright   :  (c) 2010-2013, 2015, 2016, 2018, 2019, 2022 Jose A Ortega
--                (c) 2010 Andrea Rossato, Petr Rockai
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A battery monitor for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Batt (battConfig, runBatt, runBatt') where

import Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..), Result(..), Status(..))
import Xmobar.Plugins.Monitors.Common
import System.Console.GetOpt

#if defined(freebsd_HOST_OS)
import qualified Xmobar.Plugins.Monitors.Batt.FreeBSD as MB
#else
import qualified Xmobar.Plugins.Monitors.Batt.Linux as MB
#endif


defaultOpts :: BattOpts
defaultOpts :: BattOpts
defaultOpts = BattOpts
  { onString :: String
onString = String
"On"
  , offString :: String
offString = String
"Off"
  , idleString :: String
idleString = String
"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 = Float
6
  , lowThreshold :: Float
lowThreshold = Float
10
  , highThreshold :: Float
highThreshold = Float
12
  , onlineFile :: String
onlineFile = String
"AC/online"
  , scale :: Float
scale = Float
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 = String
""
  , mediumString :: String
mediumString = String
""
  , highString :: String
highString = String
""
  , 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 String
"O" [String
"on"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { onString = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"o" [String
"off"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { offString = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" [String
"idle"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { idleString = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"positive"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { posColor = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"l" [String
"low"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { lowWColor = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"m" [String
"medium"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { mediumWColor = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"h" [String
"high"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { highWColor = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"L" [String
"lowt"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { lowThreshold = read x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"H" [String
"hight"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { highThreshold = read x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"f" [String
"online"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { onlineFile = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"s" [String
"scale"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o {scale = read x}) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"a" [String
"action"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { onLowAction = Just x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"P" [String
"percent"] ((BattOpts -> BattOpts) -> ArgDescr (BattOpts -> BattOpts)
forall a. a -> ArgDescr a
NoArg (\BattOpts
o -> BattOpts
o {incPerc = True})) String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"A" [String
"action-threshold"]
               ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { actionThreshold = read x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"on-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o ->
     BattOpts
o { onIconPattern = Just $ parseIconPattern x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"off-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o ->
     BattOpts
o { offIconPattern = Just $ parseIconPattern x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"idle-icon-pattern"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o ->
     BattOpts
o { idleIconPattern = Just $ parseIconPattern x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"lows"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { lowString = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"mediums"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { mediumString = x }) String
"") String
""
  , String
-> [String]
-> ArgDescr (BattOpts -> BattOpts)
-> String
-> OptDescr (BattOpts -> BattOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"highs"] ((String -> BattOpts -> BattOpts)
-> String -> ArgDescr (BattOpts -> BattOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BattOpts
o -> BattOpts
o { highString = x }) String
"") String
""
  ]

battConfig :: IO MConfig
battConfig :: IO MConfig
battConfig = String -> [String] -> IO MConfig
mkMConfig String
"Batt: <watts>, <left>% / <timeleft>" [String]
vs
    where vs :: [String]
vs = [String
"leftbar", String
"leftvbar", String
"left"
               , String
"acstatus", String
"timeleft", String
"watts", String
"leftipat"]

data BatteryStatus
  = BattHigh
  | BattMedium
  | BattLow

-- | Convert the current battery charge into a 'BatteryStatus'
getBattStatus
  :: Float    -- ^ Current battery charge, assumed to be in [0,1]
  -> BattOpts -- ^ Battery options, including high/low thresholds
  -> BatteryStatus
getBattStatus :: Float -> BattOpts -> BatteryStatus
getBattStatus Float
charge 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 = Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
charge

runBatt :: [String] -> Monitor String
runBatt :: [String] -> Monitor String
runBatt = [String] -> [String] -> Monitor String
runBatt' [String
"BAT", String
"BAT0", String
"BAT1", String
"BAT2"]

runBatt' :: [String] -> [String] -> Monitor String
runBatt' :: [String] -> [String] -> Monitor String
runBatt' [String]
bfs [String]
args = do
  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
  c <- io $ MB.readBatteries opts bfs
  formatResult c opts

formatResult :: Result -> BattOpts -> Monitor String
formatResult :: Result -> BattOpts -> Monitor String
formatResult Result
res BattOpts
bopt = do
  let sp :: Bool
sp = BattOpts -> Bool
incPerc BattOpts
bopt
  suffix <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
useSuffix
  d <- getConfigValue decDigits
  nas <- getConfigValue naString
  case res of
    Result Float
x Float
w Float
t Status
s ->
      do l <- Float -> Bool -> Monitor [String]
fmtPercent Float
x Bool
sp
         ws <- fmtWatts w bopt suffix d
         si <- getIconPattern bopt s x
         st <- showWithColors'
                 (fmtStatus bopt s nas (getBattStatus x bopt))
                 (100 * x)
         parseTemplate (l ++ [st, fmtTime $ floor t, ws, si])
    Result
NA -> Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString

fmtWatts :: Float -> BattOpts -> Bool -> Int -> Monitor String
fmtWatts :: Float -> BattOpts -> Bool -> Int -> Monitor String
fmtWatts Float
x BattOpts
o Bool
s Int
d = do
  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 String
"W" else String
"")
  return $ color x o ws

color :: Float -> BattOpts -> String -> String
color :: Float -> BattOpts -> String -> String
color Float
x BattOpts
o | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
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)

fmtTime :: Integer -> String
fmtTime :: Integer -> String
fmtTime Integer
x = String
hours String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
minutes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then String
minutes else Char
'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` Integer
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` Integer
3600) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
60)

fmtPercent :: Float -> Bool -> Monitor [String]
fmtPercent :: Float -> Bool -> Monitor [String]
fmtPercent Float
x Bool
sp = do
  let x' :: Float
x' = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
x
  pc <- if Bool
sp then Float -> String -> Monitor String
forall a. (Num a, Ord a) => a -> String -> Monitor String
colorizeString (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x') String
"%" else String -> Monitor String
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  p <- showPercentWithColors x'
  b <- showPercentBar (100 * x') x'
  vb <- showVerticalBar (100 * x') x'
  return [b, vb, p ++ pc]

fmtStatus :: BattOpts -> Status -> String -> BatteryStatus -> String
fmtStatus :: BattOpts -> Status -> String -> BatteryStatus -> String
fmtStatus BattOpts
opts Status
Idle String
_ BatteryStatus
_ = BattOpts -> String
idleString BattOpts
opts
fmtStatus BattOpts
_ Status
Unknown String
na BatteryStatus
_ = String
na
fmtStatus BattOpts
opts Status
Full String
_ BatteryStatus
_ = BattOpts -> String
idleString BattOpts
opts
fmtStatus BattOpts
opts Status
Charging String
_ BatteryStatus
_ = BattOpts -> String
onString BattOpts
opts
fmtStatus BattOpts
opts Status
Discharging String
_ BatteryStatus
battStatus =
  (case BatteryStatus
battStatus of
    BatteryStatus
BattHigh -> BattOpts -> String
highString
    BatteryStatus
BattMedium -> BattOpts -> String
mediumString
    BatteryStatus
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 :: Maybe String -> String -> String
maybeColor Maybe String
Nothing String
str = String
str
maybeColor (Just String
c) String
str = String
"<fc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</fc>"

getIconPattern :: BattOpts -> Status -> Float -> Monitor String
getIconPattern :: BattOpts -> Status -> Float -> Monitor String
getIconPattern BattOpts
opts Status
st Float
x = do
  let x' :: Float
x' = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
x
  case Status
st of
       Status
Unknown -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
offIconPattern BattOpts
opts) Float
x'
       Status
Idle -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
idleIconPattern BattOpts
opts) Float
x'
       Status
Full -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
idleIconPattern BattOpts
opts) Float
x'
       Status
Charging -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
onIconPattern BattOpts
opts) Float
x'
       Status
Discharging -> Maybe IconPattern -> Float -> Monitor String
showIconPattern (BattOpts -> Maybe IconPattern
offIconPattern BattOpts
opts) Float
x'