ENH make powermon its own thread

This commit is contained in:
Nathan Dwarshuis 2020-03-22 23:20:10 -04:00
parent 81a9f621da
commit 80b8a2cec6
5 changed files with 69 additions and 81 deletions

View File

@ -1,42 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
import ACPI
import SendXMsg
import Control.Monad
import Data.ByteString
import Data.ByteString.Char8 as C
import Data.Connection
import System.IO.Streams.Internal as S (read)
import System.IO.Streams.UnixSocket
splitLine :: ByteString -> [ByteString]
splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
parseLine :: ByteString -> Maybe ACPIEvent
parseLine line =
-- TODO what if we don't have a list this long (we crash)
case (line' !! 1, line' !! 2) of
("PBTN", _) -> Just Power
("PWRF", _) -> Just Power
("SLPB", _) -> Just Sleep
("SBTN", _) -> Just Sleep
("LID", "close") -> Just LidClose
_ -> Nothing
where
line' = splitLine line
sendACPIEvent :: ACPIEvent -> IO ()
sendACPIEvent = sendXMsg acpiMagic . show
main :: IO ()
main = do
-- TODO barf when the socket doesn't exist
Connection { source = s } <- connect "/var/run/acpid.socket"
forever $ readStream s
where
readStream s = do
out <- (>>= parseLine) <$> S.read s
forM_ out sendACPIEvent

View File

@ -15,6 +15,7 @@ import DBus.Screensaver
import qualified Theme as T import qualified Theme as T
import Control.Concurrent
import Control.Monad (forM, forM_, mapM_, void, when) import Control.Monad (forM, forM_, mapM_, void, when)
import Data.List (find, sortBy, sortOn) import Data.List (find, sortBy, sortOn)
@ -84,10 +85,10 @@ main :: IO ()
main = do main = do
dbClient <- startXMonadService dbClient <- startXMonadService
(barPID, h) <- spawnPipe' "xmobar" (barPID, h) <- spawnPipe' "xmobar"
pwrPID <- spawnPID "powermon" _ <- forkIO runPowermon
launch launch
$ ewmh $ ewmh
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient) $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient)
$ def { terminal = myTerm $ def { terminal = myTerm
, modMask = myModMask , modMask = myModMask
, layoutHook = myLayouts , layoutHook = myLayouts
@ -235,7 +236,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
let (magic, tag) = splitXMsg d let (magic, tag) = splitXMsg d
if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
| magic == acpiMagic -> do | magic == acpiMagic -> do
let acpiTag = readMaybe tag :: Maybe ACPIEvent let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
forM_ acpiTag $ \case forM_ acpiTag $ \case
Power -> myPowerPrompt Power -> myPowerPrompt
Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend

View File

@ -1,36 +1,72 @@
module ACPI (ACPIEvent(..), acpiMagic, isDischarging) where {-# LANGUAGE OverloadedStrings #-}
module ACPI
( ACPIEvent(..)
, acpiMagic
, isDischarging
, runPowermon
) where
import SendXMsg
import Control.Exception import Control.Exception
import Text.Read import Control.Monad
data ACPIEvent = Power | Sleep | LidClose deriving (Eq) import Data.ByteString hiding (readFile)
import Data.ByteString.Char8 as C hiding (readFile)
import Data.Connection
instance Show ACPIEvent where import System.IO.Streams.Internal as S (read)
show Power = "power" import System.IO.Streams.UnixSocket
show Sleep = "sleep"
-- show LidOpen = "olid"
show LidClose = "clid"
instance Read ACPIEvent where data ACPIEvent = Power
readPrec = do | Sleep
Ident s <- lexP | LidClose
case s of deriving (Eq)
-- TODO this isn't DRY
"power" -> return Power
"sleep" -> return Sleep
"clid" -> return LidClose
_ -> pfail
-- TODO use a data type that enforces strings of max length 5 instance Enum ACPIEvent where
acpiMagic :: String toEnum 0 = Power
acpiMagic = "%acpi" toEnum 1 = Sleep
toEnum 2 = LidClose
toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum"
fromEnum Power = 0
fromEnum Sleep = 1
fromEnum LidClose = 2
sendACPIEvent :: ACPIEvent -> IO ()
sendACPIEvent = sendXMsg acpiMagic . show . fromEnum
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
isDischarging :: IO (Maybe Bool) isDischarging :: IO (Maybe Bool)
isDischarging = do isDischarging = do
status <- try $ readFile "/sys/class/power_supply/BAT0/status" status <- try $ readFile "/sys/class/power_supply/BAT0/status"
:: IO (Either IOException String) :: IO (Either IOException String)
case status of case status of
Left e -> do Left _ -> return Nothing
print e
return Nothing
Right s -> return $ Just (s == "Discharging") Right s -> return $ Just (s == "Discharging")
-- TODO use a data type that enforces strings of max length 5
acpiMagic :: String
acpiMagic = "%acpi"
runPowermon :: IO ()
runPowermon = do
-- TODO barf when the socket doesn't exist
Connection { source = s } <- connect "/var/run/acpid.socket"
forever $ readStream s
where
readStream s = do
out <- S.read s
mapM_ sendACPIEvent $ parseLine =<< out

View File

@ -27,6 +27,9 @@ library
, dbus >= 1.2.7 , dbus >= 1.2.7
, text >= 1.2.3.1 , text >= 1.2.3.1
, containers >= 0.6.0.1 , containers >= 0.6.0.1
, tcp-streams >= 1.0.1.1
, io-streams >= 1.5.1.0
, bytestring >= 0.10.8.2
, xmobar , xmobar
ghc-options: -Wall -Werror -fno-warn-missing-signatures ghc-options: -Wall -Werror -fno-warn-missing-signatures
default-language: Haskell2010 default-language: Haskell2010
@ -64,13 +67,3 @@ executable xit-event
, my-xmonad , my-xmonad
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
executable powermon
main-is: bin/powermon.hs
build-depends: base
, tcp-streams >= 1.0.1.1
, io-streams >= 1.5.1.0
, bytestring >= 0.10.8.2
, my-xmonad
default-language: Haskell2010
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded

View File

@ -17,7 +17,7 @@
# #
# resolver: ./custom-snapshot.yaml # resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-14.12 resolver: lts-14.27
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.