Refactoring: helper for mkXPromptWithReturn and mkXPromptWithModes

XMonad/Prompt.hs

@@ -471,40 +471,18 @@ getCurrentCompletions = gets currentCompletions
 --   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:
@@ -532,6 +510,26 @@ 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
   hist <- io readHistory
@@ -541,38 +539,25 @@ mkXPromptWithModes modes conf = do
   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
+  let hs = fromMaybe [] $ M.lookup historyKey hist
+      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)
-
-      -- 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
-
-    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 ()
-
+  return st'
 
 -- | Removes numlock and capslock from a keymask.
 -- Duplicate of cleanMask from core, but in the