ADD acpi integration
This commit is contained in:
parent
a6c4f84ed4
commit
e3d9356b36
|
@ -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
|
|
@ -9,11 +9,7 @@
|
||||||
-- differentiate this event and the tag is meant to be a signal to be
|
-- differentiate this event and the tag is meant to be a signal to be
|
||||||
-- read by xmonad.
|
-- read by xmonad.
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import SendXMsg
|
||||||
import Graphics.X11.Xlib.Atom
|
|
||||||
import Graphics.X11.Xlib.Display
|
|
||||||
import Graphics.X11.Xlib.Event
|
|
||||||
import Graphics.X11.Xlib.Extras
|
|
||||||
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
@ -22,31 +18,5 @@ main :: IO ()
|
||||||
main = getArgs >>= parse
|
main = getArgs >>= parse
|
||||||
|
|
||||||
parse :: [String] -> IO ()
|
parse :: [String] -> IO ()
|
||||||
parse [magic, tag] = send magic tag >> exitSuccess
|
parse [magic, tag] = sendXMsg magic tag >> exitSuccess
|
||||||
parse _ = exitFailure
|
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
|
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
# This file is included so that a `lib/` directory will be created.
|
|
|
@ -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")
|
|
@ -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
|
|
@ -2,23 +2,41 @@ name: my-xmonad
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable xmonad
|
||||||
main-is: ../xmonad.hs
|
main-is: ../xmonad.hs
|
||||||
other-modules:
|
build-depends: base
|
||||||
build-depends: base
|
, xmonad >= 0.13
|
||||||
, xmonad >= 0.13
|
, xmonad-contrib >= 0.13
|
||||||
, xmonad-contrib >= 0.13
|
, xmonad-extras >= 0.15.2
|
||||||
, xmonad-extras >= 0.15.2
|
, X11 >= 1.9.1
|
||||||
, X11 >= 1.9.1
|
, my-xmonad
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: bin
|
||||||
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 xit-event
|
executable xit-event
|
||||||
main-is: bin/xit-event.hs
|
main-is: bin/xit-event.hs
|
||||||
other-modules:
|
build-depends: base
|
||||||
build-depends: base
|
, X11 >= 1.9.1
|
||||||
, X11 >= 1.9.1
|
, 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
|
||||||
|
|
52
xmonad.hs
52
xmonad.hs
|
@ -1,11 +1,16 @@
|
||||||
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Monad (when, void)
|
import ACPI
|
||||||
|
import SendXMsg
|
||||||
|
|
||||||
|
import Control.Monad (forM_, void, when)
|
||||||
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import Data.Char
|
|
||||||
import Data.List (sortBy, sortOn)
|
import Data.List (sortBy, sortOn)
|
||||||
import Data.Maybe (fromMaybe, isJust)
|
import Data.Maybe (fromMaybe, isJust)
|
||||||
import Data.Monoid (All(..))
|
import Data.Monoid (All(..))
|
||||||
|
@ -14,6 +19,8 @@ import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
|
||||||
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Actions.CopyWindow
|
import XMonad.Actions.CopyWindow
|
||||||
import XMonad.Actions.CycleWS
|
import XMonad.Actions.CycleWS
|
||||||
|
@ -50,6 +57,7 @@ import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
h <- spawnPipe "xmobar"
|
h <- spawnPipe "xmobar"
|
||||||
|
-- spawn "powermon"
|
||||||
xmonad
|
xmonad
|
||||||
$ ewmh
|
$ ewmh
|
||||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys
|
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys
|
||||||
|
@ -192,16 +200,18 @@ myManageHook = composeOne
|
||||||
-- registered here, close the dynamic workspaces that are empty.
|
-- registered here, close the dynamic workspaces that are empty.
|
||||||
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (magic, tag) = splitAt 5 $ map (chr . fromInteger . toInteger) d
|
let (magic, tag) = splitXMsg d
|
||||||
io $ putStrLn magic
|
if | magic == magicString -> removeEmptyWorkspaceByTag' tag
|
||||||
when (magic == magicString) $ do
|
| magic == acpiMagic -> do
|
||||||
let tag' = filter isAlphaNum tag
|
let acpiTag = readMaybe tag :: Maybe ACPIEvent
|
||||||
removeEmptyWorkspaceByTag' tag'
|
io $ print acpiTag
|
||||||
-- let onscreen = (\w -> W.current w : W.visible w) W.workspaces windows
|
forM_ acpiTag $ \case
|
||||||
-- io $ putStrLn (show tag')
|
Power -> myPowerPrompt
|
||||||
-- -- TODO this actually won't remove an empty workspace if
|
Sleep -> confirmPrompt myPromptTheme "suspend?" runSuspend
|
||||||
-- -- there are the same number of active workspaces as screens
|
LidClose -> do
|
||||||
-- removeEmptyWorkspaceByTag tag'
|
status <- io isDischarging
|
||||||
|
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||||
|
| otherwise -> return ()
|
||||||
return (All True)
|
return (All True)
|
||||||
| otherwise = return (All True)
|
| otherwise = return (All True)
|
||||||
myEventHook _ = return (All True)
|
myEventHook _ = return (All True)
|
||||||
|
@ -272,6 +282,12 @@ data PowerPrompt = PowerPrompt
|
||||||
instance XPrompt PowerPrompt where
|
instance XPrompt PowerPrompt where
|
||||||
showXPrompt PowerPrompt = "Select Option: "
|
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
|
myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
||||||
$ fromMaybe (return ())
|
$ fromMaybe (return ())
|
||||||
. (`lookup` commands)
|
. (`lookup` commands)
|
||||||
|
@ -279,10 +295,10 @@ myPowerPrompt = mkXPrompt PowerPrompt conf comps
|
||||||
comps = mkComplFunFromList' (map fst commands)
|
comps = mkComplFunFromList' (map fst commands)
|
||||||
conf = myPromptTheme
|
conf = myPromptTheme
|
||||||
commands =
|
commands =
|
||||||
[ ("poweroff", spawn "systemctl poweroff")
|
[ ("poweroff", runPowerOff)
|
||||||
, ("suspend", spawn myScreenLock >> spawn "systemctl suspend")
|
, ("suspend", runScreenLock >> runSuspend)
|
||||||
, ("hibernate", spawn myScreenLock >> spawn "systemctl hibernate")
|
, ("hibernate", runScreenLock >> runHibernate)
|
||||||
, ("reboot", spawn "systemctl reboot")
|
, ("reboot", runReboot)
|
||||||
]
|
]
|
||||||
|
|
||||||
-- osd
|
-- osd
|
||||||
|
@ -426,8 +442,8 @@ myKeys c =
|
||||||
, ("M-,", addName "backlight down" $ spawn "adj_backlight down")
|
, ("M-,", addName "backlight down" $ spawn "adj_backlight down")
|
||||||
, ("M-M1-,", addName "backlight min" $ spawn "adj_backlight min")
|
, ("M-M1-,", addName "backlight min" $ spawn "adj_backlight min")
|
||||||
, ("M-M1-.", addName "backlight max" $ spawn "adj_backlight max")
|
, ("M-M1-.", addName "backlight max" $ spawn "adj_backlight max")
|
||||||
, ("M-<F2>", addName "restart xmonad" $ spawn "killall xmobar; xmonad --restart")
|
, ("M-<F2>", addName "restart xmonad" $ spawn "killall xmobar; killall powermon; xmonad --restart")
|
||||||
, ("M-S-<F2>", addName "recompile xmonad" $ spawn "killall xmobar; xmonad --recompile && xmonad --restart")
|
, ("M-S-<F2>", addName "recompile xmonad" $ spawn "killall xmobar; killall powermon; xmonad --recompile && xmonad --restart")
|
||||||
, ("M-<End>", addName "power menu" myPowerPrompt)
|
, ("M-<End>", addName "power menu" myPowerPrompt)
|
||||||
, ("M-<Home>", addName "quit xmonad" $
|
, ("M-<Home>", addName "quit xmonad" $
|
||||||
confirmPrompt myPromptTheme "Quit XMonad?" $ io exitSuccess)
|
confirmPrompt myPromptTheme "Quit XMonad?" $ io exitSuccess)
|
||||||
|
|
Loading…
Reference in New Issue