diff --git a/bin/xmonad.hs b/bin/xmonad.hs index e36e80a..3f1ab3d 100644 --- a/bin/xmonad.hs +++ b/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- reserved for showing the keymap , KeyBinding "M-" "restart xmonad" $ noCheck (runCleanup ts >> runRestart) , KeyBinding "M-" "recompile xmonad" $ noCheck runRecompile - , KeyBinding "M-" "start Isync Service" $ noCheck runStartISyncService - , KeyBinding "M-C-" "start Isync Timer" $ noCheck runStartISyncTimer + , KeyBinding "M-" "start Isync Service" runStartISyncService + , KeyBinding "M-C-" "start Isync Timer" runStartISyncTimer , KeyBinding "M-" "select autorandr profile" runAutorandrMenu , KeyBinding "M-" "toggle ethernet" runToggleEthernet , KeyBinding "M-" "toggle bluetooth" runToggleBluetooth diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 9a778dd..2dd0646 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/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 diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 2a7b058..deb8faf 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/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,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] diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index e519c94..50861bd 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/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 -------------------------------------------------------------------------------- diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index 79b3d02..d30204d 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/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 ()