ENH inform user if keymap can't be displayed

lib/XMonad/Internal/Command/DMenu.hs

@@ -21,6 +21,7 @@ import           System.Directory         (XdgDirectory (..), getXdgDirectory)
 import           System.IO
 
 import           XMonad.Core              hiding (spawn)
+import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import           XMonad.Util.NamedActions
@@ -73,12 +74,19 @@ runBwMenu :: IO MaybeX
 runBwMenu = runIfInstalled [Required 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 }
+  s <- io $ runDMenuShowKeys x
-  io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
+  ifInstalled s
-  where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
+    $ spawnNotify
+    $ defNoteError { body = Just $ Text "could not display keymap" }
+
+runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> IO MaybeX
+runDMenuShowKeys kbs = runIfInstalled [Required myDmenuCmd] $ io $ do
+  (h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
+  forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
+  where
+    cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
       ++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
 
 runCmdMenu :: IO MaybeX

lib/XMonad/Internal/Notify.hs

@@ -13,8 +13,10 @@ module XMonad.Internal.Notify
   , defNoteInfo
   , defNoteError
   , fmtNotifyCmd
+  , spawnNotify
   ) where
 
+import           Control.Monad.IO.Class
 import           Data.Maybe
 
 import           DBus.Notify
@@ -43,13 +45,16 @@ parseBody (Text s) = Just s
 parseBody _        = Nothing
 
 fmtNotifyCmd :: Note -> String
-fmtNotifyCmd note =
+fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
-  fmtCmd "notify-send" $ getIcon note
+
-    ++ getSummary note
+spawnNotify :: MonadIO m => Note -> m ()
-    ++ getBody note
+spawnNotify = spawnCmd "notify-send" . fmtNotifyArgs
+
+fmtNotifyArgs :: Note -> [String]
+fmtNotifyArgs n = getIcon n ++ getSummary n ++ getBody n
   where
     -- TODO add the rest of the options as needed
     getSummary = (:[]) . doubleQuote . summary
-    getIcon n = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
+    getIcon n' = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
-      $ appImage n
+      $ appImage n'
-    getBody n = maybeToList $ (fmap doubleQuote . parseBody) =<< body n
+    getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'

lib/XMonad/Internal/Shell.hs

@@ -9,6 +9,7 @@ module XMonad.Internal.Shell
   , runIfInstalled
   , warnMissing
   , whenInstalled
+  , ifInstalled
   , spawnIfInstalled
   , spawnCmdIfInstalled
   , noCheck
@@ -78,8 +79,11 @@ spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
 spawnCmdIfInstalled exe args = runIfInstalled [Required exe] $ spawnCmd exe args
 
 whenInstalled :: Monad m => MaybeExe m -> m ()
-whenInstalled (Installed x _) = x
+whenInstalled = flip ifInstalled skip
-whenInstalled _               = return ()
+
+ifInstalled ::  Monad m => MaybeExe m -> m () -> m ()
+ifInstalled (Installed x _) _ = x
+ifInstalled _ alt             = alt
 
 skip :: Monad m => m ()
 skip = return ()