Fix tab-completion for :break (#17989)

In tab-completion for the `:break` command, only those
identifiers should be shown, that are accepted in the
`:break` command. Hence these identifiers must be

- defined in an interpreted module
- top-level
- currently in scope
- listed in a `ModBreaks` value as a possible breakpoint.

The identifiers my be qualified or unqualified.

To get all possible top-level breakpoints for tab-completeion
with the correct qualification do:

1. Build the  list called `pifsBreaks` of all pairs of
(Identifier, module-filename) from the `ModBreaks` values.
Here all identifiers are unqualified.

2. Build the list called `pifInscope` of all pairs of
(Identifiers, module-filename) with identifiers from
the `GlobalRdrEnv`. Take only those identifiers that are
in scope and have the  correct prefix.
Here the identifiers may be qualified.

3. From the `pifInscope` list seclect all pairs that can be
found in the `pifsBreaks` list, by comparing only the
unqualified part of the identifier.
The remaining identifiers can be used for tab-completion.

This ensures, that we show only identifiers, that can be used
in a `:break` command.

8 files changed, 180 insertions, 10 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 2416fd9d9d..87826438e3 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -48,7 +48,7 @@ import qualified GHC
 import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
              TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
              GetDocsFailure(..),
-             getModuleGraph, handleSourceError )
+             getModuleGraph, handleSourceError, ms_mod )
 import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation)
 import GHC.Hs.ImpExp
 import GHC.Hs
@@ -100,8 +100,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,
-                   isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import Data.List ( elemIndices, find, group, intercalate, intersperse,
+                   isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
 import qualified Data.Set as S
 import Data.Maybe
 import Data.Map (Map)
@@ -173,7 +173,7 @@ ghciCommands = map mkCmd [
   ("?",         keepGoing help,                 noCompletion),
   ("add",       keepGoingPaths addModule,       completeFilename),
   ("abandon",   keepGoing abandonCmd,           noCompletion),
-  ("break",     keepGoing breakCmd,             completeIdentifier),
+  ("break",     keepGoing breakCmd,             completeBreakpoint),
   ("back",      keepGoing backCmd,              noCompletion),
   ("browse",    keepGoing' (browseCmd False),   completeModule),
   ("browse!",   keepGoing' (browseCmd True),    completeModule),
@@ -3300,7 +3300,7 @@ completeCmd argLine0 = case parseLine argLine0 of
 completeGhciCommand, completeMacro, completeIdentifier, completeModule,
     completeSetModule, completeSeti, completeShowiOptions,
     completeHomeModule, completeSetOptions, completeShowOptions,
-    completeHomeModuleOrFile, completeExpression
+    completeHomeModuleOrFile, completeExpression, completeBreakpoint
     :: GhciMonad m => CompletionFunc m
 
 -- | Provide completions for last word in a given string.
@@ -3356,6 +3356,68 @@ completeIdentifier line@(left, _) =
       dflags <- GHC.getSessionDynFlags
       return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
 
+
+completeBreakpoint = wrapCompleter spaces $ \w -> do          -- #17989
+    -- See Note [Tab-completion for :break]
+    -- Pif ~ Pair with Identifier name and File name
+    pifsBreaks <- pifsFromModBreaks
+    pifsInscope <- pifsInscopeByPrefix w
+    pure $ [n | (n,f) <- pifsInscope, (unQual n, f) `elem` pifsBreaks]
+  where
+    -- Extract from the ModBreaks data all the names of top-level
+    -- functions eligible to set breakpoints, and put them
+    -- into a pair together with the filename where they are defined.
+    pifsFromModBreaks :: GhciMonad m => m [(String, FastString)]
+    pifsFromModBreaks = do
+        graph <- GHC.getModuleGraph
+        imods <- filterM GHC.moduleIsInterpreted $
+                    ms_mod <$> GHC.mgModSummaries graph
+        topDecls <- mapM pifsFromModBreaksByModule imods
+        pure $ concat topDecls
+
+    -- Return all possible top-level pifs from the ModBreaks
+    -- for one module.
+    -- Identifiers of ModBreaks pifs are never qualified.
+    pifsFromModBreaksByModule :: GhciMonad m => Module -> m [(String, FastString)]
+    pifsFromModBreaksByModule mod = do
+        (_, locs, decls) <- getModBreak mod
+        let mbFile  = safeHead $ mapMaybe srcSpanFileName_maybe $ elems locs
+        -- The first element in `decls` is the name of the top-level function.
+        let topLvlDecls = nub $ mapMaybe safeHead $ elems decls
+        pure $ case mbFile of
+          Nothing  -> []
+          (Just file) -> zip  topLvlDecls $ repeat file
+      where
+        safeHead []      = Nothing
+        safeHead (h : _) = Just h
+
+    -- Return the pifs of all identifieres (RdrNames) in scope, where
+    -- the identifier has the given prefix.
+    -- Identifiers of inscope pifs maybe qualified.
+    pifsInscopeByPrefix :: GhciMonad m => String -> m [(String, FastString)]
+    pifsInscopeByPrefix pref = do
+        dflags <- GHC.getSessionDynFlags
+        rdrs <- GHC.getRdrNamesInScope
+        let strnams = (filter (pref `isPrefixOf`) (map (showPpr dflags) rdrs))
+        nams_fil <- mapM createInscopePif strnams
+        pure $ concat nams_fil
+
+    -- Return a list of pifs for a single in scope identifier
+    createInscopePif :: GhciMonad m => String -> m [(String, FastString)]
+    createInscopePif str_rdr = do
+        names <- GHC.parseName str_rdr
+        let files = mapMaybe srcSpanFileName_maybe $ map nameSrcSpan names
+        pure $ zip (repeat str_rdr) files
+
+    -- unQual "ModLev.Module.func"   ->   "func"
+    unQual :: String -> String
+    unQual qual_unqual =
+      let ixs = elemIndices '.' qual_unqual
+      in  case ixs of
+          [] -> qual_unqual
+          _  -> drop (1 + last ixs) qual_unqual
+
+
 completeModule = wrapIdentCompleter $ \w -> do
   dflags <- GHC.getSessionDynFlags
   let pkg_mods = allVisibleModules dflags
@@ -3437,6 +3499,41 @@ allVisibleModules dflags = listVisibleModuleNames dflags
 completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
                         completeIdentifier
 
+{-
+Note [Tab-completion for :break]
+--------------------------------
+In tab-completion for the `:break` command, only those
+identifiers should be shown, that are accepted in the
+`:break` command. Hence these identifiers must be
+
+- defined in an interpreted module
+- top-level
+- currently in scope
+- listed in a `ModBreaks` value as a possible breakpoint.
+
+The identifiers may be qualified or unqualified.
+
+To get all possible top-level breakpoints for tab-completeion
+with the correct qualification do:
+
+1. Build the  list called `pifsBreaks` of all pairs of
+(Identifier, module-filename) from the `ModBreaks` values.
+Here all identifiers are unqualified.
+
+2. Build the list called `pifInscope` of all pairs of
+(Identifiers, module-filename) with identifiers from
+the `GlobalRdrEnv`. Take only those identifiers that are
+in scope and have the  correct prefix.
+Here the identifiers may be qualified.
+
+3. From the `pifInscope` list seclect all pairs that can be
+found in the `pifsBreaks` list, by comparing only the
+unqualified part of the identifier.
+The remaining identifiers can be used for tab-completion.
+
+This ensures, that we show only identifiers, that can be used
+in a `:break` command.
+-}
 
 -- -----------------------------------------------------------------------------
 -- commands for debugger
@@ -3703,7 +3800,7 @@ findBreakAndSet :: GhciMonad m
                 => Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
 findBreakAndSet md lookupTickTree = do
    tickArray <- getTickArray md
-   (breakArray, _) <- getModBreak md
+   (breakArray, _, _) <- getModBreak md
    case lookupTickTree tickArray of
       []  -> liftIO $ putStrLn $ "No breakpoints found at that location."
       some -> mapM_ (breakAt breakArray) some
@@ -3962,7 +4059,7 @@ getTickArray modl = do
    case lookupModuleEnv arrmap modl of
       Just arr -> return arr
       Nothing  -> do
-        (_breakArray, ticks) <- getModBreak modl
+        (_breakArray, ticks, _) <- getModBreak modl
         let arr = mkTickArray (assocs ticks)
         setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
         return arr
@@ -4001,19 +4098,20 @@ turnBreakOnOff :: GHC.GhcMonad m => Bool -> BreakLocation -> m BreakLocation
 turnBreakOnOff onOff loc
   | onOff == breakEnabled loc = return loc
   | otherwise = do
-      (arr, _) <- getModBreak (breakModule loc)
+      (arr, _, _) <- getModBreak (breakModule loc)
       hsc_env <- GHC.getSession
       liftIO $ enableBreakpoint hsc_env arr (breakTick loc) onOff
       return loc { breakEnabled = onOff }
 
 getModBreak :: GHC.GhcMonad m
-            => Module -> m (ForeignRef BreakArray, Array Int SrcSpan)
+            => Module -> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [String])
 getModBreak m = do
    mod_info      <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
    let modBreaks  = GHC.modInfoModBreaks mod_info
    let arr        = GHC.modBreaks_flags modBreaks
    let ticks      = GHC.modBreaks_locs  modBreaks
-   return (arr, ticks)
+   let decls      = GHC.modBreaks_decls modBreaks
+   return (arr, ticks, decls)
 
 setBreakFlag :: GHC.GhcMonad m => Bool -> ForeignRef BreakArray -> Int -> m ()
 setBreakFlag toggle arr i = do
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989.script b/testsuite/tests/ghci.debugger/scripts/T17989.script
new file mode 100644
index 0000000000..86f3f70e93
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989.script
@@ -0,0 +1,12 @@
+:l T17989M
+:complete repl ":break "
+-- all listed names are really breakpoints
+:break B.bar
+:break B.foo
+:break T17989A.bar
+:break T17989A.foo
+:break T17989C.foo
+:break foo
+:break main
+:complete repl ":break B."
+:complete repl ":break f"
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989.stdout b/testsuite/tests/ghci.debugger/scripts/T17989.stdout
new file mode 100644
index 0000000000..ce658ace22
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989.stdout
@@ -0,0 +1,20 @@
+7 7 ":break "
+"B.bar"
+"B.foo"
+"T17989A.bar"
+"T17989A.foo"
+"T17989C.foo"
+"foo"
+"main"
+Breakpoint 0 activated at T17989B.hs:10:9-25
+Breakpoint 1 activated at T17989B.hs:7:6-11
+Breakpoint 2 activated at T17989A.hs:10:7-13
+Breakpoint 3 activated at T17989A.hs:4:9-14
+Breakpoint 4 activated at T17989C.hs:4:9-26
+Breakpoint 4 was already set at T17989C.hs:4:9-26
+Breakpoint 5 activated at T17989M.hs:6:8-51
+2 2 ":break "
+"B.bar"
+"B.foo"
+1 1 ":break "
+"foo"
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989A.hs b/testsuite/tests/ghci.debugger/scripts/T17989A.hs
new file mode 100644
index 0000000000..32dfef5e85
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989A.hs
@@ -0,0 +1,13 @@
+module T17989A (foo, bar) where
+
+foo :: Int -> String
+foo n = x <> y
+  where
+    x = "A.foo-"
+    y = priv n
+
+bar :: String
+bar = "A.bar"
+
+priv :: Int -> String
+priv n = "A.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989B.hs b/testsuite/tests/ghci.debugger/scripts/T17989B.hs
new file mode 100644
index 0000000000..e48067f936
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989B.hs
@@ -0,0 +1,13 @@
+module T17989B (foo, bar) where
+
+foo :: Int -> String
+foo n =
+  let x = "B.foo-"
+      y = priv n
+  in x <> y
+
+bar :: Int -> String
+bar n = "B.bar" <> show n
+
+priv :: Int -> String
+priv n = "B.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989C.hs b/testsuite/tests/ghci.debugger/scripts/T17989C.hs
new file mode 100644
index 0000000000..c53471e14d
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989C.hs
@@ -0,0 +1,7 @@
+module T17989C (foo) where
+
+foo :: Int -> String
+foo n = "C.foo-" <> priv n
+
+priv :: Int -> String
+priv n = "C.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989M.hs b/testsuite/tests/ghci.debugger/scripts/T17989M.hs
new file mode 100644
index 0000000000..c6d77072c2
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989M.hs
@@ -0,0 +1,6 @@
+import qualified T17989A
+import qualified T17989B as B
+import           T17989C
+
+main :: IO ()
+main = putStrLn (T17989A.foo 3 <> B.foo 5 <> foo 7)
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index db597a455f..12fe420363 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -125,3 +125,4 @@ test('T16700', normal, ghci_script, ['T16700.script'])
 
 test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
 test('T2215', normal, ghci_script, ['T2215.script'])
+test('T17989', normal, ghci_script, ['T17989.script'])