ENH warn user if systemd units are missing
This commit is contained in:
parent
6620616b7b
commit
d1c398b3c3
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
Loading…
Reference in New Issue