content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : System.Taffybar.Widget.Battery
  -- Copyright   : (c) Ivan A. Malison
  -- License     : BSD3-style (see LICENSE)
  --
  -- Maintainer  : Ivan A. Malison
  -- Stability   : unstable
  -- Portability : unportable
  --
  -- This module provides battery widgets that are queried using the UPower dbus
  -- service. To avoid duplicating all information requests for each battery
  -- widget displayed (if using a multi-head configuration or multiple battery
  -- widgets), these widgets use the broadcast "TChan" based system for receiving
  -- updates defined in "System.Taffybar.Information.Battery".
  -----------------------------------------------------------------------------
  module System.Taffybar.Widget.Battery
    ( batteryIconNew
    , textBatteryNew
    , textBatteryNewWithLabelAction
    ) where
  
  import           Control.Monad
  import           Control.Monad.IO.Class
  import           Control.Monad.Trans.Reader
  import           Data.Default (Default(..))
  import           Data.Int (Int64)
  import qualified Data.Text as T
  import           GI.Gtk as Gtk
  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           System.Taffybar.Widget.Util hiding (themeLoadFlags)
  import           Text.Printf
  import           Text.StringTemplate
  
  -- | Just the battery info that will be used for display (this makes combining
  -- several easier).
  data BatteryWidgetInfo = BWI
    { seconds :: Maybe Int64
    , percent :: Int
    , status :: String
    } deriving (Eq, Show)
  
  -- | Format a duration expressed as seconds to hours and minutes
  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}
  
  -- | Given (maybe summarized) battery info and format: provides the string to display
  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'
  
  -- | A simple textual battery widget. The displayed format is specified format
  -- string where $percentage$ is replaced with the percentage of battery
  -- remaining and $time$ is replaced with the time until the battery is fully
  -- charged/discharged.
  textBatteryNew :: String -> TaffyIO Widget
  textBatteryNew format = textBatteryNewWithLabelAction labelSetter
    where labelSetter label info = do
            setBatteryStateClasses def label info
            labelSetMarkup label $
                           formatBattInfo (getBatteryWidgetInfo info) format
  
  data BatteryClassesConfig = BatteryClassesConfig
    { batteryHighThreshold :: Double
    , batteryLowThreshold :: Double
    , batteryCriticalThreshold :: Double
    }
  
  defaultBatteryClassesConfig :: BatteryClassesConfig
  defaultBatteryClassesConfig =
    BatteryClassesConfig
    { batteryHighThreshold = 80
    , batteryLowThreshold = 20
    , batteryCriticalThreshold = 5
    }
  
  instance Default BatteryClassesConfig where
    def = defaultBatteryClassesConfig
  
  setBatteryStateClasses ::
    MonadIO m => BatteryClassesConfig -> Gtk.Label -> BatteryInfo -> m ()
  setBatteryStateClasses config label info = do
    case batteryState info of
      BatteryStateCharging -> addClassIfMissing "charging" label >>
                              removeClassIfPresent "discharging" label
      BatteryStateDischarging -> addClassIfMissing "discharging" label >>
                                 removeClassIfPresent "charging" label
      _ -> removeClassIfPresent "charging" label >>
           removeClassIfPresent "discharging" label
  
    classIf "high" $ percentage >= batteryHighThreshold config
    classIf "low" $ percentage <= batteryLowThreshold config
    classIf "critical" $ percentage <= batteryCriticalThreshold config
    where percentage = batteryPercentage info
          classIf klass condition =
            if condition
            then addClassIfMissing klass label
            else removeClassIfPresent klass label
  
  -- | Like `textBatteryNew` but provides a more general way to update the label
  -- widget. The argument provided is an action that is used to update the text
  -- label given a 'BatteryInfo' object describing the state of the battery.
  textBatteryNewWithLabelAction ::
    (Gtk.Label -> BatteryInfo -> TaffyIO ()) -> TaffyIO Widget
  textBatteryNewWithLabelAction labelSetter = do
    chan <- getDisplayBatteryChan
    ctx <- ask
    liftIO $ do
      label <- labelNew Nothing
      let updateWidget =
            postGUIASync . flip runReaderT ctx . labelSetter label
      void $ onWidgetRealize label $
           runReaderT getDisplayBatteryInfo ctx >>= updateWidget
      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)
  