{-# LANGUAGE OverloadedStrings #-}
-- | This is a simple library to query the Linux UPower daemon (via DBus) for
-- battery information.
module System.Taffybar.Information.Battery
  (
  -- * Types
    BatteryInfo(..)
  , BatteryState(..)
  , BatteryTechnology(..)
  , BatteryType(..)
  , module System.Taffybar.Information.Battery
  ) where

import           BroadcastChan
import           Control.Concurrent
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Reader
import           DBus
import           DBus.Client
import           DBus.Internal.Types (Serial(..))
import qualified DBus.TH as DBus
import           Data.Int
import           Data.List
import           Data.Map ( Map )
import qualified Data.Map as M
import           Data.Maybe
import           Data.Text ( Text )
import           Data.Word
import           System.Log.Logger
import           System.Taffybar.Context
import           System.Taffybar.DBus.Client.Params
import           System.Taffybar.DBus.Client.UPower
import           System.Taffybar.DBus.Client.UPowerDevice
import           System.Taffybar.Util

batteryLogPath :: String
batteryLogPath :: String
batteryLogPath = "System.Taffybar.Information.Battery"

batteryLog
  :: MonadIO m
  => Priority -> String -> m ()
batteryLog :: Priority -> String -> m ()
batteryLog priority :: Priority
priority = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Priority -> String -> IO ()
logM String
batteryLogPath Priority
priority

batteryLogF
  :: (MonadIO m, Show t)
  => Priority -> String -> t -> m ()
batteryLogF :: Priority -> String -> t -> m ()
batteryLogF = String -> Priority -> String -> t -> m ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
String -> Priority -> String -> t -> m ()
logPrintF String
batteryLogPath

-- | The prefix of name of battery devices path. UPower generates the object
-- path as "battery" + "_" + basename of the sysfs object.
batteryPrefix :: String
batteryPrefix :: String
batteryPrefix = ObjectPath -> String
formatObjectPath ObjectPath
uPowerBaseObjectPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/devices/battery_"

-- | Determine if a power source is a battery.
isBattery :: ObjectPath -> Bool
isBattery :: ObjectPath -> Bool
isBattery = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
batteryPrefix (String -> Bool) -> (ObjectPath -> String) -> ObjectPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectPath -> String
formatObjectPath

-- | A helper to read the variant contents of a dict with a default
-- value.
readDict :: (IsVariant a) => Map Text Variant -> Text -> a -> a
readDict :: Map Text Variant -> Text -> a -> a
readDict dict :: Map Text Variant
dict key :: Text
key dflt :: a
dflt = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
dflt (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ do
  Variant
variant <- Text -> Map Text Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text Variant
dict
  Variant -> Maybe a
forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
variant

-- | Read the variant contents of a dict which is of an unknown integral type.
readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int
readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int
readDictIntegral dict :: Map Text Variant
dict key :: Text
key dflt :: Int32
dflt = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dflt) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ do
  Variant
v <- Text -> Map Text Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text Variant
dict
  case Variant -> Type
variantType Variant
v of
    TypeWord8   -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Word8
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Word8)
    TypeWord16  -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Word16
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Word16)
    TypeWord32  -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Word32
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Word32)
    TypeWord64  -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Word64
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Word64)
    TypeInt16   -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Int16
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Int16)
    TypeInt32   -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Int32
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Int32)
    TypeInt64   -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Int64
forall a. (Num a, IsVariant a) => Variant -> a
f Variant
v :: Int64)
    _           -> Maybe Int
forall a. Maybe a
Nothing
  where
    f :: (Num a, IsVariant a) => Variant -> a
    f :: Variant -> a
f = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dflt) (Maybe a -> a) -> (Variant -> Maybe a) -> Variant -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Maybe a
forall a. IsVariant a => Variant -> Maybe a
fromVariant

-- XXX: Remove this once it is exposed in haskell-dbus
dummyMethodError :: MethodError
dummyMethodError :: MethodError
dummyMethodError = Serial -> ErrorName -> MethodError
methodError (Word32 -> Serial
Serial 1) (ErrorName -> MethodError) -> ErrorName -> MethodError
forall a b. (a -> b) -> a -> b
$ String -> ErrorName
errorName_ "org.ClientTypeMismatch"

-- | Query the UPower daemon about information on a specific battery.
-- If some fields are not actually present, they may have bogus values
-- here.  Don't bet anything critical on it.
getBatteryInfo :: ObjectPath -> TaffyIO (Either MethodError BatteryInfo)
getBatteryInfo :: ObjectPath -> TaffyIO (Either MethodError BatteryInfo)
getBatteryInfo battPath :: ObjectPath
battPath = (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
systemDBusClient ReaderT Context IO Client
-> (Client -> TaffyIO (Either MethodError BatteryInfo))
-> TaffyIO (Either MethodError BatteryInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \client :: Client
client -> IO (Either MethodError BatteryInfo)
-> TaffyIO (Either MethodError BatteryInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either MethodError BatteryInfo)
 -> TaffyIO (Either MethodError BatteryInfo))
-> IO (Either MethodError BatteryInfo)
-> TaffyIO (Either MethodError BatteryInfo)
forall a b. (a -> b) -> a -> b
$ ExceptT MethodError IO BatteryInfo
-> IO (Either MethodError BatteryInfo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MethodError IO BatteryInfo
 -> IO (Either MethodError BatteryInfo))
-> ExceptT MethodError IO BatteryInfo
-> IO (Either MethodError BatteryInfo)
forall a b. (a -> b) -> a -> b
$ do
  MethodReturn
reply <- IO (Either MethodError MethodReturn)
-> ExceptT MethodError IO MethodReturn
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either MethodError MethodReturn)
 -> ExceptT MethodError IO MethodReturn)
-> IO (Either MethodError MethodReturn)
-> ExceptT MethodError IO MethodReturn
forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO (Either MethodError MethodReturn)
getAllProperties Client
client (MethodCall -> IO (Either MethodError MethodReturn))
-> MethodCall -> IO (Either MethodError MethodReturn)
forall a b. (a -> b) -> a -> b
$
           (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
battPath InterfaceName
uPowerDeviceInterfaceName "FakeMethod")
           { methodCallDestination :: Maybe BusName
methodCallDestination = BusName -> Maybe BusName
forall a. a -> Maybe a
Just BusName
uPowerBusName }
  Map Text Variant
dict <- IO (Either MethodError (Map Text Variant))
-> ExceptT MethodError IO (Map Text Variant)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either MethodError (Map Text Variant))
 -> ExceptT MethodError IO (Map Text Variant))
-> IO (Either MethodError (Map Text Variant))
-> ExceptT MethodError IO (Map Text Variant)
forall a b. (a -> b) -> a -> b
$ Either MethodError (Map Text Variant)
-> IO (Either MethodError (Map Text Variant))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MethodError (Map Text Variant)
 -> IO (Either MethodError (Map Text Variant)))
-> Either MethodError (Map Text Variant)
-> IO (Either MethodError (Map Text Variant))
forall a b. (a -> b) -> a -> b
$ MethodError
-> Maybe (Map Text Variant)
-> Either MethodError (Map Text Variant)
forall b a. b -> Maybe a -> Either b a
maybeToEither MethodError
dummyMethodError (Maybe (Map Text Variant) -> Either MethodError (Map Text Variant))
-> Maybe (Map Text Variant)
-> Either MethodError (Map Text Variant)
forall a b. (a -> b) -> a -> b
$
         [Variant] -> Maybe Variant
forall a. [a] -> Maybe a
listToMaybe (MethodReturn -> [Variant]
methodReturnBody MethodReturn
reply) Maybe Variant
-> (Variant -> Maybe (Map Text Variant))
-> Maybe (Map Text Variant)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variant -> Maybe (Map Text Variant)
forall a. IsVariant a => Variant -> Maybe a
fromVariant
  BatteryInfo -> ExceptT MethodError IO BatteryInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (BatteryInfo -> ExceptT MethodError IO BatteryInfo)
-> BatteryInfo -> ExceptT MethodError IO BatteryInfo
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> BatteryInfo
infoMapToBatteryInfo Map Text Variant
dict

infoMapToBatteryInfo :: Map Text Variant -> BatteryInfo
infoMapToBatteryInfo :: Map Text Variant -> BatteryInfo
infoMapToBatteryInfo dict :: Map Text Variant
dict =
    BatteryInfo :: String
-> String
-> String
-> String
-> Word64
-> BatteryType
-> Bool
-> Bool
-> Bool
-> Bool
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Int64
-> Int64
-> Double
-> Double
-> Bool
-> BatteryState
-> Bool
-> Double
-> BatteryTechnology
-> Word32
-> Word32
-> String
-> BatteryInfo
BatteryInfo
      { batteryNativePath :: String
batteryNativePath = Map Text Variant -> Text -> String -> String
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "NativePath" ""
      , batteryVendor :: String
batteryVendor = Map Text Variant -> Text -> String -> String
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Vendor" ""
      , batteryModel :: String
batteryModel = Map Text Variant -> Text -> String -> String
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Model" ""
      , batterySerial :: String
batterySerial = Map Text Variant -> Text -> String -> String
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Serial" ""
      , batteryType :: BatteryType
batteryType = Int -> BatteryType
forall a. Enum a => Int -> a
toEnum (Int -> BatteryType) -> Int -> BatteryType
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> Text -> Int32 -> Int
readDictIntegral Map Text Variant
dict "Type" 0
      , batteryPowerSupply :: Bool
batteryPowerSupply = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "PowerSupply" Bool
False
      , batteryHasHistory :: Bool
batteryHasHistory = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "HasHistory" Bool
False
      , batteryHasStatistics :: Bool
batteryHasStatistics = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "HasStatistics" Bool
False
      , batteryOnline :: Bool
batteryOnline = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Online" Bool
False
      , batteryEnergy :: Double
batteryEnergy = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Energy" 0.0
      , batteryEnergyEmpty :: Double
batteryEnergyEmpty = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "EnergyEmpty" 0.0
      , batteryEnergyFull :: Double
batteryEnergyFull = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "EnergyFull" 0.0
      , batteryEnergyFullDesign :: Double
batteryEnergyFullDesign = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "EnergyFullDesign" 0.0
      , batteryEnergyRate :: Double
batteryEnergyRate = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "EnergyRate" 0.0
      , batteryVoltage :: Double
batteryVoltage = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Voltage" 0.0
      , batteryTimeToEmpty :: Int64
batteryTimeToEmpty = Map Text Variant -> Text -> Int64 -> Int64
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "TimeToEmpty" 0
      , batteryTimeToFull :: Int64
batteryTimeToFull = Map Text Variant -> Text -> Int64 -> Int64
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "TimeToFull" 0
      , batteryPercentage :: Double
batteryPercentage = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Percentage" 0.0
      , batteryIsPresent :: Bool
batteryIsPresent = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "IsPresent" Bool
False
      , batteryState :: BatteryState
batteryState = Int -> BatteryState
forall a. Enum a => Int -> a
toEnum (Int -> BatteryState) -> Int -> BatteryState
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> Text -> Int32 -> Int
readDictIntegral Map Text Variant
dict "State" 0
      , batteryIsRechargeable :: Bool
batteryIsRechargeable = Map Text Variant -> Text -> Bool -> Bool
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "IsRechargable" Bool
True
      , batteryCapacity :: Double
batteryCapacity = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Capacity" 0.0
      , batteryTechnology :: BatteryTechnology
batteryTechnology =
          Int -> BatteryTechnology
forall a. Enum a => Int -> a
toEnum (Int -> BatteryTechnology) -> Int -> BatteryTechnology
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> Text -> Int32 -> Int
readDictIntegral Map Text Variant
dict "Technology" 0
      , batteryUpdateTime :: Word64
batteryUpdateTime = Map Text Variant -> Text -> Word64 -> Word64
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "UpdateTime" 0
      , batteryLuminosity :: Double
batteryLuminosity = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Luminosity" 0.0
      , batteryTemperature :: Double
batteryTemperature = Map Text Variant -> Text -> Double -> Double
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "Temperature" 0.0
      , batteryWarningLevel :: Word32
batteryWarningLevel = Map Text Variant -> Text -> Word32 -> Word32
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "WarningLevel" 0
      , batteryBatteryLevel :: Word32
batteryBatteryLevel = Map Text Variant -> Text -> Word32 -> Word32
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "BatteryLevel" 0
      , batteryIconName :: String
batteryIconName = Map Text Variant -> Text -> String -> String
forall a. IsVariant a => Map Text Variant -> Text -> a -> a
readDict Map Text Variant
dict "IconName" ""
      }

getBatteryPaths :: TaffyIO (Either MethodError [ObjectPath])
getBatteryPaths :: TaffyIO (Either MethodError [ObjectPath])
getBatteryPaths = do
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
systemDBusClient
  IO (Either MethodError [ObjectPath])
-> TaffyIO (Either MethodError [ObjectPath])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either MethodError [ObjectPath])
 -> TaffyIO (Either MethodError [ObjectPath]))
-> IO (Either MethodError [ObjectPath])
-> TaffyIO (Either MethodError [ObjectPath])
forall a b. (a -> b) -> a -> b
$ ExceptT MethodError IO [ObjectPath]
-> IO (Either MethodError [ObjectPath])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MethodError IO [ObjectPath]
 -> IO (Either MethodError [ObjectPath]))
-> ExceptT MethodError IO [ObjectPath]
-> IO (Either MethodError [ObjectPath])
forall a b. (a -> b) -> a -> b
$ do
    [ObjectPath]
paths <- IO (Either MethodError [ObjectPath])
-> ExceptT MethodError IO [ObjectPath]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either MethodError [ObjectPath])
 -> ExceptT MethodError IO [ObjectPath])
-> IO (Either MethodError [ObjectPath])
-> ExceptT MethodError IO [ObjectPath]
forall a b. (a -> b) -> a -> b
$ Client -> IO (Either MethodError [ObjectPath])
enumerateDevices Client
client
    [ObjectPath] -> ExceptT MethodError IO [ObjectPath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ObjectPath] -> ExceptT MethodError IO [ObjectPath])
-> [ObjectPath] -> ExceptT MethodError IO [ObjectPath]
forall a b. (a -> b) -> a -> b
$ (ObjectPath -> Bool) -> [ObjectPath] -> [ObjectPath]
forall a. (a -> Bool) -> [a] -> [a]
filter ObjectPath -> Bool
isBattery [ObjectPath]
paths

newtype DisplayBatteryChanVar =
  DisplayBatteryChanVar (BroadcastChan In BatteryInfo, MVar BatteryInfo)

getDisplayBatteryInfo :: TaffyIO BatteryInfo
getDisplayBatteryInfo :: TaffyIO BatteryInfo
getDisplayBatteryInfo = do
  DisplayBatteryChanVar (_, theVar :: MVar BatteryInfo
theVar) <- TaffyIO DisplayBatteryChanVar
getDisplayBatteryChanVar
  IO BatteryInfo -> TaffyIO BatteryInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO BatteryInfo -> TaffyIO BatteryInfo)
-> IO BatteryInfo -> TaffyIO BatteryInfo
forall a b. (a -> b) -> a -> b
$ MVar BatteryInfo -> IO BatteryInfo
forall a. MVar a -> IO a
readMVar MVar BatteryInfo
theVar

defaultMonitorDisplayBatteryProperties :: [String]
defaultMonitorDisplayBatteryProperties :: [String]
defaultMonitorDisplayBatteryProperties = [ "IconName", "State", "Percentage" ]

-- | Start the monitoring of the display battery, and setup the associated
-- channel and mvar for the current state.
setupDisplayBatteryChanVar :: [String] -> TaffyIO DisplayBatteryChanVar
setupDisplayBatteryChanVar :: [String] -> TaffyIO DisplayBatteryChanVar
setupDisplayBatteryChanVar properties :: [String]
properties = Taffy IO DisplayBatteryChanVar -> TaffyIO DisplayBatteryChanVar
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (Taffy IO DisplayBatteryChanVar -> TaffyIO DisplayBatteryChanVar)
-> Taffy IO DisplayBatteryChanVar -> TaffyIO DisplayBatteryChanVar
forall a b. (a -> b) -> a -> b
$
  (BroadcastChan In BatteryInfo, MVar BatteryInfo)
-> DisplayBatteryChanVar
DisplayBatteryChanVar ((BroadcastChan In BatteryInfo, MVar BatteryInfo)
 -> DisplayBatteryChanVar)
-> ReaderT
     Context IO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
-> TaffyIO DisplayBatteryChanVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
-> ReaderT
     Context IO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
monitorDisplayBattery [String]
properties

getDisplayBatteryChanVar :: TaffyIO DisplayBatteryChanVar
getDisplayBatteryChanVar :: TaffyIO DisplayBatteryChanVar
getDisplayBatteryChanVar =
  [String] -> TaffyIO DisplayBatteryChanVar
setupDisplayBatteryChanVar [String]
defaultMonitorDisplayBatteryProperties

getDisplayBatteryChan :: TaffyIO (BroadcastChan In BatteryInfo)
getDisplayBatteryChan :: TaffyIO (BroadcastChan In BatteryInfo)
getDisplayBatteryChan = do
  DisplayBatteryChanVar (chan :: BroadcastChan In BatteryInfo
chan, _) <- TaffyIO DisplayBatteryChanVar
getDisplayBatteryChanVar
  BroadcastChan In BatteryInfo
-> TaffyIO (BroadcastChan In BatteryInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return BroadcastChan In BatteryInfo
chan

updateBatteryInfo
  :: BroadcastChan In BatteryInfo
  -> MVar BatteryInfo
  -> ObjectPath
  -> TaffyIO ()
updateBatteryInfo :: BroadcastChan In BatteryInfo
-> MVar BatteryInfo -> ObjectPath -> TaffyIO ()
updateBatteryInfo chan :: BroadcastChan In BatteryInfo
chan var :: MVar BatteryInfo
var path :: ObjectPath
path =
  ObjectPath -> TaffyIO (Either MethodError BatteryInfo)
getBatteryInfo ObjectPath
path TaffyIO (Either MethodError BatteryInfo)
-> (Either MethodError BatteryInfo -> TaffyIO ()) -> TaffyIO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ())
-> (Either MethodError BatteryInfo -> IO ())
-> Either MethodError BatteryInfo
-> TaffyIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MethodError -> IO ())
-> (BatteryInfo -> IO ())
-> Either MethodError BatteryInfo
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> IO ()
warnOfFailure BatteryInfo -> IO ()
doWrites
  where
    doWrites :: BatteryInfo -> IO ()
doWrites info :: BatteryInfo
info =
        Priority -> String -> BatteryInfo -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
DEBUG "Writing info %s" BatteryInfo
info IO () -> IO BatteryInfo -> IO BatteryInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        MVar BatteryInfo -> BatteryInfo -> IO BatteryInfo
forall a. MVar a -> a -> IO a
swapMVar MVar BatteryInfo
var BatteryInfo
info IO BatteryInfo -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BroadcastChan In BatteryInfo -> BatteryInfo -> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan In a -> a -> m Bool
writeBChan BroadcastChan In BatteryInfo
chan BatteryInfo
info)
    warnOfFailure :: MethodError -> IO ()
warnOfFailure = Priority -> String -> MethodError -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
WARNING "Failed to update battery info %s"

registerForAnyUPowerPropertiesChanged
  :: (Signal -> String -> Map String Variant -> [String] -> IO ())
  -> ReaderT Context IO SignalHandler
registerForAnyUPowerPropertiesChanged :: (Signal -> String -> Map String Variant -> [String] -> IO ())
-> ReaderT Context IO SignalHandler
registerForAnyUPowerPropertiesChanged = [String]
-> (Signal -> String -> Map String Variant -> [String] -> IO ())
-> ReaderT Context IO SignalHandler
registerForUPowerPropertyChanges []

registerForUPowerPropertyChanges
  :: [String]
  -> (Signal -> String -> Map String Variant -> [String] -> IO ())
  -> ReaderT Context IO SignalHandler
registerForUPowerPropertyChanges :: [String]
-> (Signal -> String -> Map String Variant -> [String] -> IO ())
-> ReaderT Context IO SignalHandler
registerForUPowerPropertyChanges properties :: [String]
properties signalHandler :: Signal -> String -> Map String Variant -> [String] -> IO ()
signalHandler = do
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
systemDBusClient
  IO SignalHandler -> ReaderT Context IO SignalHandler
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO SignalHandler -> ReaderT Context IO SignalHandler)
-> IO SignalHandler -> ReaderT Context IO SignalHandler
forall a b. (a -> b) -> a -> b
$ Client
-> MatchRule
-> (Signal -> String -> Map String Variant -> [String] -> IO ())
-> IO SignalHandler
DBus.registerForPropertiesChanged
      Client
client
      MatchRule
matchAny { matchInterface :: Maybe InterfaceName
matchInterface = InterfaceName -> Maybe InterfaceName
forall a. a -> Maybe a
Just InterfaceName
uPowerDeviceInterfaceName }
      Signal -> String -> Map String Variant -> [String] -> IO ()
handleIfPropertyMatches
  where handleIfPropertyMatches :: Signal -> String -> Map String Variant -> [String] -> IO ()
handleIfPropertyMatches rawSignal :: Signal
rawSignal n :: String
n propertiesMap :: Map String Variant
propertiesMap l :: [String]
l =
          let propertyPresent :: String -> Bool
propertyPresent prop :: String
prop = Maybe Variant -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Variant -> Bool) -> Maybe Variant -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Map String Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
prop Map String Variant
propertiesMap
          in Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
propertyPresent [String]
properties Bool -> Bool -> Bool
|| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
properties) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Signal -> String -> Map String Variant -> [String] -> IO ()
signalHandler Signal
rawSignal String
n Map String Variant
propertiesMap [String]
l

-- | Monitor the DisplayDevice for changes, writing a new "BatteryInfo" object
-- to returned "MVar" and "Chan" objects
monitorDisplayBattery :: [String] -> TaffyIO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
monitorDisplayBattery :: [String]
-> ReaderT
     Context IO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
monitorDisplayBattery propertiesToMonitor :: [String]
propertiesToMonitor = do
  IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ Priority -> String -> IO ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
batteryLog Priority
DEBUG "Starting Battery Monitor"
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
systemDBusClient
  MVar BatteryInfo
infoVar <- IO (MVar BatteryInfo) -> ReaderT Context IO (MVar BatteryInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (MVar BatteryInfo) -> ReaderT Context IO (MVar BatteryInfo))
-> IO (MVar BatteryInfo) -> ReaderT Context IO (MVar BatteryInfo)
forall a b. (a -> b) -> a -> b
$ BatteryInfo -> IO (MVar BatteryInfo)
forall a. a -> IO (MVar a)
newMVar (BatteryInfo -> IO (MVar BatteryInfo))
-> BatteryInfo -> IO (MVar BatteryInfo)
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> BatteryInfo
infoMapToBatteryInfo Map Text Variant
forall k a. Map k a
M.empty
  BroadcastChan In BatteryInfo
chan <- TaffyIO (BroadcastChan In BatteryInfo)
forall (m :: * -> *) a. MonadIO m => m (BroadcastChan In a)
newBroadcastChan
  TaffyIO () -> TaffyIO ()
forall r. ReaderT r IO () -> ReaderT r IO ()
taffyFork (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ do
    Context
ctx <- ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let warnOfFailedGetDevice :: t -> m b
warnOfFailedGetDevice err :: t
err =
          Priority -> String -> t -> m ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
WARNING "Failure getting DisplayBattery: %s" t
err m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return "/org/freedesktop/UPower/devices/DisplayDevice"
    ObjectPath
displayPath <- IO ObjectPath -> ReaderT Context IO ObjectPath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ObjectPath -> ReaderT Context IO ObjectPath)
-> IO ObjectPath -> ReaderT Context IO ObjectPath
forall a b. (a -> b) -> a -> b
$ Client -> IO (Either MethodError ObjectPath)
getDisplayDevice Client
client IO (Either MethodError ObjectPath)
-> (Either MethodError ObjectPath -> IO ObjectPath)
-> IO ObjectPath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                   (MethodError -> IO ObjectPath)
-> (ObjectPath -> IO ObjectPath)
-> Either MethodError ObjectPath
-> IO ObjectPath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> IO ObjectPath
forall (m :: * -> *) t b.
(MonadIO m, Show t, IsString b) =>
t -> m b
warnOfFailedGetDevice ObjectPath -> IO ObjectPath
forall (m :: * -> *) a. Monad m => a -> m a
return
    let doUpdate :: TaffyIO ()
doUpdate = BroadcastChan In BatteryInfo
-> MVar BatteryInfo -> ObjectPath -> TaffyIO ()
updateBatteryInfo BroadcastChan In BatteryInfo
chan MVar BatteryInfo
infoVar ObjectPath
displayPath
        signalCallback :: Signal -> String -> Map String Variant -> [String] -> IO ()
signalCallback _ _ changedProps :: Map String Variant
changedProps _ =
          do
            Priority -> String -> Map String Variant -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
DEBUG "Battery changed properties: %s" Map String Variant
changedProps
            TaffyIO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TaffyIO ()
doUpdate Context
ctx
    SignalHandler
_ <- [String]
-> (Signal -> String -> Map String Variant -> [String] -> IO ())
-> ReaderT Context IO SignalHandler
registerForUPowerPropertyChanges [String]
propertiesToMonitor Signal -> String -> Map String Variant -> [String] -> IO ()
signalCallback
    TaffyIO ()
doUpdate
    () -> TaffyIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (BroadcastChan In BatteryInfo, MVar BatteryInfo)
-> ReaderT
     Context IO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (BroadcastChan In BatteryInfo
chan, MVar BatteryInfo
infoVar)

-- | Call "refreshAllBatteries" whenever the BatteryInfo for the DisplayDevice
-- is updated. This handles cases where there is a race between the signal that
-- something is updated and the update actually being visible. See
-- https://github.com/taffybar/taffybar/issues/330 for more details.
refreshBatteriesOnPropChange :: TaffyIO ()
refreshBatteriesOnPropChange :: TaffyIO ()
refreshBatteriesOnPropChange = ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT Context IO Context -> (Context -> TaffyIO ()) -> TaffyIO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ctx :: Context
ctx ->
  let updateIfRealChange :: Signal -> String -> Map String Variant -> [String] -> IO ()
updateIfRealChange _ _ changedProps :: Map String Variant
changedProps _ =
        (TaffyIO () -> Context -> IO ()) -> Context -> TaffyIO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TaffyIO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
ctx (TaffyIO () -> IO ()) -> TaffyIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Bool -> TaffyIO () -> TaffyIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (((String, Variant) -> Bool) -> [(String, Variant)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ["UpdateTime", "Voltage"]) (String -> Bool)
-> ((String, Variant) -> String) -> (String, Variant) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Variant) -> String
forall a b. (a, b) -> a
fst) ([(String, Variant)] -> Bool) -> [(String, Variant)] -> Bool
forall a b. (a -> b) -> a -> b
$
                       Map String Variant -> [(String, Variant)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Variant
changedProps) (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$
                  IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> IO ()
threadDelay 1000000) TaffyIO () -> TaffyIO () -> TaffyIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TaffyIO ()
refreshAllBatteries
  in ReaderT Context IO SignalHandler -> TaffyIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Context IO SignalHandler -> TaffyIO ())
-> ReaderT Context IO SignalHandler -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ (Signal -> String -> Map String Variant -> [String] -> IO ())
-> ReaderT Context IO SignalHandler
registerForAnyUPowerPropertiesChanged Signal -> String -> Map String Variant -> [String] -> IO ()
updateIfRealChange

-- | Request a refresh of all UPower batteries. This is only needed if UPower's
-- refresh mechanism is not working properly.
refreshAllBatteries :: TaffyIO ()
refreshAllBatteries :: TaffyIO ()
refreshAllBatteries = do
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
systemDBusClient
  let doRefresh :: ObjectPath -> IO (Either MethodError ())
doRefresh path :: ObjectPath
path =
        Priority -> String -> ObjectPath -> IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
DEBUG "Refreshing battery: %s" ObjectPath
path IO () -> IO (Either MethodError ()) -> IO (Either MethodError ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Client -> ObjectPath -> IO (Either MethodError ())
refresh Client
client ObjectPath
path
  Either MethodError [Either MethodError ()]
eerror <- ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
-> ReaderT Context IO (Either MethodError [Either MethodError ()])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
 -> ReaderT Context IO (Either MethodError [Either MethodError ()]))
-> ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
-> ReaderT Context IO (Either MethodError [Either MethodError ()])
forall a b. (a -> b) -> a -> b
$ TaffyIO (Either MethodError [ObjectPath])
-> ExceptT MethodError (ReaderT Context IO) [ObjectPath]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT TaffyIO (Either MethodError [ObjectPath])
getBatteryPaths ExceptT MethodError (ReaderT Context IO) [ObjectPath]
-> ([ObjectPath]
    -> ExceptT
         MethodError (ReaderT Context IO) [Either MethodError ()])
-> ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [Either MethodError ()]
-> ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Either MethodError ()]
 -> ExceptT
      MethodError (ReaderT Context IO) [Either MethodError ()])
-> ([ObjectPath] -> IO [Either MethodError ()])
-> [ObjectPath]
-> ExceptT MethodError (ReaderT Context IO) [Either MethodError ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectPath -> IO (Either MethodError ()))
-> [ObjectPath] -> IO [Either MethodError ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ObjectPath -> IO (Either MethodError ())
doRefresh
  let logRefreshError :: MethodError -> TaffyIO ()
logRefreshError = Priority -> String -> MethodError -> TaffyIO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
ERROR "Failed to refresh battery: %s"
      logGetPathsError :: MethodError -> TaffyIO ()
logGetPathsError = Priority -> String -> MethodError -> TaffyIO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
Priority -> String -> t -> m ()
batteryLogF Priority
ERROR "Failed to get battery paths %s"

  TaffyIO () -> TaffyIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ (MethodError -> TaffyIO ())
-> ([Either MethodError ()] -> TaffyIO ())
-> Either MethodError [Either MethodError ()]
-> TaffyIO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> TaffyIO ()
logGetPathsError ((Either MethodError () -> TaffyIO ())
-> [Either MethodError ()] -> TaffyIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Either MethodError () -> TaffyIO ())
 -> [Either MethodError ()] -> TaffyIO ())
-> (Either MethodError () -> TaffyIO ())
-> [Either MethodError ()]
-> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ (MethodError -> TaffyIO ())
-> (() -> TaffyIO ()) -> Either MethodError () -> TaffyIO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> TaffyIO ()
logRefreshError () -> TaffyIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return) Either MethodError [Either MethodError ()]
eerror