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

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

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

import Data.Internal.XIO
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)

fromACPIEvent :: ACPIEvent -> Int
fromACPIEvent x = case x of
  Power -> 0
  Sleep -> 1
  LidClose -> 2

toACPIEvent :: Int -> Maybe ACPIEvent
toACPIEvent x = case x of
  0 -> Just Power
  1 -> Just Sleep
  2 -> Just LidClose
  _ -> Nothing

--------------------------------------------------------------------------------
-- 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 . fromACPIEvent

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 = toACPIEvent =<< 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 $ liftIO 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