ENH warn user if systemd units are missing

This commit is contained in:
Nathan Dwarshuis 2021-06-20 17:17:30 -04:00
parent 6620616b7b
commit d1c398b3c3
5 changed files with 80 additions and 33 deletions

View File

@ -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 go k@KeyGroup { kgBindings = bs } = let bs' = go' <$> bs in
(k { kgBindings = mapMaybe fst bs' }, concatMap snd bs') (k { kgBindings = mapMaybe fst bs' }, concatMap snd bs')
go' k@KeyBinding{ kbDesc = d, kbAction = a } = case a of 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) Missing ds -> (Just $ k{ kbDesc = flagMissing d, kbAction = skip }, ds)
Ignore -> (Nothing, []) Ignore -> (Nothing, [])
flagMissing s = "[!!!]" ++ s flagMissing s = "[!!!]" ++ s
@ -534,8 +534,8 @@ externalBindings ts =
-- 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
, KeyBinding "M-<F7>" "start Isync Service" $ noCheck runStartISyncService , KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
, KeyBinding "M-C-<F7>" "start Isync Timer" $ noCheck runStartISyncTimer , KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth

View File

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

View File

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

View File

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

View File

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