Allow command name resolution for GHCi commands with option `!` #17345

This commit allows command name resolution for GHCi commands
with option `!` as follows:

    ghci> :k! Int
    Int :: *
    = Int

This commit changes implementation as follows:

Before:
  * Prefix match with full string including the option `!` (e.g. `k!`)

After (this patch):
  * Prefix match without option suffix `!` (e.g. `k`)
  * in addition, suffix match with option `!`

See also #8305 and #8113

4 files changed, 26 insertions, 5 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 0d047de510..e2f51be65f 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -102,8 +102,8 @@ import qualified Data.ByteString.Char8 as BS
 import Data.Char
 import Data.Function
 import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
-import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
-                   partition, sort, sortBy, (\\) )
+import Data.List ( find, group, intercalate, intersperse, isPrefixOf,
+                   isSuffixOf, nub, partition, sort, sortBy, (\\) )
 import qualified Data.Set as S
 import Data.Maybe
 import Data.Map (Map)
@@ -1387,8 +1387,8 @@ lookupCommand' str' = do
           ':' : rest -> (rest, [])     -- "::" selects a builtin command
           _          -> (str', macros) -- otherwise include macros in lookup
 
-      lookupExact  s = find $ (s ==)           . cmdName
-      lookupPrefix s = find $ (s `isPrefixOf`) . cmdName
+      lookupExact  s = find $ (s ==)              . cmdName
+      lookupPrefix s = find $ (s `isPrefixOptOf`) . cmdName
 
       -- hidden commands can only be matched exact
       builtinPfxMatch = lookupPrefix str ghci_cmds_nohide
@@ -1402,6 +1402,15 @@ lookupCommand' str' = do
            builtinPfxMatch <|>
            lookupPrefix str xcmds
 
+-- This predicate is for prefix match with a command-body and
+-- suffix match with an option, such as `!`.
+-- The current implementation assumes only the `!` character
+-- as the option delimiter.
+-- See also #17345
+isPrefixOptOf :: String -> String -> Bool
+isPrefixOptOf s x = let (body, opt) = break (== '!') s
+                    in  (body `isPrefixOf` x) && (opt `isSuffixOf` x)
+
 getCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)
 getCurrentBreakSpan = do
   resumes <- GHC.getResumeContext
@@ -3329,7 +3338,7 @@ completeGhciCommand = wrapCompleter " " $ \w -> do
   let{ candidates = case w of
       ':' : ':' : _ -> map (':':) command_names
       _ -> nub $ macro_names ++ command_names }
-  return $ filter (w `isPrefixOf`) candidates
+  return $ filter (w `isPrefixOptOf`) candidates
 
 completeMacro = wrapIdentCompleter $ \w -> do
   cmds <- ghci_macros <$> getGHCiState
diff --git a/testsuite/tests/ghci/scripts/T17345.script b/testsuite/tests/ghci/scripts/T17345.script
new file mode 100644
index 0000000000..076e8153fd
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T17345.script
@@ -0,0 +1,8 @@
+-- Testing command name resolution with option (`!`)
+
+-- builtin command
+:k! ()
+
+-- macro command
+:def! kind! (\e -> putStrLn "called :kind! macro" >> return "")
+:k! ()
diff --git a/testsuite/tests/ghci/scripts/T17345.stdout b/testsuite/tests/ghci/scripts/T17345.stdout
new file mode 100644
index 0000000000..49d6aca306
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T17345.stdout
@@ -0,0 +1,3 @@
+() :: *
+= ()
+called :kind! macro
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index aaefca532e..96c63149fb 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -311,3 +311,4 @@ test('T16509', normal, ghci_script, ['T16509.script'])
 test('T16804', extra_files(['T16804a.hs', 'T16804b.hs', 'T16804c.hs']), ghci_script, ['T16804.script'])
 test('T15546', normal, ghci_script, ['T15546.script'])
 test('T16876', normal, ghci_script, ['T16876.script'])
+test('T17345', normal, ghci_script, ['T17345.script'])