{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Batt
-- Copyright   :  (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 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 :: 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 = 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 :: String
onString = String
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 :: String
offString = String
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 :: String
idleString = String
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 :: Maybe String
posColor = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Maybe String
lowWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Maybe String
mediumWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Maybe String
highWColor = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Float
lowThreshold = String -> Float
forall a. Read a => String -> a
read String
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 :: Float
highThreshold = String -> Float
forall a. Read a => String -> a
read String
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 :: String
onlineFile = String
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 :: Float
scale = String -> Float
forall a. Read a => String -> a
read String
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 :: Maybe String
onLowAction = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Bool
incPerc = Bool
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 :: Float
actionThreshold = String -> Float
forall a. Read a => String -> a
read String
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 :: 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
""
  , 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 :: 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
""
  , 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 :: 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
""
  , 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 :: String
lowString = String
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 :: String
mediumString = String
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 :: String
highString = String
x }) String
"") String
""
  ]

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

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
  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
  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 -> [String] -> IO Result
MB.readBatteries BattOpts
opts [String]
bfs
  Result -> BattOpts -> Monitor String
formatResult Result
c BattOpts
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
  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 Float
x Float
w Float
t 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))
                 (Float
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])
    Result
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 Float
x Bool
sp = do
          let x' :: Float
x' = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float
1, Float
x]
          String
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 (m :: * -> *) a. Monad m => a -> m a
return String
""
          String
p <- Float -> Monitor String
showPercentWithColors Float
x'
          String
b <- Float -> Float -> Monitor String
showPercentBar (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x') Float
x'
          String
vb <- Float -> Float -> Monitor String
showVerticalBar (Float
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 Float
x BattOpts
o Bool
s 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 String
"W" else String
"")
          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 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 (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)
        fmtStatus
          :: BattOpts
          -> Status
          -> String -- ^ What to in case battery status is unknown
          -> 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
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>"
        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)
        getIconPattern :: BattOpts -> Status -> Float -> Monitor String
getIconPattern BattOpts
opts Status
st Float
x = do
          let x' :: Float
x' = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [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'