{-# LANGUAGE OverloadedStrings #-}
module System.Taffybar.Information.Battery
(
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
batteryPrefix :: String
batteryPrefix :: String
batteryPrefix = ObjectPath -> String
formatObjectPath ObjectPath
uPowerBaseObjectPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/devices/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
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
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
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"
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" ]
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
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)
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
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