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,7 +15,8 @@ import DBus.Screensaver
|
|||
|
||||
import qualified Theme as T
|
||||
|
||||
import Control.Monad (forM, forM_, mapM_, void, when)
|
||||
import Control.Concurrent
|
||||
import Control.Monad (forM, forM_, mapM_, void, when)
|
||||
|
||||
import Data.List (find, sortBy, sortOn)
|
||||
import qualified Data.Map.Lazy as M
|
||||
|
@ -84,10 +85,10 @@ main :: IO ()
|
|||
main = do
|
||||
dbClient <- startXMonadService
|
||||
(barPID, h) <- spawnPipe' "xmobar"
|
||||
pwrPID <- spawnPID "powermon"
|
||||
_ <- forkIO runPowermon
|
||||
launch
|
||||
$ ewmh
|
||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient)
|
||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient)
|
||||
$ def { terminal = myTerm
|
||||
, modMask = myModMask
|
||||
, layoutHook = myLayouts
|
||||
|
@ -235,7 +236,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
|||
let (magic, tag) = splitXMsg d
|
||||
if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
|
||||
| magic == acpiMagic -> do
|
||||
let acpiTag = readMaybe tag :: Maybe ACPIEvent
|
||||
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
||||
forM_ acpiTag $ \case
|
||||
Power -> myPowerPrompt
|
||||
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 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
|
||||
show Power = "power"
|
||||
show Sleep = "sleep"
|
||||
-- show LidOpen = "olid"
|
||||
show LidClose = "clid"
|
||||
import System.IO.Streams.Internal as S (read)
|
||||
import System.IO.Streams.UnixSocket
|
||||
|
||||
instance Read ACPIEvent where
|
||||
readPrec = do
|
||||
Ident s <- lexP
|
||||
case s of
|
||||
-- TODO this isn't DRY
|
||||
"power" -> return Power
|
||||
"sleep" -> return Sleep
|
||||
"clid" -> return LidClose
|
||||
_ -> pfail
|
||||
data ACPIEvent = Power
|
||||
| Sleep
|
||||
| LidClose
|
||||
deriving (Eq)
|
||||
|
||||
-- TODO use a data type that enforces strings of max length 5
|
||||
acpiMagic :: String
|
||||
acpiMagic = "%acpi"
|
||||
instance Enum ACPIEvent where
|
||||
toEnum 0 = Power
|
||||
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 = do
|
||||
status <- try $ readFile "/sys/class/power_supply/BAT0/status"
|
||||
:: IO (Either IOException String)
|
||||
case status of
|
||||
Left e -> do
|
||||
print e
|
||||
return Nothing
|
||||
Left _ -> return Nothing
|
||||
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
|
||||
, text >= 1.2.3.1
|
||||
, containers >= 0.6.0.1
|
||||
, tcp-streams >= 1.0.1.1
|
||||
, io-streams >= 1.5.1.0
|
||||
, bytestring >= 0.10.8.2
|
||||
, xmobar
|
||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
||||
default-language: Haskell2010
|
||||
|
@ -63,14 +66,4 @@ executable xit-event
|
|||
, X11 >= 1.9.1
|
||||
, my-xmonad
|
||||
default-language: Haskell2010
|
||||
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
|
||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
|
|
@ -17,7 +17,7 @@
|
|||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver: lts-14.12
|
||||
resolver: lts-14.27
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
|
Loading…
Reference in New Issue