ENH noop programs that are missing

bin/xmonad.hs

@@ -14,7 +14,7 @@ import           Data.List
     , sortBy
     , sortOn
     )
-import           Data.Maybe                                   (isJust)
+import           Data.Maybe                                   (isJust, mapMaybe)
 import           Data.Monoid                                  (All (..))
 
 import           Graphics.X11.Types
@@ -74,9 +74,10 @@ main = do
         , childPIDs = [p]
         , childHandles = [h]
         }
+  ekbs <- evalExternal $ externalBindings ts
   launch
     $ ewmh
-    $ addKeymap ts
+    $ addKeymap (filterExternal ekbs)
     $ def { terminal = myTerm
           , modMask = myModMask
           , layoutHook = myLayouts
@@ -369,33 +370,34 @@ xMsgEventHook _ = return (All True)
 myModMask :: KeyMask
 myModMask = mod4Mask
 
-addKeymap :: ThreadState -> XConfig l -> XConfig l
+addKeymap :: [KeyGroup (X ())] -> XConfig l -> XConfig l
-addKeymap ts = addDescrKeys' ((myModMask, xK_F1), runShowKeys) (mkKeys ts)
+addKeymap external = addDescrKeys' ((myModMask, xK_F1), runShowKeys)
+  (\c -> concatMap (mkNamedSubmap c) $ internalBindings c ++ external)
 
-mkKeys :: ThreadState -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
+internalBindings :: XConfig Layout -> [KeyGroup (X ())]
-mkKeys ts c =
+internalBindings c =
-  mkNamedSubmap "Window Layouts"
+  [ KeyGroup "Window Layouts"
-  [ ("M-j", "focus down", windows W.focusDown)
+    [ KeyBinding "M-j" "focus down" $ windows W.focusDown
-  , ("M-k", "focus up", windows W.focusUp)
+    , KeyBinding "M-k" "focus up" $ windows W.focusUp
-  , ("M-m", "focus master", windows W.focusMaster)
+    , KeyBinding "M-m" "focus master" $ windows W.focusMaster
-  , ("M-d", "focus master", runHide)
+    , KeyBinding "M-d" "focus master" runHide
-  , ("M-S-j", "swap down", windows W.swapDown)
+    , KeyBinding "M-S-j" "swap down" $ windows W.swapDown
-  , ("M-S-k", "swap up", windows W.swapUp)
+    , KeyBinding "M-S-k" "swap up" $ windows W.swapUp
-  , ("M-S-m", "swap master", windows W.swapMaster)
+    , KeyBinding "M-S-m" "swap master" $ windows W.swapMaster
-  , ("M-<Return>", "next layout", sendMessage NextLayout)
+    , KeyBinding "M-<Return>" "next layout" $ sendMessage NextLayout
-  , ("M-S-<Return>", "reset layout", setLayout $ layoutHook c)
+    , KeyBinding "M-S-<Return>" "reset layout" $ setLayout $ layoutHook c
-  , ("M-t", "sink tiling", withFocused $ windows . W.sink)
+    , KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink
-  , ("M-S-t", "float tiling", withFocused O.float)
+    , KeyBinding "M-S-t" "float tiling" $ withFocused O.float
-  , ("M--", "shrink", sendMessage Shrink)
+    , KeyBinding "M--" "shrink" $ sendMessage Shrink
-  , ("M-=", "expand", sendMessage Expand)
+    , KeyBinding "M-=" "expand" $ sendMessage Expand
-  , ("M-S--", "remove master window", sendMessage $ IncMasterN (-1))
+    , KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1)
-  , ("M-S-=", "add master window", sendMessage $ IncMasterN 1)
+    , KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1
-  ] ++
+    ]
 
-  mkNamedSubmap "Workspaces"
+  , KeyGroup "Workspaces"
     -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
     -- valid keysyms)
-  ([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces
+    ([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces
       , (mods, msg, f) <-
         [ ("M-", "switch to workspace ", windows . W.view)
         , ("M-S-", "move client to workspace ", windows . W.shift)
@@ -404,91 +406,126 @@ mkKeys ts c =
               windows $ W.view n')
         ]
      ] ++
-   [ ("M-M1-l", "move up workspace", moveTo Next HiddenNonEmptyWS)
+     [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS
-   , ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS)
+     , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS
-   ]) ++
+     ])
 
-  mkNamedSubmap "Dynamic Workspaces"
+  , KeyGroup "Dynamic Workspaces"
-  [ ("M-C-" ++ [k], "launch/switch to " ++ n, cmd)
+    [ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd
     |  DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
        let cmd = case a of
              Just a' -> spawnOrSwitch t a'
              Nothing -> windows $ W.view t
-  ] ++
+    ]
 
-  mkNamedSubmap "Screens"
+  , KeyGroup "Screens"
-  [ ("M-l", "move up screen", nextScreen)
+    [ KeyBinding "M-l" "move up screen" nextScreen
-  , ("M-h", "move down screen", prevScreen)
+    , KeyBinding "M-h" "move down screen" prevScreen
-  , ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen)
+    , KeyBinding "M-C-l" "follow client up screen" $ shiftNextScreen >> nextScreen
-  , ("M-C-h", "follow client down screen", shiftPrevScreen >> prevScreen)
+    , KeyBinding "M-C-h" "follow client down screen" $ shiftPrevScreen >> prevScreen
-  , ("M-S-l", "shift workspace up screen", swapNextScreen >> nextScreen)
+    , KeyBinding "M-S-l" "shift workspace up screen" $ swapNextScreen >> nextScreen
-  , ("M-S-h", "shift workspace down screen", swapPrevScreen >> prevScreen)
+    , KeyBinding "M-S-h" "shift workspace down screen" $ swapPrevScreen >> prevScreen
-  ] ++
+    ]
-
-  mkNamedSubmap "Actions"
-  [ ("M-q", "close window", kill1)
-  , ("M-r", "run program", runCmdMenu)
-  , ("M-<Space>", "warp pointer", warpToWindow 0.5 0.5)
-  , ("M-C-s", "capture area", runAreaCapture)
-  , ("M-C-S-s", "capture screen", runScreenCapture)
-  , ("M-C-d", "capture desktop", runDesktopCapture)
-  , ("M-C-b", "browse captures", runCaptureBrowser)
-  -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
-  ] ++
-
-  mkNamedSubmap "Launchers"
-  [ ("<XF86Search>", "select/launch app", runAppMenu)
-  , ("M-g", "launch clipboard manager", runClipMenu)
-  , ("M-a", "launch network selector", runNetMenu)
-  , ("M-w", "launch window selector", runWinMenu)
-  , ("M-u", "launch device selector", runDevMenu)
-  , ("M-b", "launch bitwarden selector", runBwMenu)
-  , ("M-C-e", "launch editor", runEditor)
-  , ("M-C-w", "launch browser", runBrowser)
-  , ("M-C-t", "launch terminal with tmux", runTMux)
-  , ("M-C-S-t", "launch terminal", runTerm)
-  , ("M-C-q", "launch calc", runCalc)
-  , ("M-C-f", "launch file manager", runFileManager)
-  ] ++
-
-  mkNamedSubmap "Multimedia"
-  [ ("<XF86AudioPlay>", "toggle play/pause", runTogglePlay)
-  , ("<XF86AudioPrev>", "previous track", runPrevTrack)
-  , ("<XF86AudioNext>", "next track", runNextTrack)
-  , ("<XF86AudioStop>", "stop", runStopPlay)
-  , ("<XF86AudioLowerVolume>", "volume down", runVolumeDown)
-  , ("<XF86AudioRaiseVolume>", "volume up", runVolumeUp)
-  , ("<XF86AudioMute>", "volume mute", runVolumeMute)
-  ] ++
 
   -- dummy map for dunst commands (defined separately but this makes them show
   -- up in the help menu)
-  mkNamedSubmap "Dunst"
+  , KeyGroup "Dunst"
-  [ ("M-`", "dunst history", return ())
+    [ KeyBinding "M-`" "dunst history" skip
-  , ("M-S-`", "dunst close", return ())
+    , KeyBinding "M-S-`" "dunst close" skip
-  , ("M-M1-`", "dunst context menu", return ())
+    , KeyBinding "M-M1-`" "dunst context menu" skip
-  , ("M-C-`", "dunst close all", return ())
+    , KeyBinding "M-C-`" "dunst close all" skip
-  ] ++
-
-  mkNamedSubmap "System"
-  [ ("M-.", "backlight up", runIncBacklight)
-  , ("M-,", "backlight down", runDecBacklight)
-  , ("M-M1-,", "backlight min", runMinBacklight)
-  , ("M-M1-.", "backlight max", runMaxBacklight)
-  , ("M-<End>", "power menu", runPowerPrompt)
-  , ("M-<Home>", "quit xmonad", runQuitPrompt)
-  , ("M-<Delete>", "lock screen", runScreenLock)
-  -- M-<F1> reserved for showing the keymap
-  , ("M-<F2>", "restart xmonad", runCleanup ts >> runRestart)
-  , ("M-<F3>", "recompile xmonad", runRecompile)
-  , ("M-<F7>", "start Isync Service", runStartISyncService)
-  , ("M-C-<F7>", "start Isync Timer", runStartISyncTimer)
-  , ("M-<F8>", "select autorandr profile", runAutorandrMenu)
-  , ("M-<F9>", "toggle ethernet", runToggleEthernet)
-  , ("M-<F10>", "toggle bluetooth", runToggleBluetooth)
-  , ("M-<F11>", "toggle screensaver", runToggleDPMS)
-  , ("M-<F12>", "switch gpu", runOptimusPrompt)
     ]
+  ]
+
+mkNamedSubmap :: XConfig Layout ->  KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)]
+mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } =
+  (subtitle h:) $ mkNamedKeymap c
+  $ (\KeyBinding{kbSyms = s, kbDesc = d, kbAction = a} -> (s, addName d a))
+  <$> b
+
+data KeyBinding a = KeyBinding
+  { kbSyms :: String
+  , kbDesc :: String
+  , kbAction :: a
+  }
+
+data KeyGroup a = KeyGroup
+  { kgHeader :: String
+  , kgBindings :: [KeyBinding a]
+  }
+
+evalExternal :: [KeyGroup (IO MaybeX)] -> IO [KeyGroup MaybeX]
+evalExternal = mapM go
   where
-    mkNamedSubmap header bindings = (subtitle header:) $ mkNamedKeymap c
+    go k@KeyGroup { kgBindings = bs } =
-      $ map (\(key, name, cmd) -> (key, addName name cmd)) bindings
+      (\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
+
+evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a)
+evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a
+
+filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
+filterExternal = fmap go
+  where
+    go k@KeyGroup { kgBindings = bs } =
+      k { kgBindings = mapMaybe go' bs }
+    go' k@KeyBinding { kbAction = Installed x } = Just $ k { kbAction = x }
+    go' _ = Nothing
+
+externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)]
+externalBindings ts =
+  [ KeyGroup "Launchers"
+    [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
+    , KeyBinding "M-g" "launch clipboard manager" runClipMenu
+    , KeyBinding "M-a" "launch network selector" runNetMenu
+    , KeyBinding "M-w" "launch window selector" runWinMenu
+    , KeyBinding "M-u" "launch device selector" runDevMenu
+    , KeyBinding "M-b" "launch bitwarden selector" runBwMenu
+    , KeyBinding "M-C-e" "launch editor" runEditor
+    , KeyBinding "M-C-w" "launch browser" runBrowser
+    , KeyBinding "M-C-t" "launch terminal with tmux" runTMux
+    , KeyBinding "M-C-S-t" "launch terminal" runTerm
+    , KeyBinding "M-C-q" "launch calc" runCalc
+    , KeyBinding "M-C-f" "launch file manager" runFileManager
+    ]
+
+  , KeyGroup "Actions"
+    [ KeyBinding "M-q" "close window" $ noCheck kill1
+    , KeyBinding "M-r" "run program" runCmdMenu
+    , KeyBinding "M-<Space>" "warp pointer" $ noCheck $ warpToWindow 0.5 0.5
+    , KeyBinding "M-C-s" "capture area" runAreaCapture
+    , KeyBinding "M-C-S-s" "capture screen" runScreenCapture
+    , KeyBinding "M-C-d" "capture desktop" runDesktopCapture
+    , KeyBinding "M-C-b" "browse captures" runCaptureBrowser
+    -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
+    ]
+
+  , KeyGroup "Multimedia"
+    [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" runTogglePlay
+    , KeyBinding "<XF86AudioPrev>" "previous track" runPrevTrack
+    , KeyBinding "<XF86AudioNext>" "next track" runNextTrack
+    , KeyBinding "<XF86AudioStop>" "stop" runStopPlay
+    , KeyBinding "<XF86AudioLowerVolume>" "volume down" runVolumeDown
+    , KeyBinding "<XF86AudioRaiseVolume>" "volume up" runVolumeUp
+    , KeyBinding "<XF86AudioMute>" "volume mute" runVolumeMute
+    ]
+  
+  , KeyGroup "System"
+    [ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight
+    , KeyBinding "M-," "backlight down" $ noCheck runDecBacklight
+    , KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight
+    , KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight
+    , KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
+    , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
+    , KeyBinding "M-<Delete>" "lock screen" runScreenLock
+    -- 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-<F8>" "select autorandr profile" runAutorandrMenu
+    , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
+    , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
+    , KeyBinding "M-<F11>" "toggle screensaver" $ noCheck runToggleDPMS
+    , KeyBinding "M-<F12>" "switch gpu" $ noCheck runOptimusPrompt
+    ]
+  ]

lib/XMonad/Internal/Command/DMenu.hs

@@ -18,6 +18,7 @@ import           Control.Monad.Reader
 import           Graphics.X11.Types
 
 import           System.IO
+import           System.Directory (getXdgDirectory, XdgDirectory(..))
 
 import           XMonad.Core              hiding (spawn)
 import           XMonad.Internal.Process
@@ -25,13 +26,28 @@ import           XMonad.Internal.Shell
 import           XMonad.Util.NamedActions
 
 --------------------------------------------------------------------------------
--- | Other internal functions
+-- | DMenu executables
 
 myDmenuCmd :: String
 myDmenuCmd = "rofi"
 
-spawnDmenuCmd :: [String] -> X ()
+myDmenuDevices :: String
-spawnDmenuCmd = spawnCmd myDmenuCmd
+myDmenuDevices = "rofi-dev"
+
+myDmenuPasswords :: String
+myDmenuPasswords = "rofi-bw"
+
+myDmenuMonitors :: String
+myDmenuMonitors = "rofi-autorandr"
+
+myDmenuNetworks :: String
+myDmenuNetworks = "networkmanager_dmenu"
+
+--------------------------------------------------------------------------------
+-- | Other internal functions
+
+spawnDmenuCmd :: [String] -> IO MaybeX
+spawnDmenuCmd = spawnCmdIfInstalled myDmenuCmd
 
 themeArgs :: String -> [String]
 themeArgs hexColor =
@@ -45,18 +61,19 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
 --------------------------------------------------------------------------------
 -- | Exported Commands
 
-devSecrets :: [String]
+runDevMenu :: IO MaybeX
-devSecrets = ["-c", "/home/ndwar/.config/rofi/devices.yml"]
+runDevMenu = runIfInstalled [myDmenuDevices] $ do
-
+  c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
-runDevMenu :: X ()
+  spawnCmd myDmenuDevices
-runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs
+    $ ["-c", c]
-  where
+    ++ "--" : themeArgs "#999933"
-    rofiArgs = "--" : themeArgs "#999933" ++ myDmenuMatchingArgs
-
-runBwMenu :: X ()
-runBwMenu = spawnCmd "rofi-bw" $ ["-c", "--"] ++ themeArgs "#bb6600"
     ++ myDmenuMatchingArgs
 
+runBwMenu :: IO MaybeX
+runBwMenu = runIfInstalled [myDmenuPasswords] $
+  spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
+
+-- TODO what to do with this if rofi doesn't exist?
 runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
 runShowKeys x = addName "Show Keybindings" $ do
   (h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
@@ -64,24 +81,25 @@ runShowKeys x = addName "Show Keybindings" $ do
   where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
           ++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
 
-runCmdMenu :: X ()
+runCmdMenu :: IO MaybeX
 runCmdMenu = spawnDmenuCmd ["-show", "run"]
 
-runAppMenu :: X ()
+runAppMenu :: IO MaybeX
 runAppMenu = spawnDmenuCmd ["-show", "drun"]
 
-runClipMenu :: X ()
+-- TODO this also depends on greenclip
+runClipMenu :: IO MaybeX
 runClipMenu = spawnDmenuCmd $
   [ "-modi", "\"clipboard:greenclip print\""
   , "-show", "clipboard"
   , "-run-command", "'{cmd}'"
   ] ++ themeArgs "#00c44e"
 
-runWinMenu :: X ()
+runWinMenu :: IO MaybeX
 runWinMenu = spawnDmenuCmd ["-show", "window"]
 
-runNetMenu :: X ()
+runNetMenu :: IO MaybeX
-runNetMenu = spawnCmd "networkmanager_dmenu" $ themeArgs "#ff3333"
+runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333"
 
-runAutorandrMenu :: X ()
+runAutorandrMenu :: IO MaybeX
-runAutorandrMenu = spawnCmd "rofi-autorandr" $ themeArgs "#ff0066"
+runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066"

lib/XMonad/Internal/Command/Desktop.hs

@@ -52,75 +52,103 @@ import           XMonad.Internal.Shell
 import           XMonad.Operations
 
 --------------------------------------------------------------------------------
--- | Some nice apps
+-- | My Executables
 
 myTerm :: String
 myTerm = "urxvt"
 
-runTerm :: X ()
+myBrowser :: String
-runTerm = spawn myTerm
+myBrowser = "brave-accel"
 
-runTMux :: X ()
+myEditor :: String
-runTMux = spawn
+myEditor = "emacsclient"
-  $ "tmux has-session"
-  #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
-  #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
-  where
-    c = "exec tmux attach-session -d"
-    msg = "could not connect to tmux session"
-
-runCalc :: X ()
-runCalc = spawnCmd myTerm ["-e", "R"]
-
-runBrowser :: X ()
-runBrowser = spawn "brave-accel"
-
-runEditor :: X ()
-runEditor = spawnCmd "emacsclient"
-  ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
-
-runFileManager :: X ()
-runFileManager = spawn "pcmanfm"
-
---------------------------------------------------------------------------------
--- | Multimedia Commands
 
 myMultimediaCtl :: String
 myMultimediaCtl = "playerctl"
 
-runTogglePlay :: X ()
+myBluetooth :: String
-runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
+myBluetooth = "bluetoothctl"
 
-runPrevTrack :: X ()
+myCapture :: String
-runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
+myCapture = "flameshot"
 
-runNextTrack :: X ()
+myImageBrowser :: String
-runNextTrack = spawnCmd myMultimediaCtl ["next"]
+myImageBrowser = "feh"
 
-runStopPlay :: X ()
+--------------------------------------------------------------------------------
-runStopPlay = spawnCmd myMultimediaCtl ["stop"]
+-- | Misc constants
 
 volumeChangeSound :: FilePath
 volumeChangeSound = "smb_fireball.wav"
 
-runVolumeDown :: X ()
+ethernetIface :: String
-runVolumeDown =  spawnSound volumeChangeSound >> void (lowerVolume 2)
+ethernetIface = "enp7s0f1"
 
-runVolumeUp :: X ()
+--------------------------------------------------------------------------------
-runVolumeUp = spawnSound volumeChangeSound >> void (raiseVolume 2)
+-- | Some nice apps
 
-runVolumeMute :: X ()
+runTerm :: IO MaybeX
-runVolumeMute = void toggleMute >> spawnSound volumeChangeSound
+runTerm = spawnIfInstalled myTerm
+
+runTMux :: IO MaybeX
+runTMux = runIfInstalled [myTerm, "tmux", "bash"] cmd
+  where
+    cmd = spawn
+      $ "tmux has-session"
+      #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
+      #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
+    c = "exec tmux attach-session -d"
+    msg = "could not connect to tmux session"
+
+runCalc :: IO MaybeX
+runCalc = runIfInstalled [myTerm, "R"] $ spawnCmd myTerm ["-e", "R"]
+
+runBrowser :: IO MaybeX
+runBrowser = spawnIfInstalled myBrowser
+
+runEditor :: IO MaybeX
+runEditor = spawnCmdIfInstalled myEditor
+  ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
+
+runFileManager :: IO MaybeX
+runFileManager = spawnIfInstalled "pcmanfm"
+
+--------------------------------------------------------------------------------
+-- | Multimedia Commands
+
+runMultimediaIfInstalled :: String -> IO MaybeX
+runMultimediaIfInstalled cmd = spawnCmdIfInstalled myMultimediaCtl [cmd]
+
+runTogglePlay :: IO MaybeX
+runTogglePlay = runMultimediaIfInstalled "play-pause"
+
+runPrevTrack :: IO MaybeX
+runPrevTrack = runMultimediaIfInstalled "previous"
+
+runNextTrack :: IO MaybeX
+runNextTrack = runMultimediaIfInstalled "next"
+
+runStopPlay :: IO MaybeX
+runStopPlay = runMultimediaIfInstalled "stop"
+
+runVolumeDown :: IO MaybeX
+runVolumeDown =  spawnSound volumeChangeSound (return ()) $ void (lowerVolume 2)
+
+runVolumeUp :: IO MaybeX
+runVolumeUp = spawnSound volumeChangeSound (return ()) $ void (raiseVolume 2)
+
+runVolumeMute :: IO MaybeX
+runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return ()
 
 --------------------------------------------------------------------------------
 -- | System commands
 
-runToggleBluetooth :: X ()
+runToggleBluetooth :: IO MaybeX
-runToggleBluetooth = spawn
+runToggleBluetooth = runIfInstalled [myBluetooth] $ spawn
-  $ "bluetoothctl show | grep -q \"Powered: no\""
+  $ myBluetooth ++ " show | grep -q \"Powered: no\""
   #!&& "a=on"
   #!|| "a=off"
-  #!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
+  #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a"  }
 
 runIncBacklight :: X ()
@@ -138,11 +166,8 @@ runMaxBacklight = io $ void callMaxBrightness
 runToggleDPMS :: X ()
 runToggleDPMS = io $ void callToggle
 
-ethernetIface :: String
+runToggleEthernet :: IO MaybeX
-ethernetIface = "enp7s0f1"
+runToggleEthernet = runIfInstalled ["nmcli"] $ spawn
-
-runToggleEthernet :: X ()
-runToggleEthernet = spawn
   $ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
   #!&& "a=connect"
   #!|| "a=disconnect"
@@ -199,25 +224,25 @@ getCaptureDir = do
   where
     fallback = (</> ".local/share") <$> getHomeDirectory
 
-runFlameshot :: String -> X ()
+runFlameshot :: String -> IO MaybeX
-runFlameshot mode = do
+runFlameshot mode = runIfInstalled [myCapture] $ do
   ssDir <- io getCaptureDir
-  spawnCmd "flameshot" $ mode : ["-p", ssDir]
+  spawnCmd myCapture $ mode : ["-p", ssDir]
 
 -- TODO this will steal focus from the current window (and puts it
 -- in the root window?) ...need to fix
-runAreaCapture :: X ()
+runAreaCapture :: IO MaybeX
 runAreaCapture = runFlameshot "gui"
 
 -- myWindowCap = "screencap -w" --external script
 
-runScreenCapture :: X ()
+runDesktopCapture :: IO MaybeX
-runScreenCapture = runFlameshot "screen"
-
-runDesktopCapture :: X ()
 runDesktopCapture = runFlameshot "full"
 
-runCaptureBrowser :: X ()
+runScreenCapture :: IO MaybeX
-runCaptureBrowser = do
+runScreenCapture = runFlameshot "screen"
+  
+runCaptureBrowser :: IO MaybeX
+runCaptureBrowser = runIfInstalled [myImageBrowser] $ do
   dir <- io getCaptureDir
-  spawnCmd "feh" [dir]
+  spawnCmd myImageBrowser [dir]

lib/XMonad/Internal/Command/Power.hs

@@ -31,8 +31,8 @@ import           XMonad.Prompt.ConfirmPrompt
 --------------------------------------------------------------------------------
 -- | Core commands
 
-runScreenLock :: X ()
+runScreenLock :: IOMaybeX
-runScreenLock = spawn "screenlock"
+runScreenLock = spawnIfInstalled "screenlock"
 
 runPowerOff :: X ()
 runPowerOff = spawn "systemctl poweroff"
@@ -119,6 +119,6 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
     sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
     executeAction a = case toEnum $ read a of
       Poweroff  -> runPowerOff
-      Shutdown  -> runScreenLock >> runSuspend
+      Shutdown  -> (io runScreenLock >>= whenInstalled) >> runSuspend
-      Hibernate -> runScreenLock >> runHibernate
+      Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
       Reboot    -> runReboot

lib/XMonad/Internal/Concurrent/ACPIEvent.hs

@@ -23,6 +23,7 @@ import           System.IO.Streams.UnixSocket
 
 import           XMonad.Core
 import           XMonad.Internal.Command.Power
+import           XMonad.Internal.Shell
 import           XMonad.Internal.Concurrent.ClientMessage
 
 --------------------------------------------------------------------------------
@@ -100,4 +101,6 @@ handleACPI tag = do
     Sleep -> runSuspendPrompt
     LidClose -> do
       status <- io isDischarging
-      forM_ status $ \s -> runScreenLock >> when s runSuspend
+      forM_ status $ \s -> do
+        io runScreenLock >>= whenInstalled
+        when s runSuspend

lib/XMonad/Internal/Concurrent/Removable.hs

@@ -56,7 +56,7 @@ removedHasDrive [_, a] = maybe False (driveFlag `elem`)
 removedHasDrive _ = False
 
 playSoundMaybe :: FilePath -> Bool -> IO ()
-playSoundMaybe p b = when b $ spawnSound p
+playSoundMaybe p b = when b $ playSound p
 
 -- NOTE: the udisks2 service should be already running for this module to work.
 -- If it not already, we won't see any signals from the dbus until it is

lib/XMonad/Internal/Shell.hs

@@ -2,23 +2,69 @@
 -- | Functions for formatting and spawning shell commands
 
 module XMonad.Internal.Shell
-  ( fmtCmd
+  ( MaybeExe(..)
+  , MaybeX
+  , IOMaybeX
+  , runIfInstalled
+  , whenInstalled
+  , spawnIfInstalled
+  , spawnCmdIfInstalled
+  , noCheck
+  , fmtCmd
   , spawnCmd
   , spawnSound
+  , playSound
   , doubleQuote
   , singleQuote
+  , skip
   , (#!&&)
   , (#!||)
   , (#!>>)
   ) where
 
+import           Control.Monad           (filterM)
 import           Control.Monad.IO.Class
 
-import           System.FilePath.Posix
+import           Data.Maybe              (isNothing)
 
-import           XMonad.Core             (getXMonadDir)
+import           System.FilePath.Posix
+import           System.Directory        (findExecutable)
+
+import           XMonad.Core             (getXMonadDir, X)
 import           XMonad.Internal.Process
 
+--------------------------------------------------------------------------------
+-- | Gracefully handling missing binaries
+
+data MaybeExe m = Installed (m ()) | Missing [String] | Noop
+
+type MaybeX = MaybeExe X
+
+type IOMaybeX = IO MaybeX
+
+runIfInstalled :: MonadIO m => [String] -> m () -> IO (MaybeExe m)
+runIfInstalled exes x = do
+  missing <- filterM (fmap isNothing . findExecutable) exes
+  return $ case missing of
+    [] -> Installed x
+    ms -> Missing ms
+
+spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
+spawnIfInstalled exe = runIfInstalled [exe] $ spawn exe
+
+spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
+spawnCmdIfInstalled exe args = runIfInstalled [exe] $ spawnCmd exe args
+
+whenInstalled :: Monad m => MaybeExe m -> m ()
+whenInstalled (Installed x) = x
+whenInstalled _ = return ()
+
+skip :: Monad m => m ()
+skip = return ()
+
+noCheck :: Monad m => a () -> m (MaybeExe a)
+noCheck = return . Installed
+
 --------------------------------------------------------------------------------
 -- | Opening subshell
 
@@ -31,8 +77,12 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
 soundDir :: FilePath
 soundDir = "sound"
 
-spawnSound :: MonadIO m => FilePath -> m ()
+spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
-spawnSound file = do
+spawnSound file pre post = runIfInstalled ["paplay"]
+  $ pre >> playSound file >> post
+
+playSound :: MonadIO m => FilePath -> m ()
+playSound file = do
   path <- (</> soundDir </> file) <$> getXMonadDir
   -- paplay seems to have less latency than aplay
   spawnCmd "paplay" [path]