Battery.hs

{-# LANGUAGE OverloadedStrings #-}
-- | This is a simple library to query the Linux UPower daemon (via DBus) for
-- battery information. Currently, it only retrieves information for the first
-- battery it finds.
module System.Taffybar.Information.Battery (
  -- * Types
  BatteryContext,
  BatteryInfo(..),
  BatteryState(..),
  BatteryTechnology(..),
  BatteryType(..),
  -- * Accessors
  batteryContextsNew,
  getBatteryInfo
  ) where

import Data.Map ( Map )
import qualified Data.Map as M
import Data.Maybe ( fromMaybe, maybeToList )
import Data.Word
import Data.Int
import DBus
import DBus.Client
import Data.List ( isInfixOf )
import Data.Text ( Text )
import qualified Data.Text as T
import Safe ( atMay )

-- | An opaque wrapper around some internal library state
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)

-- | There are a few fields supported by UPower that aren't exposed
-- here.. could be easily.
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
  }
{-
  , batteryUpdateTime :: Time
  , batteryRecallNotice :: Bool
  , batteryRecallVendor :: Text
  , batteryRecallUr :: Text
-}

-- | determine if a power source is a battery. The simple heuristic is a
-- substring search on 'BAT'.
isBattery :: ObjectPath -> Bool
isBattery = isInfixOf "BAT" . formatObjectPath

-- | Find the power sources that are batteries (according to
-- 'isBattery')
batteries :: [ObjectPath] -> [ObjectPath]
batteries = filter isBattery

-- | The name of the power daemon bus
powerBusName :: BusName
powerBusName = "org.freedesktop.UPower"

-- | The base object path
powerBaseObjectPath :: ObjectPath
powerBaseObjectPath = "/org/freedesktop/UPower"

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

-- | Read the variant contents of a dict which is of an unknown integral type.
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

-- | 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 :: BatteryContext -> IO (Maybe BatteryInfo)
getBatteryInfo (BC systemConn battPath)
  -- Grab all of the properties of the battery each call with one
  -- message.
 = 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
      }

-- | Construct a battery context for every battery in the system. This
-- could fail if the UPower daemon is not running. The contexts can be
-- used to get actual battery state with 'getBatteryInfo'.
batteryContextsNew :: IO [BatteryContext]
batteryContextsNew = do
  systemConn <- connectSystem
  let mc = methodCall powerBaseObjectPath "org.freedesktop.UPower" "EnumerateDevices"
  reply <- call_ systemConn mc { methodCallDestination = Just powerBusName }
  return $ do
    body <- take 1 $ methodReturnBody reply
    powerDevices <- maybeToList $ fromVariant body
    battPath <- batteries powerDevices
    return $ BC systemConn battPath