{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Taffybar.Battery (
batteryBarNew,
batteryBarNewWithFormat,
textBatteryNew,
defaultBatteryConfig
) where
import Control.Applicative
import qualified Control.Exception.Enclosed as E
import Data.Int (Int64)
import Data.IORef
import Graphics.UI.Gtk
import Safe (atMay)
import qualified System.IO as IO
import Text.Printf (printf)
import Text.StringTemplate
import Prelude
import System.Information.Battery
import System.Taffybar.Widgets.PollingBar
import System.Taffybar.Widgets.PollingLabel
data BatteryWidgetInfo = BWI { seconds :: Maybe Int64
, percent :: Int
, status :: String
} deriving (Eq, Show)
combine :: [BatteryWidgetInfo] -> Maybe BatteryWidgetInfo
combine [] = Nothing
combine bs =
Just (BWI { seconds = sum <$> (sequence (seconds <$> bs))
, percent = (sum $ percent <$> bs) `div` (length bs)
, status = status $ head bs
})
formatDuration :: Maybe Int64 -> String
formatDuration Nothing = ""
formatDuration (Just secs) = let minutes = secs `div` 60
hours = minutes `div` 60
minutes' = minutes `mod` 60
in printf "%02d:%02d" hours minutes'
safeGetBatteryInfo :: IORef BatteryContext -> Int -> IO (Maybe BatteryInfo)
safeGetBatteryInfo mv i = do
ctxt <- readIORef mv
E.catchAny (getBatteryInfo ctxt) $ \_ -> reconnect
where
reconnect = do
IO.hPutStrLn IO.stderr "reconnecting"
ctxts <- batteryContextsNew
let mctxt = ctxts `atMay` i
case mctxt of
Nothing -> IO.hPutStrLn IO.stderr "Could not reconnect to UPower"
Just ctxt ->
writeIORef mv ctxt
return Nothing
getBatteryWidgetInfo :: IORef BatteryContext -> Int -> IO (Maybe BatteryWidgetInfo)
getBatteryWidgetInfo r i = do
minfo <- safeGetBatteryInfo r i
case minfo of
Nothing -> return Nothing
Just info -> do
let battPctNum :: Int
battPctNum = floor (batteryPercentage info)
battTime :: Maybe Int64
battTime = case batteryState info of
BatteryStateCharging -> Just $ batteryTimeToFull info
BatteryStateDischarging -> Just $ batteryTimeToEmpty info
_ -> Nothing
battStatus :: String
battStatus = case batteryState info of
BatteryStateCharging -> "Charging"
BatteryStateDischarging -> "Discharging"
_ -> "✔"
return . Just $ BWI { seconds = battTime
, percent = battPctNum
, status = battStatus
}
formatBattInfo :: Maybe BatteryWidgetInfo -> String -> String
formatBattInfo Nothing _ = ""
formatBattInfo (Just info) fmt =
let tpl = newSTMP fmt
tpl' = setManyAttrib [ ("percentage", (show . percent) info)
, ("time", formatDuration (seconds info))
, ("status", status info)
] tpl
in render tpl'
battSumm :: [IORef BatteryContext] -> String -> IO String
battSumm rs fmt = do
winfos <- sequence $ fmap (uncurry getBatteryWidgetInfo) (rs `zip` [0..])
let ws :: [BatteryWidgetInfo]
ws = flatten winfos
flatten [] = []
flatten ((Just a):as) = a:(flatten as)
flatten (Nothing:as) = flatten as
combined = combine ws
return $ formatBattInfo combined fmt
textBatteryNew :: [IORef BatteryContext]
-> String
-> Double
-> IO Widget
textBatteryNew [] _ _ =
let lbl :: Maybe String
lbl = Just "No battery"
in labelNew lbl >>= return . toWidget
textBatteryNew rs fmt pollSeconds = do
l <- pollingLabelNew "" pollSeconds (battSumm rs fmt)
widgetShowAll l
return l
battPct :: IORef BatteryContext -> Int -> IO Double
battPct i r = do
minfo <- safeGetBatteryInfo i r
case minfo of
Nothing -> return 0
Just info -> return (batteryPercentage info / 100)
defaultBatteryConfig :: BarConfig
defaultBatteryConfig =
defaultBarConfig colorFunc
where
colorFunc pct
| pct < 0.1 = (1, 0, 0)
| pct < 0.9 = (0.5, 0.5, 0.5)
| otherwise = (0, 1, 0)
batteryBarNew :: BarConfig -> Double -> IO Widget
batteryBarNew battCfg pollSeconds =
batteryBarNewWithFormat battCfg "$percentage$%" pollSeconds
batteryBarNewWithFormat :: BarConfig -> String -> Double -> IO Widget
batteryBarNewWithFormat battCfg formatString pollSeconds = do
battCtxt <- batteryContextsNew
case battCtxt of
[] -> do
let lbl :: Maybe String
lbl = Just "No battery"
toWidget <$> labelNew lbl
cs -> do
b <- hBoxNew False 1
rs <- sequence $ fmap newIORef cs
txt <- textBatteryNew rs formatString pollSeconds
let ris :: [(IORef BatteryContext, Int)]
ris = rs `zip` [0..]
bars <- sequence $ fmap (\(i, r) -> pollingBarNew battCfg pollSeconds (battPct i r)) ris
mapM_ (\bar -> boxPackStart b bar PackNatural 0) bars
boxPackStart b txt PackNatural 0
widgetShowAll b
return (toWidget b)