{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Taffybar.Widget.Battery ( textBatteryNew, batteryIconNew ) where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Int (Int64)
import qualified Data.Text as T
import GI.Gtk
import Prelude
import StatusNotifier.Tray (scalePixbufToSize)
import System.Taffybar.Context
import System.Taffybar.Information.Battery
import System.Taffybar.Util
import System.Taffybar.Widget.Generic.AutoSizeImage
import System.Taffybar.Widget.Generic.ChannelWidget
import Text.Printf
import Text.StringTemplate
data BatteryWidgetInfo = BWI
{ seconds :: Maybe Int64
, percent :: Int
, status :: String
} deriving (Eq, Show)
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'
getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
getBatteryWidgetInfo info =
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"
_ -> "✔"
in BWI {seconds = battTime, percent = battPctNum, status = battStatus}
formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
formatBattInfo info fmt =
let tpl = newSTMP fmt
tpl' = setManyAttrib [ ("percentage", (show . percent) info)
, ("time", formatDuration (seconds info))
, ("status", status info)
] tpl
in render tpl'
textBatteryNew
:: String
-> TaffyIO Widget
textBatteryNew format = do
chan <- getDisplayBatteryChan
ctx <- ask
let getLabelText info = formatBattInfo (getBatteryWidgetInfo info) format
getBatteryInfoIO = runReaderT getDisplayBatteryInfo ctx
liftIO $ do
label <- getLabelText <$> getBatteryInfoIO >>= labelNew . Just
let setMarkup text = postGUIASync $ labelSetMarkup label text
updateWidget = setMarkup . getLabelText
void $ onWidgetRealize label $ getLabelText <$> getBatteryInfoIO >>= setMarkup
toWidget =<< channelWidgetNew label chan updateWidget
themeLoadFlags :: [IconLookupFlags]
themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]
batteryIconNew :: TaffyIO Widget
batteryIconNew = do
chan <- getDisplayBatteryChan
ctx <- ask
liftIO $ do
image <- imageNew
styleCtx <- widgetGetStyleContext =<< toWidget image
defaultTheme <- iconThemeGetDefault
let getCurrentBatteryIconNameString =
T.pack . batteryIconName <$> runReaderT getDisplayBatteryInfo ctx
extractPixbuf info =
fst <$> iconInfoLoadSymbolicForContext info styleCtx
setIconForSize size = do
name <- getCurrentBatteryIconNameString
iconThemeLookupIcon defaultTheme name size themeLoadFlags >>=
traverse extractPixbuf >>=
traverse (scalePixbufToSize size OrientationHorizontal)
updateImage <- autoSizeImage image setIconForSize OrientationHorizontal
toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage)