{-# 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 ( 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

-- | Just the battery info that will be used for display (this makes combining
-- several easier).
data BatteryWidgetInfo = BWI
  { BatteryWidgetInfo -> Maybe Int64
seconds :: Maybe Int64
  , BatteryWidgetInfo -> Int
percent :: Int
  , BatteryWidgetInfo -> String
status :: String
  } deriving (BatteryWidgetInfo -> BatteryWidgetInfo -> Bool
(BatteryWidgetInfo -> BatteryWidgetInfo -> Bool)
-> (BatteryWidgetInfo -> BatteryWidgetInfo -> Bool)
-> Eq BatteryWidgetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatteryWidgetInfo -> BatteryWidgetInfo -> Bool
$c/= :: BatteryWidgetInfo -> BatteryWidgetInfo -> Bool
== :: BatteryWidgetInfo -> BatteryWidgetInfo -> Bool
$c== :: BatteryWidgetInfo -> BatteryWidgetInfo -> Bool
Eq, Int -> BatteryWidgetInfo -> ShowS
[BatteryWidgetInfo] -> ShowS
BatteryWidgetInfo -> String
(Int -> BatteryWidgetInfo -> ShowS)
-> (BatteryWidgetInfo -> String)
-> ([BatteryWidgetInfo] -> ShowS)
-> Show BatteryWidgetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatteryWidgetInfo] -> ShowS
$cshowList :: [BatteryWidgetInfo] -> ShowS
show :: BatteryWidgetInfo -> String
$cshow :: BatteryWidgetInfo -> String
showsPrec :: Int -> BatteryWidgetInfo -> ShowS
$cshowsPrec :: Int -> BatteryWidgetInfo -> ShowS
Show)

-- | Format a duration expressed as seconds to hours and minutes
formatDuration :: Maybe Int64 -> String
formatDuration :: Maybe Int64 -> String
formatDuration Nothing = ""
formatDuration (Just secs :: Int64
secs) = let minutes :: Int64
minutes = Int64
secs Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 60
                                 hours :: Int64
hours = Int64
minutes Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 60
                                 minutes' :: Int64
minutes' = Int64
minutes Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` 60
                             in String -> Int64 -> Int64 -> String
forall r. PrintfType r => String -> r
printf "%02d:%02d" Int64
hours Int64
minutes'

getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
getBatteryWidgetInfo info :: BatteryInfo
info =
  let battPctNum :: Int
      battPctNum :: Int
battPctNum = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (BatteryInfo -> Double
batteryPercentage BatteryInfo
info)
      battTime :: Maybe Int64
      battTime :: Maybe Int64
battTime =
        case BatteryInfo -> BatteryState
batteryState BatteryInfo
info of
          BatteryStateCharging -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ BatteryInfo -> Int64
batteryTimeToFull BatteryInfo
info
          BatteryStateDischarging -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ BatteryInfo -> Int64
batteryTimeToEmpty BatteryInfo
info
          _ -> Maybe Int64
forall a. Maybe a
Nothing
      battStatus :: String
      battStatus :: String
battStatus =
        case BatteryInfo -> BatteryState
batteryState BatteryInfo
info of
          BatteryStateCharging -> "Charging"
          BatteryStateDischarging -> "Discharging"
          _ -> "✔"
  in BWI :: Maybe Int64 -> Int -> String -> BatteryWidgetInfo
BWI {seconds :: Maybe Int64
seconds = Maybe Int64
battTime, percent :: Int
percent = Int
battPctNum, status :: String
status = String
battStatus}

-- | Given (maybe summarized) battery info and format: provides the string to display
formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
formatBattInfo :: BatteryWidgetInfo -> String -> Text
formatBattInfo info :: BatteryWidgetInfo
info fmt :: String
fmt =
  let tpl :: StringTemplate Text
tpl = String -> StringTemplate Text
forall a. Stringable a => String -> StringTemplate a
newSTMP String
fmt
      tpl' :: StringTemplate Text
tpl' = [(String, String)] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
[(String, a)] -> StringTemplate b -> StringTemplate b
setManyAttrib [ ("percentage", (Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (BatteryWidgetInfo -> Int) -> BatteryWidgetInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatteryWidgetInfo -> Int
percent) BatteryWidgetInfo
info)
                           , ("time", Maybe Int64 -> String
formatDuration (BatteryWidgetInfo -> Maybe Int64
seconds BatteryWidgetInfo
info))
                           , ("status", BatteryWidgetInfo -> String
status BatteryWidgetInfo
info)
                           ] StringTemplate Text
tpl
  in StringTemplate Text -> Text
forall a. Stringable a => StringTemplate a -> a
render StringTemplate Text
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 -- ^ Display format
  -> TaffyIO Widget
textBatteryNew :: String -> TaffyIO Widget
textBatteryNew format :: String
format = do
  BroadcastChan In BatteryInfo
chan <- TaffyIO (BroadcastChan In BatteryInfo)
getDisplayBatteryChan
  Context
ctx <- ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let getLabelText :: BatteryInfo -> Text
getLabelText info :: BatteryInfo
info = BatteryWidgetInfo -> String -> Text
formatBattInfo (BatteryInfo -> BatteryWidgetInfo
getBatteryWidgetInfo BatteryInfo
info) String
format
      getBatteryInfoIO :: IO BatteryInfo
getBatteryInfoIO = ReaderT Context IO BatteryInfo -> Context -> IO BatteryInfo
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Context IO BatteryInfo
getDisplayBatteryInfo Context
ctx
  IO Widget -> TaffyIO Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> TaffyIO Widget) -> IO Widget -> TaffyIO Widget
forall a b. (a -> b) -> a -> b
$ do
    Label
label <- BatteryInfo -> Text
getLabelText (BatteryInfo -> Text) -> IO BatteryInfo -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BatteryInfo
getBatteryInfoIO IO Text -> (Text -> IO Label) -> IO Label
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew (Maybe Text -> IO Label)
-> (Text -> Maybe Text) -> Text -> IO Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just
    let setMarkup :: Text -> IO ()
setMarkup text :: Text
text = IO () -> IO ()
postGUIASync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
labelSetMarkup Label
label Text
text
        updateWidget :: BatteryInfo -> IO ()
updateWidget = Text -> IO ()
setMarkup (Text -> IO ()) -> (BatteryInfo -> Text) -> BatteryInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatteryInfo -> Text
getLabelText
    IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Label -> IO () -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onWidgetRealize Label
label (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ BatteryInfo -> Text
getLabelText (BatteryInfo -> Text) -> IO BatteryInfo -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BatteryInfo
getBatteryInfoIO IO Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO ()
setMarkup
    Label -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget (Label -> IO Widget) -> IO Label -> IO Widget
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Label
-> BroadcastChan In BatteryInfo
-> (BatteryInfo -> IO ())
-> IO Label
forall (m :: * -> *) w a.
(MonadIO m, IsWidget w) =>
w -> BroadcastChan In a -> (a -> IO ()) -> m w
channelWidgetNew Label
label BroadcastChan In BatteryInfo
chan BatteryInfo -> IO ()
updateWidget

themeLoadFlags :: [IconLookupFlags]
themeLoadFlags :: [IconLookupFlags]
themeLoadFlags = [IconLookupFlags
IconLookupFlagsGenericFallback, IconLookupFlags
IconLookupFlagsUseBuiltin]

batteryIconNew :: TaffyIO Widget
batteryIconNew :: TaffyIO Widget
batteryIconNew = do
  BroadcastChan In BatteryInfo
chan <- TaffyIO (BroadcastChan In BatteryInfo)
getDisplayBatteryChan
  Context
ctx <- ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO Widget -> TaffyIO Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> TaffyIO Widget) -> IO Widget -> TaffyIO Widget
forall a b. (a -> b) -> a -> b
$ do
    Image
image <- IO Image
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
imageNew
    StyleContext
styleCtx <- Widget -> IO StyleContext
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m StyleContext
widgetGetStyleContext (Widget -> IO StyleContext) -> IO Widget -> IO StyleContext
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Image -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget Image
image
    IconTheme
defaultTheme <- IO IconTheme
forall (m :: * -> *). (HasCallStack, MonadIO m) => m IconTheme
iconThemeGetDefault
    let getCurrentBatteryIconNameString :: IO Text
getCurrentBatteryIconNameString =
          String -> Text
T.pack (String -> Text) -> (BatteryInfo -> String) -> BatteryInfo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatteryInfo -> String
batteryIconName (BatteryInfo -> Text) -> IO BatteryInfo -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Context IO BatteryInfo -> Context -> IO BatteryInfo
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Context IO BatteryInfo
getDisplayBatteryInfo Context
ctx
        extractPixbuf :: IconInfo -> IO Pixbuf
extractPixbuf info :: IconInfo
info =
          (Pixbuf, Bool) -> Pixbuf
forall a b. (a, b) -> a
fst ((Pixbuf, Bool) -> Pixbuf) -> IO (Pixbuf, Bool) -> IO Pixbuf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IconInfo -> StyleContext -> IO (Pixbuf, Bool)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIconInfo a, IsStyleContext b) =>
a -> b -> m (Pixbuf, Bool)
iconInfoLoadSymbolicForContext IconInfo
info StyleContext
styleCtx
        setIconForSize :: Int32 -> IO (Maybe Pixbuf)
setIconForSize size :: Int32
size = do
          Text
name <- IO Text
getCurrentBatteryIconNameString
          IconTheme
-> Text -> Int32 -> [IconLookupFlags] -> IO (Maybe IconInfo)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIconTheme a) =>
a -> Text -> Int32 -> [IconLookupFlags] -> m (Maybe IconInfo)
iconThemeLookupIcon IconTheme
defaultTheme Text
name Int32
size [IconLookupFlags]
themeLoadFlags IO (Maybe IconInfo)
-> (Maybe IconInfo -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (IconInfo -> IO Pixbuf) -> Maybe IconInfo -> IO (Maybe Pixbuf)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse IconInfo -> IO Pixbuf
extractPixbuf IO (Maybe Pixbuf)
-> (Maybe Pixbuf -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              (Pixbuf -> IO Pixbuf) -> Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Int32 -> Orientation -> Pixbuf -> IO Pixbuf
scalePixbufToSize Int32
size Orientation
OrientationHorizontal)
    IO ()
updateImage <- Image -> (Int32 -> IO (Maybe Pixbuf)) -> Orientation -> IO (IO ())
forall (m :: * -> *).
MonadIO m =>
Image -> (Int32 -> IO (Maybe Pixbuf)) -> Orientation -> m (IO ())
autoSizeImage Image
image Int32 -> IO (Maybe Pixbuf)
setIconForSize Orientation
OrientationHorizontal
    Image -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget (Image -> IO Widget) -> IO Image -> IO Widget
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Image
-> BroadcastChan In BatteryInfo
-> (BatteryInfo -> IO ())
-> IO Image
forall (m :: * -> *) w a.
(MonadIO m, IsWidget w) =>
w -> BroadcastChan In a -> (a -> IO ()) -> m w
channelWidgetNew Image
image BroadcastChan In BatteryInfo
chan (IO () -> BatteryInfo -> IO ()
forall a b. a -> b -> a
const (IO () -> BatteryInfo -> IO ()) -> IO () -> BatteryInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
postGUIASync IO ()
updateImage)