ENH use dep interface for screen lock

This commit is contained in:
Nathan Dwarshuis 2021-11-19 22:42:19 -05:00
parent 543858c95e
commit 5c30d513eb
3 changed files with 67 additions and 22 deletions

View File

@ -9,6 +9,7 @@ module Main (main) where
import Control.Concurrent import Control.Concurrent
import Control.Monad (unless) import Control.Monad (unless)
import Data.Either (fromRight)
import Data.List import Data.List
( isPrefixOf ( isPrefixOf
, sortBy , sortBy
@ -81,7 +82,8 @@ main = do
, childPIDs = [p] , childPIDs = [p]
, childHandles = [h] , childHandles = [h]
} }
ext <- evalExternal $ externalBindings bc sc ts lock <- fromRight skip <$> evalFeature runScreenLock
ext <- evalExternal $ externalBindings bc sc ts lock
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
-- IDK why this is necessary; nothing prior to this line will print if missing -- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout hFlush stdout
@ -92,7 +94,7 @@ main = do
, modMask = myModMask , modMask = myModMask
, layoutHook = myLayouts , layoutHook = myLayouts
, manageHook = myManageHook , manageHook = myManageHook
, handleEventHook = myEventHook , handleEventHook = myEventHook lock
, startupHook = myStartupHook , startupHook = myStartupHook
, workspaces = myWorkspaces , workspaces = myWorkspaces
, logHook = myLoghook h , logHook = myLoghook h
@ -375,19 +377,19 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Eventhook configuration -- | Eventhook configuration
myEventHook :: Event -> X All myEventHook :: X () -> Event -> X All
myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def myEventHook lock = xMsgEventHook lock <+> docksEventHook <+> handleEventHook def
-- | React to ClientMessage events from concurrent threads -- | React to ClientMessage events from concurrent threads
xMsgEventHook :: Event -> X All xMsgEventHook :: X () -> Event -> X All
xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } xMsgEventHook lock ClientMessageEvent { ev_message_type = t, ev_data = d }
| t == bITMAP = do | t == bITMAP = do
let (xtype, tag) = splitXMsg d let (xtype, tag) = splitXMsg d
case xtype of case xtype of
Workspace -> removeDynamicWorkspace tag Workspace -> removeDynamicWorkspace tag
ACPI -> handleACPI tag ACPI -> handleACPI lock tag
return (All True) return (All True)
xMsgEventHook _ = return (All True) xMsgEventHook _ _ = return (All True)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Keymap configuration -- | Keymap configuration
@ -504,9 +506,9 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip } (Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
-- _ -> Nothing -- _ -> Nothing
externalBindings :: BrightnessControls -> SSControls -> ThreadState externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
-> [KeyGroup (IO MaybeX)] -> [KeyGroup (IO MaybeX)]
externalBindings bc sc ts = externalBindings bc sc ts lock =
[ KeyGroup "Launchers" [ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -555,9 +557,10 @@ externalBindings bc sc ts =
, KeyBinding "M-," "backlight down" $ return $ io <$> bctlDec bc , KeyBinding "M-," "backlight down" $ return $ io <$> bctlDec bc
, KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc , KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc
, KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc , KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt , KeyBinding "M-<End>" "power menu" $ noCheck $ runPowerPrompt lock
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock -- TODO this won't be aware of when the lock doesn't exist
, KeyBinding "M-<Delete>" "lock screen" $ noCheck lock
-- M-<F1> reserved for showing the keymap -- M-<F1> reserved for showing the keymap
, KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart) , KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
, KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile , KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile

View File

@ -44,8 +44,15 @@ myOptimusManager = "optimus-manager"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Core commands -- | Core commands
runScreenLock :: IO MaybeX -- runScreenLock :: IO MaybeX
runScreenLock = spawnIfInstalled myScreenlock -- runScreenLock = spawnIfInstalled myScreenlock
runScreenLock :: Feature (X ()) (X ())
runScreenLock = Feature
{ ftrAction = spawn myScreenlock
, ftrSilent = False
, ftrChildren = [exe myScreenlock]
}
runPowerOff :: X () runPowerOff :: X ()
runPowerOff = spawn "systemctl poweroff" runPowerOff = spawn "systemctl poweroff"
@ -101,6 +108,12 @@ runOptimusPrompt' = do
runOptimusPrompt :: IO MaybeX runOptimusPrompt :: IO MaybeX
runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt' runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt'
-- runOptimusPrompt :: Feature (X ()) (X ())
-- runOptimusPrompt = Feature
-- { ftrAction = runOptimusPrompt'
-- , ftrSilent = False
-- , ftrChildren = [exe myOptimusManager]
-- }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Universal power prompt -- | Universal power prompt
@ -128,8 +141,8 @@ data PowerPrompt = PowerPrompt
instance XPrompt PowerPrompt where instance XPrompt PowerPrompt where
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:" showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
runPowerPrompt :: X () runPowerPrompt :: X () -> X ()
runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeAction
where where
comp = mkComplFunFromList [] comp = mkComplFunFromList []
theme = T.promptTheme { promptKeymap = keymap } theme = T.promptTheme { promptKeymap = keymap }
@ -148,6 +161,34 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
Poweroff -> runPowerOff Poweroff -> runPowerOff
-- TODO these dependency functions need to be assembled elsewhere and fed -- TODO these dependency functions need to be assembled elsewhere and fed
-- to this function -- to this function
Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend -- Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate -- Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
Shutdown -> lock >> runSuspend
Hibernate -> lock >> runHibernate
Reboot -> runReboot Reboot -> runReboot
-- runPowerPrompt :: Feature (X ()) (X ()) -> IO (X ())
-- runPowerPrompt lock = do
-- lock' <- evalFeature lock
-- return $ mkXPrompt PowerPrompt theme comp $ executeAction $ fromRight (return ()) lock'
-- where
-- comp = mkComplFunFromList []
-- theme = T.promptTheme { promptKeymap = keymap }
-- keymap = M.fromList
-- $ ((controlMask, xK_g), quit) :
-- map (first $ (,) 0)
-- [ (xK_p, sendAction Poweroff)
-- , (xK_s, sendAction Shutdown)
-- , (xK_h, sendAction Hibernate)
-- , (xK_r, sendAction Reboot)
-- , (xK_Return, quit)
-- , (xK_Escape, quit)
-- ]
-- sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
-- executeAction l a = case toEnum $ read a of
-- Poweroff -> runPowerOff
-- -- TODO these dependency functions need to be assembled elsewhere and fed
-- -- to this function
-- Shutdown -> l >> runSuspend
-- Hibernate -> l >> runHibernate
-- Reboot -> runReboot

View File

@ -99,15 +99,16 @@ runPowermon = runIfInstalled [pathR acpiPath] listenACPI
-- | Handle ClientMessage event containing and ACPI event (to be used in -- | Handle ClientMessage event containing and ACPI event (to be used in
-- Xmonad's event hook) -- Xmonad's event hook)
handleACPI :: String -> X () handleACPI :: X () -> String -> X ()
handleACPI tag = do handleACPI lock tag = do
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
forM_ acpiTag $ \case forM_ acpiTag $ \case
Power -> runPowerPrompt Power -> runPowerPrompt lock
Sleep -> runSuspendPrompt Sleep -> runSuspendPrompt
LidClose -> do LidClose -> do
status <- io isDischarging status <- io isDischarging
-- only run suspend if battery exists and is discharging -- only run suspend if battery exists and is discharging
forM_ status $ flip when runSuspend forM_ status $ flip when runSuspend
io runScreenLock >>= whenInstalled -- io runScreenLock >>= whenInstalled
lock