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
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,24 +167,26 @@ 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" }
|
||||
#!|| 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" }
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
|
||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync failed" }
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Configuration commands
|
||||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue