hmonitors/src/Monitors/Battery.hs

135 lines
3.8 KiB
Haskell

module Monitors.Battery (queryBattery) where
import Data.List
import Data.Maybe
import System.Process
import Text.Printf
import Text.Regex
import qualified Data.Map as M
import Monitors.Common
data BatteryData = BatteryData
{ battery :: String
, state :: String
, percent :: Int
, time :: Maybe (Int,Int)
}
dischargingIcons :: M.Map Int String
dischargingIcons = M.map buildIcon $ M.fromList
[ ( 0 , 62861 )
, ( 10 , 62841 )
, ( 20 , 62842 )
, ( 30 , 62843 )
, ( 40 , 62844 )
, ( 50 , 62845 )
, ( 60 , 62846 )
, ( 70 , 62847 )
, ( 80 , 62848 )
, ( 90 , 62849 )
, ( 100 , 62840 )
]
chargingIcons :: M.Map Int String
chargingIcons = M.map buildIcon $ M.fromList
[ ( 20 , 62853 )
, ( 30 , 62854 )
, ( 40 , 62855 )
, ( 60 , 62856 )
, ( 80 , 62857 )
, ( 90 , 62858 )
, ( 100 , 62852 )
]
alertIcon :: String
alertIcon = buildIcon 62850
unknownIcon :: String
unknownIcon = buildIcon 62864
fullIcon :: String
fullIcon = buildIcon 62851
getColor :: Int -> String
getColor charge = fromMaybe def (M.lookup getKey colors)
where
getKey
| charge < 20 = "red"
| charge >= 20 && charge < 80 = "yellow"
| charge >= 80 && charge <= 100 = "green"
| otherwise = "active"
def = "#ffffff"
iconSel :: Ord a => a -> M.Map a String -> String
iconSel a xs = fromMaybe def $ findKey a xs >>= lookupKey xs
where
findKey b ys = getNextAbove b (M.keys ys)
lookupKey = flip M.lookup
getNextAbove a = listToMaybe . dropWhile (< a) . sort
def = unknownIcon
getIcon :: BatteryData -> String
getIcon BatteryData { state = "Charging", percent = charge } = iconSel charge chargingIcons
getIcon BatteryData { state = "Discharging", percent = charge } = iconSel charge dischargingIcons
getIcon BatteryData { state = "Full" } = fullIcon
getIcon BatteryData { state = "Unknown" } = unknownIcon
getIcon _ = unknownIcon
parseBatteryInfo :: String -> Maybe BatteryData
parseBatteryInfo = fmap fmtBattery . matchRegex regex
where
regex = mkRegex "^(.+): (.+), ([0-9]+)%(, ([0-9]+):([0-9]+):[0-9]+ .+)?"
fmtBattery [b,s,p,_,h,m] =
let
t = if h /= "" && m /= ""
then Just (read h,read m)
else Nothing
in BatteryData
{ battery = b
, state = s
, percent = read p
, time = t
}
getColorIcon :: BatteryData -> String
getColorIcon BatteryData { state = "Full" } = colorize (colors M.! "active") fullIcon
getColorIcon x@BatteryData { percent = charge } = colorize (getColor charge) (getIcon x)
getStatus :: BatteryData -> String
getStatus x@BatteryData { state = "Full" } = getColorIcon x
getStatus x@BatteryData { state = "Unknown", percent = charge }
| charge >= 95 = getStatus x{ state="Full" }
| otherwise =
let
fmt = "%s %d"
colorIcon = getColorIcon x
in printf fmt colorIcon charge
getStatus x@BatteryData { state = "Charging", percent = charge } =
let
fmt = "%s %d"
colorIcon = getColorIcon x
in printf fmt colorIcon charge
getStatus x@BatteryData { state = "Discharging", percent = charge, time = (Just (h,m)) } =
let
fmt = "%s %d (%d:%02d)"
colorIcon = getColorIcon x
in printf fmt colorIcon charge h m
getStatus _ = colorize (colors M.! "active") unknownIcon
parseAcpiStdout :: String -> [BatteryData]
parseAcpiStdout = mapMaybe parseBatteryInfo . lines
fmtData :: [BatteryData] -> String
fmtData = (separator ++ ) . intercalate separator . map getStatus
runAcpi :: IO String
runAcpi = readProcess "acpi" ["-b"] ""
queryBattery :: IO String
queryBattery = fmtData . parseAcpiStdout <$> runAcpi