module System.Information.Battery (
BatteryContext,
BatteryInfo(..),
BatteryState(..),
BatteryTechnology(..),
BatteryType(..),
batteryContextNew,
getBatteryInfo
) where
import Data.Map ( Map )
import qualified Data.Map as M
import Data.Maybe ( fromMaybe )
import Data.Word
import Data.Int
import DBus
import DBus.Client
import Data.List ( find, isInfixOf )
import Data.Text ( Text )
import qualified Data.Text as T
import Safe ( atMay )
data BatteryContext = BC Client ObjectPath
data BatteryType = BatteryTypeUnknown
| BatteryTypeLinePower
| BatteryTypeBatteryType
| BatteryTypeUps
| BatteryTypeMonitor
| BatteryTypeMouse
| BatteryTypeKeyboard
| BatteryTypePda
| BatteryTypePhone
deriving (Show, Ord, Eq, Enum)
data BatteryState = BatteryStateUnknown
| BatteryStateCharging
| BatteryStateDischarging
| BatteryStateEmpty
| BatteryStateFullyCharged
| BatteryStatePendingCharge
| BatteryStatePendingDischarge
deriving (Show, Ord, Eq, Enum)
data BatteryTechnology = BatteryTechnologyUnknown
| BatteryTechnologyLithiumIon
| BatteryTechnologyLithiumPolymer
| BatteryTechnologyLithiumIronPhosphate
| BatteryTechnologyLeadAcid
| BatteryTechnologyNickelCadmium
| BatteryTechnologyNickelMetalHydride
deriving (Show, Ord, Eq, Enum)
data BatteryInfo = BatteryInfo { batteryNativePath :: Text
, batteryVendor :: Text
, batteryModel :: Text
, batterySerial :: Text
, batteryType :: BatteryType
, batteryPowerSupply :: Bool
, batteryHasHistory :: Bool
, batteryHasStatistics :: Bool
, batteryOnline :: Bool
, batteryEnergy :: Double
, batteryEnergyEmpty :: Double
, batteryEnergyFull :: Double
, batteryEnergyFullDesign :: Double
, batteryEnergyRate :: Double
, batteryVoltage :: Double
, batteryTimeToEmpty :: Int64
, batteryTimeToFull :: Int64
, batteryPercentage :: Double
, batteryIsPresent :: Bool
, batteryState :: BatteryState
, batteryIsRechargable :: Bool
, batteryCapacity :: Double
, batteryTechnology :: BatteryTechnology
}
firstBattery :: [ObjectPath] -> Maybe ObjectPath
firstBattery = find (isInfixOf "BAT" . formatObjectPath)
powerBusName :: BusName
powerBusName = "org.freedesktop.UPower"
powerBaseObjectPath :: ObjectPath
powerBaseObjectPath = "/org/freedesktop/UPower"
readDict :: (IsVariant a) => Map Text Variant -> Text -> a -> a
readDict dict key dflt = fromMaybe dflt $ do
variant <- M.lookup key dict
fromVariant variant
readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int
readDictIntegral dict key dflt = fromMaybe (fromIntegral dflt) $ do
v <- M.lookup key dict
case variantType v of
TypeWord8 -> return $ fromIntegral (f v :: Word8)
TypeWord16 -> return $ fromIntegral (f v :: Word16)
TypeWord32 -> return $ fromIntegral (f v :: Word32)
TypeWord64 -> return $ fromIntegral (f v :: Word64)
TypeInt16 -> return $ fromIntegral (f v :: Int16)
TypeInt32 -> return $ fromIntegral (f v :: Int32)
TypeInt64 -> return $ fromIntegral (f v :: Int64)
_ -> Nothing
where
f :: (Num a, IsVariant a) => Variant -> a
f = fromMaybe (fromIntegral dflt) . fromVariant
getBatteryInfo :: BatteryContext -> IO (Maybe BatteryInfo)
getBatteryInfo (BC systemConn battPath) = do
reply <- call_ systemConn (methodCall battPath "org.freedesktop.DBus.Properties" "GetAll")
{ methodCallDestination = Just "org.freedesktop.UPower"
, methodCallBody = [toVariant $ T.pack "org.freedesktop.UPower.Device"]
}
return $ do
body <- methodReturnBody reply `atMay` 0
dict <- fromVariant body
return BatteryInfo { batteryNativePath = readDict dict "NativePath" ""
, batteryVendor = readDict dict "Vendor" ""
, batteryModel = readDict dict "Model" ""
, batterySerial = readDict dict "Serial" ""
, batteryType = toEnum $ fromIntegral $ readDictIntegral dict "Type" 0
, batteryPowerSupply = readDict dict "PowerSupply" False
, batteryHasHistory = readDict dict "HasHistory" False
, batteryHasStatistics = readDict dict "HasStatistics" False
, batteryOnline = readDict dict "Online" False
, batteryEnergy = readDict dict "Energy" 0.0
, batteryEnergyEmpty = readDict dict "EnergyEmpty" 0.0
, batteryEnergyFull = readDict dict "EnergyFull" 0.0
, batteryEnergyFullDesign = readDict dict "EnergyFullDesign" 0.0
, batteryEnergyRate = readDict dict "EnergyRate" 0.0
, batteryVoltage = readDict dict "Voltage" 0.0
, batteryTimeToEmpty = readDict dict "TimeToEmpty" 0
, batteryTimeToFull = readDict dict "TimeToFull" 0
, batteryPercentage = readDict dict "Percentage" 0.0
, batteryIsPresent = readDict dict "IsPresent" False
, batteryState = toEnum $ readDictIntegral dict "State" 0
, batteryIsRechargable = readDict dict "IsRechargable" True
, batteryCapacity = readDict dict "Capacity" 0.0
, batteryTechnology =
toEnum $ fromIntegral $ readDictIntegral dict "Technology" 0
}
batteryContextNew :: IO (Maybe BatteryContext)
batteryContextNew = do
systemConn <- connectSystem
reply <- call_ systemConn (methodCall powerBaseObjectPath "org.freedesktop.UPower" "EnumerateDevices")
{ methodCallDestination = Just powerBusName
}
return $ do
body <- methodReturnBody reply `atMay` 0
powerDevices <- fromVariant body
battPath <- firstBattery powerDevices
return $ BC systemConn battPath