ENH use dep interface for screen lock

bin/xmonad.hs

@@ -9,6 +9,7 @@ module Main (main) where
 import           Control.Concurrent
 import           Control.Monad                                (unless)
 
+import           Data.Either                                  (fromRight)
 import           Data.List
     ( isPrefixOf
     , sortBy
@@ -81,7 +82,8 @@ main = do
         , childPIDs = [p]
         , 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
   -- IDK why this is necessary; nothing prior to this line will print if missing
   hFlush stdout
@@ -92,7 +94,7 @@ main = do
           , modMask = myModMask
           , layoutHook = myLayouts
           , manageHook = myManageHook
-          , handleEventHook = myEventHook
+          , handleEventHook = myEventHook lock
           , startupHook = myStartupHook
           , workspaces = myWorkspaces
           , logHook = myLoghook h
@@ -375,19 +377,19 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
 --------------------------------------------------------------------------------
 -- | 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
-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
     let (xtype, tag) = splitXMsg d
     case xtype of
       Workspace -> removeDynamicWorkspace tag
-      ACPI      -> handleACPI tag
+      ACPI      -> handleACPI lock tag
     return (All True)
-xMsgEventHook _ = return (All True)
+xMsgEventHook _ _ = return (All True)
 
 --------------------------------------------------------------------------------
 -- | Keymap configuration
@@ -504,9 +506,9 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
   (Left _)  -> Just $ k{ kbDesc = "[!!!]" ++  d, kbAction = skip }
   -- _                     -> Nothing
 
-externalBindings :: BrightnessControls -> SSControls -> ThreadState
+externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
   -> [KeyGroup (IO MaybeX)]
-externalBindings bc sc ts =
+externalBindings bc sc ts lock =
   [ KeyGroup "Launchers"
     [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
     , 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-M1-," "backlight min" $ return $ io <$> bctlMin 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-<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
     , KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
     , KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile

lib/XMonad/Internal/Command/Power.hs

@@ -44,8 +44,15 @@ myOptimusManager = "optimus-manager"
 --------------------------------------------------------------------------------
 -- | 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 = spawn "systemctl poweroff"
@@ -101,6 +108,12 @@ runOptimusPrompt' = do
 
 runOptimusPrompt :: IO MaybeX
 runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt'
+-- runOptimusPrompt :: Feature (X ()) (X ())
+-- runOptimusPrompt = Feature
+--   { ftrAction = runOptimusPrompt'
+--   , ftrSilent = False
+--   , ftrChildren = [exe myOptimusManager]
+--   }
 
 --------------------------------------------------------------------------------
 -- | Universal power prompt
@@ -128,8 +141,8 @@ data PowerPrompt = PowerPrompt
 instance XPrompt PowerPrompt where
     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
     comp = mkComplFunFromList []
     theme = T.promptTheme { promptKeymap = keymap }
@@ -148,6 +161,34 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
       Poweroff  -> runPowerOff
       -- TODO these dependency functions need to be assembled elsewhere and fed
       -- 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
+
+-- 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

lib/XMonad/Internal/Concurrent/ACPIEvent.hs

@@ -99,15 +99,16 @@ runPowermon = runIfInstalled [pathR acpiPath] listenACPI
 
 -- | Handle ClientMessage event containing and ACPI event (to be used in
 -- 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
   forM_ acpiTag $ \case
-    Power -> runPowerPrompt
+    Power -> runPowerPrompt lock
     Sleep -> runSuspendPrompt
     LidClose -> do
       status <- io isDischarging
       -- only run suspend if battery exists and is discharging
       forM_ status $ flip when runSuspend
-      io runScreenLock >>= whenInstalled
+      -- io runScreenLock >>= whenInstalled
+      lock