ENH check for xset before running screensaver

bin/xmobar.hs

@@ -161,4 +161,4 @@ config confDir = defaultConfig
   }
 
 main :: IO ()
-main = xmobar =<< config <$> getXMonadDir
+main = xmobar . config =<< getXMonadDir

bin/xmonad.hs

@@ -46,6 +46,7 @@ import           XMonad.Internal.Concurrent.DynamicWorkspaces
 import           XMonad.Internal.Concurrent.Removable
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.IntelBacklight
+import           XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                        as T
@@ -65,7 +66,7 @@ import           XMonad.Util.WorkspaceCompare
 
 main :: IO ()
 main = do
-  (cl, bc) <- startXMonadService
+  (cl, bc, sc) <- startXMonadService
   (h, p) <- spawnPipe "xmobar"
   _ <- forkIO runPowermon
   _ <- forkIO runRemovableMon
@@ -75,7 +76,7 @@ main = do
         , childPIDs = [p]
         , childHandles = [h]
         }
-  (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc ts
+  (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc sc ts
   mapM_ warnMissing missing
   -- IDK why this is necessary; nothing prior to this line will print if missing
   hFlush stdout
@@ -482,8 +483,11 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
       Ignore         -> (Nothing, [])
     flagMissing s = "[!!!]" ++ s
 
-externalBindings :: Maybe BacklightControls -> ThreadState -> [KeyGroup (IO MaybeX)]
-externalBindings bc ts =
+externalBindings :: Maybe BacklightControls
+  -> MaybeExe SSControls
+  -> ThreadState
+  -> [KeyGroup (IO MaybeX)]
+externalBindings bc sc ts =
   [ KeyGroup "Launchers"
     [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
     , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@@ -536,7 +540,7 @@ externalBindings bc ts =
     , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
     , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
-    , KeyBinding "M-<F11>" "toggle screensaver" $ noCheck runToggleDPMS
+    , KeyBinding "M-<F11>" "toggle screensaver" $ return $ fmap (io . ssToggle) sc
     , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
     ]
   ]

lib/XMonad/Internal/DBus/Control.hs

@@ -13,8 +13,9 @@ import           DBus.Client
 
 import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
+import           XMonad.Internal.Shell
 
-startXMonadService :: IO (Client, Maybe BacklightControls)
+startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
 startXMonadService = do
   client <- connectSession
   requestResult <- requestName client "org.xmonad" []
@@ -22,12 +23,12 @@ startXMonadService = do
   -- different
   if requestResult /= NamePrimaryOwner then do
     putStrLn "Another service owns \"org.xmonad\""
-    return (client, Nothing)
+    return (client, Nothing, Ignore)
   else do
     putStrLn "Started xmonad dbus client"
     bc <- exportIntelBacklight client
-    exportScreensaver client
-    return (client, bc)
+    sc <- exportScreensaver client
+    return (client, bc, sc)
 
 stopXMonadService :: Client -> IO ()
 stopXMonadService client = do

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -8,6 +8,7 @@ module XMonad.Internal.DBus.Screensaver
   , callToggle
   , callQuery
   , matchSignal
+  , SSControls(..)
   ) where
 
 import           Control.Monad               (void)
@@ -20,6 +21,7 @@ import           Graphics.X11.Xlib.Display
 
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Process
+import           XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
 -- | Low-level functions
@@ -89,8 +91,18 @@ bodyGetCurrentState _   = Nothing
 --------------------------------------------------------------------------------
 -- | Exported haskell API
 
-exportScreensaver :: Client -> IO ()
-exportScreensaver client =
+newtype SSControls = SSControls { ssToggle :: IO () }
+
+exportScreensaver :: Client -> IO (MaybeExe SSControls)
+exportScreensaver client = do
+  d <- depInstalled dep
+  if d then flip Installed [] <$> exportScreensaver' client
+    else return $ Missing [dep]
+  where
+    dep = exe "xset"
+
+exportScreensaver' :: Client -> IO SSControls
+exportScreensaver' client = do
   export client path defaultInterface
     { interfaceName = interface
     , interfaceMethods =
@@ -98,6 +110,7 @@ exportScreensaver client =
       , autoMethod memQuery query
       ]
     }
+  return $ SSControls { ssToggle = callToggle }
 
 callToggle :: IO ()
 callToggle = void $ callMethod $ methodCall path interface memToggle

lib/XMonad/Internal/Shell.hs

@@ -6,11 +6,11 @@ module XMonad.Internal.Shell
   , UnitType(..)
   , Dependency(..)
   , MaybeX
-  , IOMaybeX
   , exe
   , systemUnit
   , userUnit
   , runIfInstalled
+  , depInstalled
   , warnMissing
   , whenInstalled
   , ifInstalled
@@ -74,11 +74,14 @@ systemUnit = unit SystemUnit
 userUnit :: String -> Dependency
 userUnit = unit UserUnit
 
-data MaybeExe m = Installed (m ()) [Dependency] | Missing [Dependency] | Ignore
+data MaybeExe a = Installed a [Dependency] | Missing [Dependency] | Ignore
 
-type MaybeX = MaybeExe X
+instance Functor MaybeExe where
+  fmap f (Installed x ds) = Installed (f x) ds
+  fmap _ (Missing x)      = Missing x
+  fmap _ Ignore           = Ignore
 
-type IOMaybeX = IO MaybeX
+type MaybeX = MaybeExe (X ())
 
 warnMissing :: Dependency -> IO ()
 warnMissing Dependency {depRequired = r, depName = n, depType = t } =
@@ -110,30 +113,30 @@ depInstalled Dependency { depName = n, depType = t } =
 filterMissing :: [Dependency] -> IO [Dependency]
 filterMissing = filterM (fmap not . depInstalled)
 
-runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe m)
+runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe (m ()))
 runIfInstalled ds x = do
   missing <- filterMissing ds
   return $ if not $ any depRequired missing
     then Installed x $ filter (not . depRequired) missing
     else Missing missing
 
-spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
+spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
 spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
 
-spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
+spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
 spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
 
-whenInstalled :: Monad m => MaybeExe m -> m ()
+whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
 whenInstalled = flip ifInstalled skip
 
-ifInstalled ::  Monad m => MaybeExe m -> m () -> m ()
+ifInstalled ::  MaybeExe a -> a -> a
 ifInstalled (Installed x _) _ = x
 ifInstalled _ alt             = alt
 
 skip :: Monad m => m ()
 skip = return ()
 
-noCheck :: Monad m => a () -> m (MaybeExe a)
+noCheck :: Monad m => a () -> m (MaybeExe (a ()))
 noCheck = return . flip Installed []
 
 --------------------------------------------------------------------------------
@@ -148,7 +151,7 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
 soundDir :: FilePath
 soundDir = "sound"
 
-spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
+spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
 spawnSound file pre post = runIfInstalled [exe "paplay"]
   $ pre >> playSound file >> post