From e3d9356b367148cbd72b06532bd679732b2d96eb Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Fri, 13 Mar 2020 20:50:13 -0400 Subject: [PATCH] ADD acpi integration --- bin/powermon.hs | 42 ++++++++++++++++++++++++++++++++++++++ bin/xit-event.hs | 34 ++----------------------------- lib/.gitignore | 1 - lib/ACPI.hs | 36 +++++++++++++++++++++++++++++++++ lib/SendXMsg.hs | 40 +++++++++++++++++++++++++++++++++++++ my-xmonad.cabal | 50 +++++++++++++++++++++++++++++++--------------- xmonad.hs | 52 +++++++++++++++++++++++++++++++----------------- 7 files changed, 188 insertions(+), 67 deletions(-) create mode 100644 bin/powermon.hs delete mode 100644 lib/.gitignore create mode 100644 lib/ACPI.hs create mode 100644 lib/SendXMsg.hs diff --git a/bin/powermon.hs b/bin/powermon.hs new file mode 100644 index 0000000..870aad5 --- /dev/null +++ b/bin/powermon.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +import SendXMsg +import ACPI + +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 diff --git a/bin/xit-event.hs b/bin/xit-event.hs index d8eb24a..76cfc84 100644 --- a/bin/xit-event.hs +++ b/bin/xit-event.hs @@ -9,11 +9,7 @@ -- differentiate this event and the tag is meant to be a signal to be -- read by xmonad. -import Graphics.X11.Types -import Graphics.X11.Xlib.Atom -import Graphics.X11.Xlib.Display -import Graphics.X11.Xlib.Event -import Graphics.X11.Xlib.Extras +import SendXMsg import System.Environment import System.Exit @@ -22,31 +18,5 @@ main :: IO () main = getArgs >>= parse parse :: [String] -> IO () -parse [magic, tag] = send magic tag >> exitSuccess +parse [magic, tag] = sendXMsg magic tag >> exitSuccess parse _ = exitFailure - -send :: String -> String -> IO () -send magic tag = do - dpy <- openDisplay "" - root <- rootWindow dpy $ defaultScreen dpy - allocaXEvent $ \e -> do - setEventType e clientMessage - -- NOTE: This function is written such that the penultimate - -- argument represents the first 40 bits of the 160 bit data - -- field, and it also only takes a decimal digit, which means the - -- string to be stored in the data field needs to be converted to - -- its decimal equivalent. The penultimate argument will be used - -- for the magic string and the last will be used for the tag. - setClientMessageEvent e root bITMAP 8 m t - sendEvent dpy root False substructureNotifyMask e - flush dpy - where - m = str2digit magic - t = str2digit tag - -str2digit :: (Num a) => String -> a -str2digit = fromIntegral - . sum - . map (\(p, n) -> n * 256 ^ p) - . zip [0 :: Int ..] - . map fromEnum diff --git a/lib/.gitignore b/lib/.gitignore deleted file mode 100644 index 04a4a5b..0000000 --- a/lib/.gitignore +++ /dev/null @@ -1 +0,0 @@ -# This file is included so that a `lib/` directory will be created. diff --git a/lib/ACPI.hs b/lib/ACPI.hs new file mode 100644 index 0000000..b4fa370 --- /dev/null +++ b/lib/ACPI.hs @@ -0,0 +1,36 @@ +module ACPI (ACPIEvent(..), acpiMagic, isDischarging) where + +import Control.Exception +import Text.Read + +data ACPIEvent = Power | Sleep | LidClose deriving (Eq) + +instance Show ACPIEvent where + show Power = "power" + show Sleep = "sleep" + -- show LidOpen = "olid" + show LidClose = "clid" + +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 + +-- TODO use a data type that enforces strings of max length 5 +acpiMagic :: String +acpiMagic = "%acpi" + +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 + Right s -> return $ Just (s == "Discharging") diff --git a/lib/SendXMsg.hs b/lib/SendXMsg.hs new file mode 100644 index 0000000..8ba24e2 --- /dev/null +++ b/lib/SendXMsg.hs @@ -0,0 +1,40 @@ +module SendXMsg (sendXMsg, splitXMsg) where + +import Data.Char + +import Graphics.X11.Types +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Display +import Graphics.X11.Xlib.Event +import Graphics.X11.Xlib.Extras + +sendXMsg :: String -> String -> IO () +sendXMsg magic tag = do + dpy <- openDisplay "" + root <- rootWindow dpy $ defaultScreen dpy + allocaXEvent $ \e -> do + setEventType e clientMessage + -- NOTE: This function is written such that the penultimate + -- argument represents the first 40 bits of the 160 bit data + -- field, and it also only takes a decimal digit, which means the + -- string to be stored in the data field needs to be converted to + -- its decimal equivalent. The penultimate argument will be used + -- for the magic string and the last will be used for the tag. + setClientMessageEvent e root bITMAP 8 m t + sendEvent dpy root False substructureNotifyMask e + flush dpy + where + m = str2digit magic + t = str2digit tag + +splitXMsg :: (Integral a) => [a] -> (String, String) +splitXMsg s = (magic, filter isAlphaNum tag) + where + (magic, tag) = splitAt 5 $ map (chr . fromInteger . toInteger) s + +str2digit :: (Num a) => String -> a +str2digit = fromIntegral + . sum + . map (\(p, n) -> n * 256 ^ p) + . zip [0 :: Int ..] + . map fromEnum diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 0d19482..ad83cce 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -2,23 +2,41 @@ name: my-xmonad version: 0.1.0.0 build-type: Simple cabal-version: >=1.10 + +library + hs-source-dirs: lib + exposed-modules: SendXMsg + , ACPI + build-depends: base + , X11 >= 1.9.1 + ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded executable xmonad - main-is: ../xmonad.hs - other-modules: - build-depends: base - , xmonad >= 0.13 - , xmonad-contrib >= 0.13 - , xmonad-extras >= 0.15.2 - , X11 >= 1.9.1 - hs-source-dirs: lib - default-language: Haskell2010 - ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded + main-is: ../xmonad.hs + build-depends: base + , xmonad >= 0.13 + , xmonad-contrib >= 0.13 + , xmonad-extras >= 0.15.2 + , X11 >= 1.9.1 + , my-xmonad + hs-source-dirs: bin + default-language: Haskell2010 + ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded executable xit-event - main-is: bin/xit-event.hs - other-modules: - build-depends: base - , X11 >= 1.9.1 - default-language: Haskell2010 - ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded + main-is: bin/xit-event.hs + build-depends: base + , 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 diff --git a/xmonad.hs b/xmonad.hs index a74f5e6..c56cea7 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} + module Main (main) where -import Control.Monad (when, void) +import ACPI +import SendXMsg + +import Control.Monad (forM_, void, when) import System.Exit import System.IO -import Data.Char import Data.List (sortBy, sortOn) import Data.Maybe (fromMaybe, isJust) import Data.Monoid (All(..)) @@ -14,6 +19,8 @@ import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Extras import Graphics.X11.Types +import Text.Read (readMaybe) + import XMonad import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS @@ -50,6 +57,7 @@ import qualified XMonad.StackSet as W main = do h <- spawnPipe "xmobar" + -- spawn "powermon" xmonad $ ewmh $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys @@ -192,16 +200,18 @@ myManageHook = composeOne -- registered here, close the dynamic workspaces that are empty. myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } | t == bITMAP = do - let (magic, tag) = splitAt 5 $ map (chr . fromInteger . toInteger) d - io $ putStrLn magic - when (magic == magicString) $ do - let tag' = filter isAlphaNum tag - removeEmptyWorkspaceByTag' tag' - -- let onscreen = (\w -> W.current w : W.visible w) W.workspaces windows - -- io $ putStrLn (show tag') - -- -- TODO this actually won't remove an empty workspace if - -- -- there are the same number of active workspaces as screens - -- removeEmptyWorkspaceByTag tag' + let (magic, tag) = splitXMsg d + if | magic == magicString -> removeEmptyWorkspaceByTag' tag + | magic == acpiMagic -> do + let acpiTag = readMaybe tag :: Maybe ACPIEvent + io $ print acpiTag + forM_ acpiTag $ \case + Power -> myPowerPrompt + Sleep -> confirmPrompt myPromptTheme "suspend?" runSuspend + LidClose -> do + status <- io isDischarging + forM_ status $ \s -> runScreenLock >> when s runSuspend + | otherwise -> return () return (All True) | otherwise = return (All True) myEventHook _ = return (All True) @@ -272,6 +282,12 @@ data PowerPrompt = PowerPrompt instance XPrompt PowerPrompt where showXPrompt PowerPrompt = "Select Option: " +runScreenLock = spawn myScreenLock +runPowerOff = spawn "systemctl poweroff" +runSuspend = spawn "systemctl suspend" +runHibernate = spawn "systemctl hibernate" +runReboot = spawn "systemctl reboot" + myPowerPrompt = mkXPrompt PowerPrompt conf comps $ fromMaybe (return ()) . (`lookup` commands) @@ -279,10 +295,10 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps comps = mkComplFunFromList' (map fst commands) conf = myPromptTheme commands = - [ ("poweroff", spawn "systemctl poweroff") - , ("suspend", spawn myScreenLock >> spawn "systemctl suspend") - , ("hibernate", spawn myScreenLock >> spawn "systemctl hibernate") - , ("reboot", spawn "systemctl reboot") + [ ("poweroff", runPowerOff) + , ("suspend", runScreenLock >> runSuspend) + , ("hibernate", runScreenLock >> runHibernate) + , ("reboot", runReboot) ] -- osd @@ -426,8 +442,8 @@ myKeys c = , ("M-,", addName "backlight down" $ spawn "adj_backlight down") , ("M-M1-,", addName "backlight min" $ spawn "adj_backlight min") , ("M-M1-.", addName "backlight max" $ spawn "adj_backlight max") - , ("M-", addName "restart xmonad" $ spawn "killall xmobar; xmonad --restart") - , ("M-S-", addName "recompile xmonad" $ spawn "killall xmobar; xmonad --recompile && xmonad --restart") + , ("M-", addName "restart xmonad" $ spawn "killall xmobar; killall powermon; xmonad --restart") + , ("M-S-", addName "recompile xmonad" $ spawn "killall xmobar; killall powermon; xmonad --recompile && xmonad --restart") , ("M-", addName "power menu" myPowerPrompt) , ("M-", addName "quit xmonad" $ confirmPrompt myPromptTheme "Quit XMonad?" $ io exitSuccess)