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

126 lines
4.0 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- | Concurrent module to handle events from acpid
module XMonad.Internal.Concurrent.ACPIEvent
( runPowermon
, runHandleACPI
) where
import Control.Exception
import Control.Monad
import Data.ByteString hiding (readFile)
import Data.ByteString.Char8 as C hiding (readFile)
import Data.Connection
import Data.Internal.Dependency
import Text.Read (readMaybe)
import System.IO.Streams as S (read)
import System.IO.Streams.UnixSocket
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 = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
-- | 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 <- try $ readFile "/sys/class/power_supply/BAT0/status"
:: IO (Either IOException String)
case status of
Left _ -> return Nothing
Right s -> return $ Just (s == "Discharging")
listenACPI :: IO ()
listenACPI = do
Connection { source = s } <- connect acpiPath
forever $ readStream s
where
readStream s = do
out <- S.read s
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 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