Safe Haskell | None |
---|---|
Language | Haskell2010 |
This is a simple library to query the Linux UPower daemon (via DBus) for battery information.
Synopsis
- data BatteryInfo = BatteryInfo {
- batteryNativePath :: String
- batteryVendor :: String
- batteryModel :: String
- batterySerial :: String
- batteryUpdateTime :: Word64
- batteryType :: BatteryType
- batteryPowerSupply :: Bool
- batteryHasHistory :: Bool
- batteryHasStatistics :: Bool
- batteryOnline :: Bool
- batteryEnergy :: Double
- batteryEnergyEmpty :: Double
- batteryEnergyFull :: Double
- batteryEnergyFullDesign :: Double
- batteryEnergyRate :: Double
- batteryVoltage :: Double
- batteryLuminosity :: Double
- batteryTimeToEmpty :: Int64
- batteryTimeToFull :: Int64
- batteryPercentage :: Double
- batteryTemperature :: Double
- batteryIsPresent :: Bool
- batteryState :: BatteryState
- batteryIsRechargeable :: Bool
- batteryCapacity :: Double
- batteryTechnology :: BatteryTechnology
- batteryWarningLevel :: Word32
- batteryBatteryLevel :: Word32
- batteryIconName :: String
- data BatteryState
- data BatteryTechnology
- data BatteryType
- newtype DisplayBatteryChanVar = DisplayBatteryChanVar (BroadcastChan In BatteryInfo, MVar BatteryInfo)
- batteryLogPath :: String
- batteryLog :: MonadIO m => Priority -> String -> m ()
- batteryLogF :: (MonadIO m, Show t) => Priority -> String -> t -> m ()
- batteryPrefix :: String
- isBattery :: ObjectPath -> Bool
- readDict :: IsVariant a => Map Text Variant -> Text -> a -> a
- readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int
- dummyMethodError :: MethodError
- getBatteryInfo :: ObjectPath -> TaffyIO (Either MethodError BatteryInfo)
- infoMapToBatteryInfo :: Map Text Variant -> BatteryInfo
- getBatteryPaths :: TaffyIO (Either MethodError [ObjectPath])
- getDisplayBatteryInfo :: TaffyIO BatteryInfo
- defaultMonitorDisplayBatteryProperties :: [String]
- setupDisplayBatteryChanVar :: [String] -> TaffyIO DisplayBatteryChanVar
- getDisplayBatteryChanVar :: TaffyIO DisplayBatteryChanVar
- getDisplayBatteryChan :: TaffyIO (BroadcastChan In BatteryInfo)
- updateBatteryInfo :: BroadcastChan In BatteryInfo -> MVar BatteryInfo -> ObjectPath -> TaffyIO ()
- registerForAnyUPowerPropertiesChanged :: (Signal -> String -> Map String Variant -> [String] -> IO ()) -> ReaderT Context IO SignalHandler
- registerForUPowerPropertyChanges :: [String] -> (Signal -> String -> Map String Variant -> [String] -> IO ()) -> ReaderT Context IO SignalHandler
- monitorDisplayBattery :: [String] -> TaffyIO (BroadcastChan In BatteryInfo, MVar BatteryInfo)
- refreshBatteriesOnPropChange :: TaffyIO ()
- refreshAllBatteries :: TaffyIO ()
Types
data BatteryInfo Source #
Instances
Eq BatteryInfo Source # | |
Defined in System.Taffybar.DBus.Client.UPowerDevice (==) :: BatteryInfo -> BatteryInfo -> Bool # (/=) :: BatteryInfo -> BatteryInfo -> Bool # | |
Show BatteryInfo Source # | |
Defined in System.Taffybar.DBus.Client.UPowerDevice showsPrec :: Int -> BatteryInfo -> ShowS # show :: BatteryInfo -> String # showList :: [BatteryInfo] -> ShowS # |
data BatteryState Source #
BatteryStateUnknown | |
BatteryStateCharging | |
BatteryStateDischarging | |
BatteryStateEmpty | |
BatteryStateFullyCharged | |
BatteryStatePendingCharge | |
BatteryStatePendingDischarge |
Instances
data BatteryTechnology Source #
Instances
data BatteryType Source #
BatteryTypeUnknown | |
BatteryTypeLinePower | |
BatteryTypeBatteryType | |
BatteryTypeUps | |
BatteryTypeMonitor | |
BatteryTypeMouse | |
BatteryTypeKeyboard | |
BatteryTypePda | |
BatteryTypePhone |
Instances
newtype DisplayBatteryChanVar Source #
batteryPrefix :: String Source #
The prefix of name of battery devices path. UPower generates the object path as "battery" + "_" + basename of the sysfs object.
isBattery :: ObjectPath -> Bool Source #
Determine if a power source is a battery.
readDict :: IsVariant a => Map Text Variant -> Text -> a -> a Source #
A helper to read the variant contents of a dict with a default value.
readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int Source #
Read the variant contents of a dict which is of an unknown integral type.
getBatteryInfo :: ObjectPath -> TaffyIO (Either MethodError BatteryInfo) Source #
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.
setupDisplayBatteryChanVar :: [String] -> TaffyIO DisplayBatteryChanVar Source #
Start the monitoring of the display battery, and setup the associated channel and mvar for the current state.
updateBatteryInfo :: BroadcastChan In BatteryInfo -> MVar BatteryInfo -> ObjectPath -> TaffyIO () Source #
registerForAnyUPowerPropertiesChanged :: (Signal -> String -> Map String Variant -> [String] -> IO ()) -> ReaderT Context IO SignalHandler Source #
registerForUPowerPropertyChanges :: [String] -> (Signal -> String -> Map String Variant -> [String] -> IO ()) -> ReaderT Context IO SignalHandler Source #
monitorDisplayBattery :: [String] -> TaffyIO (BroadcastChan In BatteryInfo, MVar BatteryInfo) Source #
Monitor the DisplayDevice for changes, writing a new BatteryInfo object to returned MVar and Chan objects
refreshBatteriesOnPropChange :: TaffyIO () Source #
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.
refreshAllBatteries :: TaffyIO () Source #
Request a refresh of all UPower batteries. This is only needed if UPower's refresh mechanism is not working properly.