ENH warn user if systemd units are missing

bin/xmonad.hs

@@ -480,7 +480,7 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
     go k@KeyGroup { kgBindings = bs } = let bs' = go' <$> bs in
       (k { kgBindings = mapMaybe fst bs' }, concatMap snd bs')
     go' k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
-      Installed x ds -> (Just $ k{ kbAction = x }, fmap Optional ds)
+      Installed x ds -> (Just $ k{ kbAction = x }, ds)
       Missing ds     -> (Just $ k{ kbDesc = flagMissing d, kbAction = skip }, ds)
       Ignore         -> (Nothing, [])
     flagMissing s = "[!!!]" ++ s
@@ -534,8 +534,8 @@ externalBindings ts =
     -- M-<F1> reserved for showing the keymap
     , KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
     , KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile
-    , KeyBinding "M-<F7>" "start Isync Service" $ noCheck runStartISyncService
-    , KeyBinding "M-C-<F7>" "start Isync Timer" $ noCheck runStartISyncTimer
+    , KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
+    , KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
     , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
     , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth

lib/XMonad/Internal/Command/DMenu.hs

@@ -63,7 +63,7 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
 -- | Exported Commands
 
 runDevMenu :: IO MaybeX
-runDevMenu = runIfInstalled [Required myDmenuDevices] $ do
+runDevMenu = runIfInstalled [exe myDmenuDevices] $ do
   c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
   spawnCmd myDmenuDevices
     $ ["-c", c]
@@ -71,7 +71,7 @@ runDevMenu = runIfInstalled [Required myDmenuDevices] $ do
     ++ myDmenuMatchingArgs
 
 runBwMenu :: IO MaybeX
-runBwMenu = runIfInstalled [Required myDmenuPasswords] $
+runBwMenu = runIfInstalled [exe myDmenuPasswords] $
   spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
 
 runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
@@ -82,7 +82,7 @@ runShowKeys x = addName "Show Keybindings" $ do
     $ defNoteError { body = Just $ Text "could not display keymap" }
 
 runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> IO MaybeX
-runDMenuShowKeys kbs = runIfInstalled [Required myDmenuCmd] $ io $ do
+runDMenuShowKeys kbs = runIfInstalled [exe myDmenuCmd] $ io $ do
   (h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
   forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
   where

lib/XMonad/Internal/Command/Desktop.hs

@@ -91,7 +91,7 @@ runTerm :: IO MaybeX
 runTerm = spawnIfInstalled myTerm
 
 runTMux :: IO MaybeX
-runTMux = runIfInstalled [Required myTerm, Required "tmux", Required "bash"] cmd
+runTMux = runIfInstalled [exe myTerm, exe "tmux", exe "bash"] cmd
   where
     cmd = spawn
       $ "tmux has-session"
@@ -101,7 +101,7 @@ runTMux = runIfInstalled [Required myTerm, Required "tmux", Required "bash"] cmd
     msg = "could not connect to tmux session"
 
 runCalc :: IO MaybeX
-runCalc = runIfInstalled [Required myTerm, Required "R"] $ spawnCmd myTerm ["-e", "R"]
+runCalc = runIfInstalled [exe myTerm, exe "R"] $ spawnCmd myTerm ["-e", "R"]
 
 runBrowser :: IO MaybeX
 runBrowser = spawnIfInstalled myBrowser
@@ -144,7 +144,7 @@ runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return ()
 -- | System commands
 
 runToggleBluetooth :: IO MaybeX
-runToggleBluetooth = runIfInstalled [Required myBluetooth] $ spawn
+runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn
   $ myBluetooth ++ " show | grep -q \"Powered: no\""
   #!&& "a=on"
   #!|| "a=off"
@@ -167,21 +167,23 @@ runToggleDPMS :: X ()
 runToggleDPMS = io $ void callToggle
 
 runToggleEthernet :: IO MaybeX
-runToggleEthernet = runIfInstalled [Required "nmcli"] $ spawn
+runToggleEthernet = runIfInstalled [exe "nmcli"] $ spawn
   $ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
   #!&& "a=connect"
   #!|| "a=disconnect"
   #!>> fmtCmd "nmcli" ["device", "$a", ethernetIface]
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed"  }
 
-runStartISyncTimer :: X ()
-runStartISyncTimer = spawn
+runStartISyncTimer :: IO MaybeX
+runStartISyncTimer = runIfInstalled [userUnit "mbsync.timer"]
+  $ spawn
   $ "systemctl --user start mbsync.timer"
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started"  }
   #!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" }
 
-runStartISyncService :: X ()
-runStartISyncService = spawn
+runStartISyncService :: IO MaybeX
+runStartISyncService = runIfInstalled [userUnit "mbsync.service"]
+  $ spawn
   $ "systemctl --user start mbsync.service"
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
   #!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync failed" }
@@ -225,7 +227,7 @@ getCaptureDir = do
     fallback = (</> ".local/share") <$> getHomeDirectory
 
 runFlameshot :: String -> IO MaybeX
-runFlameshot mode = runIfInstalled [Required myCapture] $ do
+runFlameshot mode = runIfInstalled [exe myCapture] $ do
   ssDir <- io getCaptureDir
   spawnCmd myCapture $ mode : ["-p", ssDir]
 
@@ -243,6 +245,6 @@ runScreenCapture :: IO MaybeX
 runScreenCapture = runFlameshot "screen"
 
 runCaptureBrowser :: IO MaybeX
-runCaptureBrowser = runIfInstalled [Required myImageBrowser] $ do
+runCaptureBrowser = runIfInstalled [exe myImageBrowser] $ do
   dir <- io getCaptureDir
   spawnCmd myImageBrowser [dir]

lib/XMonad/Internal/Command/Power.hs

@@ -129,7 +129,7 @@ runOptimusPrompt' = do
 runOptimusPrompt :: IO MaybeX
 runOptimusPrompt = do
   g <- requireOptimus
-  if g then runIfInstalled [Required myOptimusManager] runOptimusPrompt'
+  if g then runIfInstalled [exe myOptimusManager] runOptimusPrompt'
     else return Ignore
 
 --------------------------------------------------------------------------------

lib/XMonad/Internal/Shell.hs

@@ -3,9 +3,13 @@
 
 module XMonad.Internal.Shell
   ( MaybeExe(..)
+  , UnitType(..)
   , Dependency(..)
   , MaybeX
   , IOMaybeX
+  , exe
+  , systemUnit
+  , userUnit
   , runIfInstalled
   , warnMissing
   , whenInstalled
@@ -32,6 +36,7 @@ import           Control.Monad.IO.Class
 import           Data.Maybe              (isJust)
 
 import           System.Directory        (findExecutable)
+import           System.Exit
 import           System.FilePath.Posix
 
 import           XMonad.Core             (X, getXMonadDir)
@@ -40,27 +45,67 @@ import           XMonad.Internal.Process
 --------------------------------------------------------------------------------
 -- | Gracefully handling missing binaries
 
-data Dependency = Required String | Optional String deriving (Eq, Show)
+data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
 
-data MaybeExe m = Installed (m ()) [String] | Missing [Dependency] | Ignore
+data DependencyType = Executable | Systemd UnitType deriving (Eq, Show)
+
+data Dependency = Dependency
+  { depRequired :: Bool
+  , depName     :: String
+  , depType     :: DependencyType
+  }
+  deriving (Eq, Show)
+
+exe :: String -> Dependency
+exe n = Dependency
+  { depRequired = True
+  , depName = n
+  , depType = Executable }
+
+unit :: UnitType -> String -> Dependency
+unit t n = Dependency
+  { depRequired = True
+  , depName = n
+  , depType = Systemd t }
+
+systemUnit :: String -> Dependency
+systemUnit = unit SystemUnit
+
+userUnit :: String -> Dependency
+userUnit = unit UserUnit
+
+data MaybeExe m = Installed (m ()) [Dependency] | Missing [Dependency] | Ignore
 
 type MaybeX = MaybeExe X
 
 type IOMaybeX = IO MaybeX
 
 warnMissing :: Dependency -> String
-warnMissing d            = case d of
-  Required d' -> warn "required" d'
-  Optional d' -> warn "optional" d'
+warnMissing Dependency {depRequired = r, depName = n, depType = t } =
+  "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
   where
-    warn t n = "WARNING: " ++ t ++ " executable not found: " ++ n
+    fmtType Executable = "executable"
+    fmtType (Systemd u) =
+      "systemd " ++ (if u == UserUnit then "user" else "system") ++ " unit"
+    r' = if r then "required" else "optional"
 
 exeInstalled :: String -> IO Bool
 exeInstalled x = isJust <$> findExecutable x
 
+unitInstalled :: String -> UnitType -> IO Bool
+unitInstalled x u = do
+  (rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
+  return $ case rc of
+    ExitSuccess -> True
+    _           -> False
+  where
+    cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
+
 depInstalled :: Dependency -> IO Bool
-depInstalled (Required d) = exeInstalled d
-depInstalled (Optional d) = exeInstalled d
+depInstalled Dependency { depName = n, depType = t } =
+  case t of
+    Executable -> exeInstalled n
+    Systemd u  -> unitInstalled n u
 
 filterMissing :: [Dependency] -> IO [Dependency]
 filterMissing = filterM (fmap not . depInstalled)
@@ -68,15 +113,15 @@ filterMissing = filterM (fmap not . depInstalled)
 runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe m)
 runIfInstalled ds x = do
   missing <- filterMissing ds
-  return $ if null [m | Required m <- missing]
-    then Installed x [m | Optional m <- missing]
+  return $ if not $ any depRequired missing
+    then Installed x $ filter (not . depRequired) missing
     else Missing missing
 
 spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
-spawnIfInstalled exe = runIfInstalled [Required exe] $ spawn exe
+spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
 
 spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
-spawnCmdIfInstalled exe args = runIfInstalled [Required exe] $ spawnCmd exe args
+spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
 
 whenInstalled :: Monad m => MaybeExe m -> m ()
 whenInstalled = flip ifInstalled skip
@@ -104,7 +149,7 @@ soundDir :: FilePath
 soundDir = "sound"
 
 spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
-spawnSound file pre post = runIfInstalled [Required "paplay"]
+spawnSound file pre post = runIfInstalled [exe "paplay"]
   $ pre >> playSound file >> post
 
 playSound :: MonadIO m => FilePath -> m ()