ENH (actually) make optimus-manager and emacs deps more robust

lib/XMonad/Internal/Command/DMenu.hs

@@ -143,7 +143,7 @@ runClipMenu :: SometimesX
 runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
   where
     act = spawnCmd myDmenuCmd args
-    tree = listToAnds (processExists myClipboardManager)
+    tree = listToAnds (process myClipboardManager)
       $ sysExe <$> [myDmenuCmd, myClipboardManager]
     args = [ "-modi", "\"clipboard:greenclip print\""
            , "-show", "clipboard"

lib/XMonad/Internal/Command/Desktop.hs

@@ -71,6 +71,9 @@ myBrowser = "brave-accel"
 myEditor :: String
 myEditor = "emacsclient"
 
+myEditorServer :: String
+myEditorServer = "emacs"
+
 myMultimediaCtl :: String
 myMultimediaCtl = "playerctl"
 
@@ -128,7 +131,9 @@ runEditor = sometimesIO_ "text editor" "emacs" tree cmd
   where
     cmd = spawnCmd myEditor
       ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
-    tree = Only_ $ sysExe myEditor
+    -- NOTE we could test if the emacs socket exists, but it won't come up
+    -- before xmonad starts, so just check to see if the process has started
+    tree = toAnd_ (sysExe myEditor) $ process myEditorServer
 
 runFileManager :: SometimesX
 runFileManager = sometimesExe "file browser" "pcmanfm" True "pcmanfm"

lib/XMonad/Internal/Command/Power.hs

@@ -135,14 +135,15 @@ runOptimusPrompt' fb = do
       #!&& unwords [myOptimusManager, "--switch", mode, "--no-confirm"]
       #!&& "killall xmonad"
 
--- TODO test that the socket is open (/tmp/optimus-manager)
 runOptimusPrompt :: SometimesX
 runOptimusPrompt = Sometimes "graphics switcher" [s]
   where
     s = Subfeature { sfData = r, sfName = "optimus manager", sfLevel = Error }
     r = IORoot runOptimusPrompt' t
     t = And1 (fontTreeAlt T.defFontFamily)
-      $ And_ (Only_ $ sysExe myOptimusManager) (Only_ $ sysExe myPrimeOffload)
+      $ listToAnds (socketExists "optimus-manager" socketName) $ sysExe
+      <$> [myOptimusManager, myPrimeOffload]
+    socketName = (</> "optimus-manager") <$> getTemporaryDirectory
 
 --------------------------------------------------------------------------------
 -- | Universal power prompt

lib/XMonad/Internal/Dependency.hs

@@ -68,7 +68,6 @@ module XMonad.Internal.Dependency
   , readEthernet
   , readWireless
   , socketExists
-  , processExists
 
   -- lifting
   , ioSometimes
@@ -95,9 +94,9 @@ module XMonad.Internal.Dependency
   , pathR
   , pathRW
   , pathW
-  -- , sysTest
   , voidResult
   , voidRead
+  , process
 
   -- misc
   , shellTest
@@ -352,6 +351,7 @@ data SystemDependency =
   Executable Bool FilePath
   | AccessiblePath FilePath Bool Bool
   | Systemd UnitType String
+  | Process String
   deriving (Eq, Show, Generic)
 
 instance Hashable SystemDependency
@@ -662,6 +662,8 @@ testSysDependency (Systemd t n) = shellTest cmd msg
   where
     msg = unwords ["systemd", unitType t, "unit", singleQuote n, "not found"]
     cmd = fmtCmd "systemctl" $ ["--user" | t == UserUnit] ++ ["status", n]
+testSysDependency (Process n) = shellTest (fmtCmd "pidof" [n])
+  $ "Process " ++ singleQuote n ++ " not found"
 testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
   where
     testPerm False _ _  = Nothing
@@ -788,14 +790,6 @@ socketExists' getPath = do
   where
     toErr = Just . Msg Error
 
-processExists :: String -> IODependency_
-processExists n = IOTest_ ("determine if process " ++ n ++ " is running")
-  $ processExists' n
-
-processExists' :: String -> IO (Maybe Msg)
-processExists' n = shellTest (fmtCmd "pidof" [n])
-  $ "Process " ++ singleQuote n ++ " not found"
-
 --------------------------------------------------------------------------------
 -- | DBus Dependency Testing
 
@@ -983,8 +977,8 @@ sysdUser = sysd UserUnit
 sysdSystem :: String -> IODependency_
 sysdSystem = sysd SystemUnit
 
--- sysTest :: String -> IO (Maybe String) -> IODependency_
--- sysTest n = IOSystem_ . IOTest n
+process :: String -> IODependency_
+process = IOSystem_ . Process
 
 --------------------------------------------------------------------------------
 -- | Printing
@@ -1108,6 +1102,7 @@ dataSysDependency d = first Q $
                                        ])
     (Systemd t n) -> ("systemd", [ ("unittype", JSON_Q $ Q $ unitType t)
                                  , ("unit", JSON_Q $ Q n)])
+    (Process n) -> ("process", [("name", JSON_Q $ Q n)])
 
 dataDBusDependency :: DBusDependency_ -> DependencyData
 dataDBusDependency d =