xmonad-config/lib/XMonad/Internal/Concurrent/ACPIEvent.hs

{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
-- | Concurrent module to handle events from acpid

module XMonad.Internal.Concurrent.ACPIEvent
  ( runPowermon
  , runHandleACPI
  ) where

import           Data.Internal.Dependency

import           Network.Socket
import           Network.Socket.ByteString

import           RIO
import qualified RIO.ByteString                           as B

import           XMonad.Core
import           XMonad.Internal.Command.Power
import           XMonad.Internal.Concurrent.ClientMessage
import           XMonad.Internal.Shell
import           XMonad.Internal.Theme                    (FontBuilder)

--------------------------------------------------------------------------------
-- | Data structure to hold the ACPI events I care about
--
-- Enumerate so these can be converted to strings and back when sent in a
-- ClientMessage event to X

data ACPIEvent = Power
    | Sleep
    | LidClose
    deriving (Eq)

instance Enum ACPIEvent where
  toEnum 0 = Power
  toEnum 1 = Sleep
  toEnum 2 = LidClose
  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"

  fromEnum Power    = 0
  fromEnum Sleep    = 1
  fromEnum LidClose = 2

--------------------------------------------------------------------------------
-- | Internal functions

-- | Convert a string to an ACPI event (this string is assumed to come from
-- the acpid socket)
parseLine :: ByteString -> Maybe ACPIEvent
parseLine line =
  case splitLine line of
    (_:"PBTN":_)        -> Just Power
    (_:"PWRF":_)        -> Just Power
    (_:"SLPB":_)        -> Just Sleep
    (_:"SBTN":_)        -> Just Sleep
    (_:"LID":"close":_) -> Just LidClose
    _                   -> Nothing
  where
    splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse
    newline = 10
    space = 32

-- | Send an ACPIEvent to the X server as a ClientMessage
sendACPIEvent :: ACPIEvent -> IO ()
sendACPIEvent = sendXMsg ACPI . show . fromEnum

isDischarging :: IO (Maybe Bool)
isDischarging = do
  status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status"
  case status of
    Left _  -> return Nothing
    Right s -> return $ Just (s == "Discharging")

listenACPI :: IO ()
listenACPI = do
  sock <- socket AF_UNIX Stream defaultProtocol
  connect sock $ SockAddrUnix acpiPath
  forever $ do
    out <- recv sock 1024
    mapM_ sendACPIEvent $ parseLine out

acpiPath :: FilePath
acpiPath = "/var/run/acpid.socket"

socketDep :: IOTree_
socketDep = Only_ $ pathR acpiPath [Package Official "acpid"]

-- | Handle ClientMessage event containing and ACPI event (to be used in
-- Xmonad's event hook)
handleACPI :: FontBuilder -> X () -> String -> X ()
handleACPI fb lock tag = do
  let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
  forM_ acpiTag $ \case
    Power -> powerPrompt lock fb
    Sleep -> suspendPrompt fb
    LidClose -> do
      status <- io isDischarging
      -- only run suspend if battery exists and is discharging
      forM_ status $ flip when runSuspend
      lock

--------------------------------------------------------------------------------
-- | Exported API

-- | Spawn a new thread that will listen for ACPI events on the acpid socket
-- and send ClientMessage events when it receives them
runPowermon :: SometimesIO
runPowermon = sometimesIO_ "ACPI event monitor" "acpid" socketDep $ io listenACPI

runHandleACPI :: Always (String -> X ())
runHandleACPI = Always "ACPI event handler" $ Option sf fallback
  where
    sf = Subfeature withLock "acpid prompt"
    withLock = IORoot (uncurry handleACPI)
      $ And12 (,) promptFontDep $ Only
      $ IOSometimes runScreenLock id
    fallback = Always_ $ FallbackAlone $ const skip