Use bracket pattern in XMonad.Prompt

Also deduplicates some code shared by mkXPromptWithReturn and
mkXPromptWithModes.

CHANGES.md

@@ -13,6 +13,10 @@
     Added `sorter` to `XPConfig` used to sort the possible completions by how
     well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).
 
+    Fixes a potential bug where an error during prompt execution would
+    leave the window open and keep the keyboard grabbed. See issue
+    [#180](https://github.com/xmonad/xmonad-contrib/issues/180).
+
 ## 0.15
 
 ### Breaking Changes

XMonad/Prompt.hs

@@ -361,40 +361,18 @@ getInput = gets command
 --   module.
 mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a)
 mkXPromptWithReturn t conf compl action = do
-  XConf { display = d, theRoot = rw } <- ask
-  s    <- gets $ screenRect . W.screenDetail . W.current . windowset
-  hist <- io readHistory
-  w    <- io $ createWin d rw conf s
-  io $ selectInput d w $ exposureMask .|. keyPressMask
-  gc <- io $ createGC d w
-  io $ setGraphicsExposures d gc False
-  fs <- initXMF (font conf)
-  numlock <- gets $ X.numberlockMask
-  let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist
-      om = (XPSingleMode compl (XPT t)) --operation mode
-      st = initState d rw w s om gc fs hs conf numlock
-  st' <- io $ execStateT runXP st
-
-  releaseXMF fs
-  io $ freeGC d gc
-  if successful st' then do
-    let
-      prune = take (historySize conf)
-
-    io $ writeHistory $ M.insertWith
-      (\xs ys -> prune . historyFilter conf $ xs ++ ys)
-      (showXPrompt t)
-      (prune $ historyFilter conf [command st'])
-      hist
-                                -- we need to apply historyFilter before as well, since
-                                -- otherwise the filter would not be applied if
-                                -- there is no history
-      --When alwaysHighlight is True, autocompletion is handled with indexes.
-      --When it is false, it is handled depending on the prompt buffer's value
-    let selectedCompletion = case alwaysHighlight (config st') of
-          False -> command st'
-          True -> fromMaybe (command st') $ highlightedCompl st'
-    Just <$> action selectedCompletion
+  st' <- mkXPromptImplementation (showXPrompt t) conf (XPSingleMode compl (XPT t))
+  if successful st'
+    then do
+      let selectedCompletion =
+            case alwaysHighlight (config st') of
+              -- When alwaysHighlight is True, autocompletion is
+              -- handled with indexes.
+              False -> command st'
+              -- When it is false, it is handled depending on the
+              -- prompt buffer's value.
+              True -> fromMaybe (command st') $ highlightedCompl st'
+      Just <$> action selectedCompletion
     else return Nothing
 
 -- | Creates a prompt given:
@@ -422,59 +400,74 @@ mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> retur
 -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.
 mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
 mkXPromptWithModes modes conf = do
+  let defaultMode = head modes
+      modeStack = W.Stack { W.focus = defaultMode -- Current mode
+                          , W.up = []
+                          , W.down = tail modes -- Other modes
+                          }
+      om = XPMultipleModes modeStack
+  st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om
+  if successful st'
+    then do
+      case operationMode st' of
+        XPMultipleModes ms -> let
+          action = modeAction $ W.focus ms
+          in action (command st') $ (fromMaybe "" $ highlightedCompl st')
+        _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode
+    else return ()
+
+-- Internal function used to implement 'mkXPromptWithReturn' and
+-- 'mkXPromptWithModes'.
+mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
+mkXPromptImplementation historyKey conf om = do
   XConf { display = d, theRoot = rw } <- ask
-  s    <- gets $ screenRect . W.screenDetail . W.current . windowset
+  s <- gets $ screenRect . W.screenDetail . W.current . windowset
+  numlock <- gets X.numberlockMask
   hist <- io readHistory
-  w    <- io $ createWin d rw conf s
-  io $ selectInput d w $ exposureMask .|. keyPressMask
-  gc <- io $ createGC d w
-  io $ setGraphicsExposures d gc False
   fs <- initXMF (font conf)
-  numlock <- gets $ X.numberlockMask
-  let
-    defaultMode = head modes
-    hs = fromMaybe [] $ M.lookup (showXPrompt defaultMode) hist
-    modeStack = W.Stack{ W.focus = defaultMode --current mode
-                       , W.up = []
-                       , W.down = tail modes --other modes
-                       }
-    st = initState d rw w s (XPMultipleModes modeStack) gc fs hs conf { alwaysHighlight = True} numlock
-  st' <- io $ execStateT runXP st
-
+  st' <- io $
+    bracket
+      (createWin d rw conf s)
+      (destroyWindow d)
+      (\w ->
+        bracket
+          (createGC d w)
+          (freeGC d)
+          (\gc -> do
+            selectInput d w $ exposureMask .|. keyPressMask
+            setGraphicsExposures d gc False
+            let hs = fromMaybe [] $ M.lookup historyKey hist
+                st = initState d rw w s om gc fs hs conf numlock
+            runXP st))
   releaseXMF fs
-  io $ freeGC d gc
-
-  if successful st' then do
-    let
-      prune = take (historySize conf)
-
-      -- insert into history the buffers value
-    io $ writeHistory $ M.insertWith
+  when (successful st') $ do
+    let prune = take (historySize conf)
+    io $ writeHistory $
+      M.insertWith
       (\xs ys -> prune . historyFilter conf $ xs ++ ys)
-      (showXPrompt defaultMode)
+      historyKey
+      -- We need to apply historyFilter before as well, since
+      -- otherwise the filter would not be applied if there is no
+      -- history
       (prune $ historyFilter conf [command st'])
       hist
+  return st'
 
-    case operationMode st' of
-      XPMultipleModes ms -> let
-        action = modeAction $ W.focus ms
-        in action (command st') $ (fromMaybe "" $ highlightedCompl st')
-      _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode
-    else
-      return ()
-
-
-runXP :: XP ()
-runXP = do
-  (d,w) <- gets (dpy &&& win)
-  status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime
-  when (status == grabSuccess) $ do
+runXP :: XPState -> IO XPState
+runXP st = do
+  let d = dpy st
+      w = win st
+  st' <- bracket
+    (grabKeyboard d w True grabModeAsync grabModeAsync currentTime)
+    (\_ -> ungrabKeyboard d currentTime)
+    (\status ->
+      flip execStateT st $ do
+        when (status == grabSuccess) $ do
           updateWindows
           eventLoop handle
-          io $ ungrabKeyboard d currentTime
-  io $ destroyWindow d w
-  destroyComplWin
-  io $ sync d False
+        destroyComplWin)
+  sync d False
+  return st'
 
 type KeyStroke = (KeySym, String)