From 6620616b7befb9158ecf7b862df9c92cc94c8d21 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 20 Jun 2021 13:55:31 -0400
Subject: [PATCH] ENH inform user if keymap can't be displayed

---
 lib/XMonad/Internal/Command/DMenu.hs | 18 +++++++++++++-----
 lib/XMonad/Internal/Notify.hs        | 19 ++++++++++++-------
 lib/XMonad/Internal/Shell.hs         |  8 ++++++--
 3 files changed, 31 insertions(+), 14 deletions(-)

diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs
index fc8f91a..9a778dd 100644
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/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,13 +74,20 @@ 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 }
-  io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
-  where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
-          ++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
+  s <- io $ runDMenuShowKeys x
+  ifInstalled s
+    $ 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
 runCmdMenu = spawnDmenuCmd ["-show", "run"]
diff --git a/lib/XMonad/Internal/Notify.hs b/lib/XMonad/Internal/Notify.hs
index 2f93df9..7e0bd2a 100644
--- a/lib/XMonad/Internal/Notify.hs
+++ b/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 =
-  fmtCmd "notify-send" $ getIcon note
-    ++ getSummary note
-    ++ getBody note
+fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
+
+spawnNotify :: MonadIO m => Note -> m ()
+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 }])
-      $ appImage n
-    getBody n = maybeToList $ (fmap doubleQuote . parseBody) =<< body n
+    getIcon n' = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
+      $ appImage n'
+    getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'
diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs
index 089f31c..79b3d02 100644
--- a/lib/XMonad/Internal/Shell.hs
+++ b/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 _               = return ()
+whenInstalled = flip ifInstalled skip
+
+ifInstalled ::  Monad m => MaybeExe m -> m () -> m ()
+ifInstalled (Installed x _) _ = x
+ifInstalled _ alt             = alt
 
 skip :: Monad m => m ()
 skip = return ()