ENH make powermon its own thread
This commit is contained in:
parent
81a9f621da
commit
80b8a2cec6
|
@ -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
|
|
|
@ -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
|
||||||
|
|
82
lib/ACPI.hs
82
lib/ACPI.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue