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
import Data.Word
import Data.Int
import DBus.Client.Simple
import Data.List ( find )
import Data.Text ( isInfixOf, Text )
newtype BatteryContext = BC Proxy
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" . objectPathText)
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 = val
where
Just val = fromVariant variant
variant = M.findWithDefault (toVariant dflt) key dict
readDictIntegral :: Map Text Variant -> Text -> Int32 -> Int
readDictIntegral dict key dflt = case variantType variant of
TypeWord8 -> fromIntegral (f variant :: Word8)
TypeWord16 -> fromIntegral (f variant :: Word16)
TypeWord32 -> fromIntegral (f variant :: Word32)
TypeWord64 -> fromIntegral (f variant :: Word64)
TypeInt16 -> fromIntegral (f variant :: Int16)
TypeInt32 -> fromIntegral (f variant :: Int32)
TypeInt64 -> fromIntegral (f variant :: Int64)
t -> error $ "readDictIntegral " ++ show key ++ ": got type " ++ show t
where
variant = M.findWithDefault (toVariant dflt) key dict
f :: IsVariant a => Variant -> a
f = fromJust . fromVariant
getBatteryInfo :: BatteryContext -> IO BatteryInfo
getBatteryInfo (BC batteryProxy) = do
let iface :: Variant
iface = toVariant ("org.freedesktop.UPower.Device" :: Text)
[val] <- call batteryProxy "org.freedesktop.DBus.Properties" "GetAll" [iface]
let dict :: Map Text Variant
Just dict = fromVariant val
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
powerProxy <- proxy systemConn powerBusName powerBaseObjectPath
[ powerDevicesV ] <- call powerProxy "org.freedesktop.UPower" "EnumerateDevices" []
let Just powerDevices = fromVariant powerDevicesV
case firstBattery powerDevices of
Nothing -> return Nothing
Just battPath ->
proxy systemConn powerBusName battPath >>= (return . Just . BC)