Battery.hs

{-# 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 using the UPower system
-- service.
--
-- Currently it reports only the first battery it finds.  If it does
-- not find a battery, it just returns an obnoxious widget with
-- warning text in it.  Battery hotplugging is not supported.  These
-- more advanced features could be supported if there is interest.
-----------------------------------------------------------------------------
module System.Taffybar.Widget.Battery
  ( batteryBarNew
  , batteryBarNewWithFormat
  , textBatteryNew
  , defaultBatteryConfig
  ) where

import           Control.Applicative
import qualified Control.Exception.Enclosed as E
import           Control.Monad.Trans
import           Data.IORef
import           Data.Int (Int64)
import           Graphics.UI.Gtk
import           Safe (atMay)
import qualified System.IO as IO
import           Text.Printf (printf)
import           Text.StringTemplate

import           Prelude

import           System.Taffybar.Information.Battery
import           System.Taffybar.Widget.Generic.PollingBar
import           System.Taffybar.Widget.Generic.PollingLabel


-- | 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)

-- | Combination for 'BatteryWidgetInfo'.
-- If one battery lacks time information, combination has no time information
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
    }

-- | 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'

safeGetBatteryInfo :: IORef BatteryContext -> Int -> IO (Maybe BatteryInfo)
safeGetBatteryInfo mv i = do
  ctxt <- readIORef mv
  E.catchAny (getBatteryInfo ctxt) $ const 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
                          }


-- | Given (maybe summarized) battery info and format: provides the string to display
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'

-- | Provides textual information regarding multiple batteries
battSumm :: [IORef BatteryContext] -> String -> IO String
battSumm rs fmt = do
  winfos <- traverse (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


-- | A simple textual battery widget that auto-updates once every polling period
-- (specified in seconds). 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.
--
-- Multiple battery values are combined as follows:
-- - for time remaining, the largest value is used.
-- - for percentage, the mean is taken.
textBatteryNew :: [IORef BatteryContext]
                    -> String -- ^ Display format
                    -> Double -- ^ Poll period in seconds
                    -> IO Widget
textBatteryNew [] _ _ =
  let lbl :: Maybe String
      lbl = Just "No battery"
  in toWidget <$> labelNew lbl
textBatteryNew rs fmt pollSeconds = do
    l <- pollingLabelNew "" pollSeconds (battSumm rs fmt)
    widgetShowAll l
    return l


-- | Returns the current battery percent as a double in the range [0,
-- 1]
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)

-- | A default configuration for the graphical battery display.  The
-- bar will be red when power is critical (< 10%), green if it is full
-- (> 90%), and grey otherwise.
--
-- You can customize this with any of the options in 'BarConfig'
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)


-- | A fancy graphical battery widget that represents batteries as colored
-- vertical bars (one per battery). There is also a textual percentage reppadout
-- next to the bars, containing a summary of battery information.
batteryBarNew :: MonadIO m => BarConfig -> Double -> m Widget
batteryBarNew battCfg = liftIO .
  batteryBarNewWithFormat battCfg "$percentage$%"

-- | A battery bar constructor which allows using a custom format string in
-- order to display more information, such as charging/discharging time and
-- status. An example: "$percentage$% ($time$) - $status$".
batteryBarNewWithFormat :: MonadIO m => BarConfig -> String -> Double -> m Widget
batteryBarNewWithFormat battCfg formatString pollSeconds =
  liftIO $ 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 <- traverse newIORef cs
        txt <- textBatteryNew rs formatString pollSeconds
        let ris :: [(IORef BatteryContext, Int)]
            ris = rs `zip` [0 ..]
        bars <-
          traverse
            (\(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)