Fix GHCi completion (#20101)

Updates haskeline submodule

7 files changed, 38 insertions, 17 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d1e49dadd3..3bd7f0820c 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -278,6 +278,10 @@ ghciCommands = map mkCmd [
 word_break_chars :: String
 word_break_chars = spaces ++ specials ++ symbols
 
+word_break_chars_pred :: Char -> Bool
+word_break_chars_pred '.' = False
+word_break_chars_pred c = c `elem` (spaces ++ specials) || isSymbolChar c
+
 symbols, specials, spaces :: String
 symbols = "!#$%&*+/<=>?@\\^|-~"
 specials = "(),;[]`{}"
@@ -3525,16 +3529,10 @@ completeIdentifier line@(left, _) =
   case left of
     ('.':_)  -> wrapCompleter (specials ++ spaces) complete line
                -- operator or qualification
-    (x:_) | isSymbolChar x -> wrapCompleter (specials ++ spaces)
-                                 complete (takeOpChars line)         -- operator
-    _                      -> wrapIdentCompleter complete (takeIdentChars line)
+    (x:_) | isSymbolChar x -> wrapCompleter' (\c -> c `elem` (specials ++ spaces) || not (isSymbolChar c))
+                                 complete line         -- operator
+    _                      -> wrapIdentCompleter complete line
   where
-    takeOpChars (l, r) = (takeWhile isSymbolChar l, r)               -- #10576
-       -- An operator contains only symbol characters
-    takeIdentChars (l, r) = (takeWhile notOpChar l, r)
-       -- An identifier doesn't contain symbol characters with the
-       -- exception of a dot
-    notOpChar c = (not .isSymbol ) c || c == '.'
     complete w = do
       rdrs <- GHC.getRdrNamesInScope
       dflags <- GHC.getSessionDynFlags
@@ -3610,7 +3608,7 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do          -- #3000
             bids = nub $ declPath <$> ident_decls
         pure $ map (combineModIdent mod_str) bids
 
-completeModule = wrapIdentCompleter $ \w -> do
+completeModule = wrapIdentCompleterMod $ \w -> do
   hsc_env <- GHC.getSession
   let pkg_mods = allVisibleModules (hsc_units hsc_env)
   loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
@@ -3629,7 +3627,7 @@ completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
       return $ loaded_mods ++ pkg_mods
   return $ filter (w `isPrefixOf`) $ map (showPpr (hsc_dflags hsc_env)) modules
 
-completeHomeModule = wrapIdentCompleter listHomeModules
+completeHomeModule = wrapIdentCompleterMod listHomeModules
 
 listHomeModules :: GHC.GhcMonad m => String -> m [String]
 listHomeModules w = do
@@ -3669,11 +3667,20 @@ unionComplete f1 f2 line = do
   return (cs1 ++ cs2)
 
 wrapCompleter :: Monad m => String -> (String -> m [String]) -> CompletionFunc m
-wrapCompleter breakChars fun = completeWord Nothing breakChars
+wrapCompleter breakChars = wrapCompleter' (`elem` breakChars)
+
+wrapCompleter' :: Monad m => (Char -> Bool) -> (String -> m [String]) -> CompletionFunc m
+wrapCompleter' breakPred fun = completeWord' Nothing breakPred
     $ fmap (map simpleCompletion . nubSort) . fun
 
 wrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m
-wrapIdentCompleter = wrapCompleter word_break_chars
+wrapIdentCompleter = wrapCompleter' word_break_chars_pred
+
+wrapIdentCompleterMod :: Monad m => (String -> m [String]) -> CompletionFunc m
+wrapIdentCompleterMod = wrapCompleter' go
+  where
+    go '.' = False -- Treated specially since it is a seperator for module qualifiers
+    go c = word_break_chars_pred c
 
 wrapIdentCompleterWithModifier
   :: Monad m
diff --git a/libraries/haskeline b/libraries/haskeline
-Subproject c03e7029b2d9c3d16da5480306b42b8d4ebe03c
+Subproject 2a5d9451ab7a0602b604a4bf0b9f950e913b865
diff --git a/testsuite/tests/ghci/scripts/T10576a.stdout b/testsuite/tests/ghci/scripts/T10576a.stdout
index 1069c6ac77..db5ac98b93 100644
--- a/testsuite/tests/ghci/scripts/T10576a.stdout
+++ b/testsuite/tests/ghci/scripts/T10576a.stdout
@@ -1,2 +1,2 @@
-1 1 ""
-"\9728\9728"
\ No newline at end of file
+1 1 "x1"
+"\9728\9728"
diff --git a/testsuite/tests/ghci/scripts/T10576b.stdout b/testsuite/tests/ghci/scripts/T10576b.stdout
index 5a000606dc..23ea0cab6c 100644
--- a/testsuite/tests/ghci/scripts/T10576b.stdout
+++ b/testsuite/tests/ghci/scripts/T10576b.stdout
@@ -1,3 +1,3 @@
-2 2 ""
+2 2 "x1\9728\9728"
 "x1"
-"x2"
\ No newline at end of file
+"x2"
diff --git a/testsuite/tests/ghci/scripts/T20101.script b/testsuite/tests/ghci/scripts/T20101.script
new file mode 100644
index 0000000000..5328f96507
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T20101.script
@@ -0,0 +1,4 @@
+:complete repl "let x = y++b"
+:complete repl "let x = y+"
+:complete repl "let x = y ++"
+:complete repl "let x = b"
diff --git a/testsuite/tests/ghci/scripts/T20101.stdout b/testsuite/tests/ghci/scripts/T20101.stdout
new file mode 100644
index 0000000000..6fc1442275
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T20101.stdout
@@ -0,0 +1,9 @@
+1 1 "let x = y++"
+"break"
+2 2 "let x = y"
+"+"
+"++"
+1 1 "let x = y "
+"++"
+1 1 "let x = "
+"break"
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 3856dde227..b75ac178a9 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -343,3 +343,4 @@ test('T19650',
      ghci_script,
      ['T19650.script'])
 test('T20019', normal, ghci_script, ['T20019.script'])
+test('T20101', normal, ghci_script, ['T20101.script'])