For :info, return all matching Names, rather than complaining about ambiguity

This fixes Trac #9881, and gives more helpful output in the case of ambiguity.
Certainly more helpful than the positively-misleading error we get right now.

6 files changed, 100 insertions, 58 deletions

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index eeffe17dce..6aa21fa0ba 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -10,7 +10,7 @@ module RnEnv (
         newTopSrcBinder,
         lookupLocatedTopBndrRn, lookupTopBndrRn,
         lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
-        lookupLocalOccRn_maybe,
+        lookupLocalOccRn_maybe, lookupInfoOccRn,
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
         lookupGlobalOccRn, lookupGlobalOccRn_maybe,
@@ -75,6 +75,7 @@ import FastString
 import Control.Monad
 import Data.List
 import qualified Data.Set as Set
+import ListSetOps       ( minusList )
 import Constants        ( mAX_TUPLE_SIZE )
 
 {-
@@ -763,10 +764,12 @@ lookupOccRn_maybe rdr_name
        ; case mb_name of {
                 Just name  -> return (Just name) ;
                 Nothing -> do
-       { dflags  <- getDynFlags
-       ; is_ghci <- getIsGHCi   -- This test is not expensive,
-                                -- and only happens for failed lookups
-       ; lookupQualifiedNameGHCi dflags is_ghci rdr_name } } } } }
+       { ns <- lookupQualifiedNameGHCi rdr_name
+                      -- This test is not expensive,
+                      -- and only happens for failed lookups
+       ; case ns of
+           (n:_) -> return (Just n)  -- Unlikely to be more than one...?
+           []    -> return Nothing } } } } }
 
 lookupGlobalOccRn :: RdrName -> RnM Name
 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
@@ -778,6 +781,25 @@ lookupGlobalOccRn rdr_name
            Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name)
                          ; unboundName WL_Global rdr_name } }
 
+lookupInfoOccRn :: RdrName -> RnM [Name]
+-- lookupInfoOccRn is intended for use in GHCi's ":info" command
+-- It finds all the GREs that RdrName could mean, not complaining
+-- about ambiguity, but rather returning them all
+-- C.f. Trac #9881
+lookupInfoOccRn rdr_name
+  | Just n <- isExact_maybe rdr_name   -- e.g. (->)
+  = return [n]
+
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+  = do { n <- lookupOrig rdr_mod rdr_occ
+       ; return [n] }
+
+  | otherwise
+  = do { rdr_env <- getGlobalRdrEnv
+       ; let ns = map gre_name (lookupGRE_RdrName rdr_name rdr_env)
+       ; qual_ns <- lookupQualifiedNameGHCi rdr_name
+       ; return (ns ++ (qual_ns `minusList` ns)) }
+
 lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
 -- No filter function; does not report an error on failure
 
@@ -957,32 +979,37 @@ and should instead check the qualified import but at the moment
 this requires some refactoring so leave as a TODO
 -}
 
-lookupQualifiedNameGHCi :: DynFlags -> Bool -> RdrName -> RnM (Maybe Name)
-lookupQualifiedNameGHCi dflags is_ghci rdr_name
-  | Just (mod,occ) <- isQual_maybe rdr_name
-  , is_ghci
-  , gopt Opt_ImplicitImportQualified dflags   -- Enables this GHCi behaviour
-  , not (safeDirectImpsReq dflags)            -- See Note [Safe Haskell and GHCi]
+lookupQualifiedNameGHCi :: RdrName -> RnM [Name]
+lookupQualifiedNameGHCi rdr_name
   = -- We want to behave as we would for a source file import here,
     -- and respect hiddenness of modules/packages, hence loadSrcInterface.
-    do { res <- loadSrcInterface_maybe doc mod False Nothing
-       ; case res of
-           Succeeded ifaces
-             | (n:ns) <- [ name
-                         | iface <- ifaces
-                         , avail <- mi_exports iface
-                         , name  <- availNames avail
-                         , nameOccName name == occ ]
-             -> ASSERT(all (==n) ns) return (Just n)
-
-           _ -> -- Either we couldn't load the interface, or
-                -- we could but we didn't find the name in it
-                do { traceRn (text "lookupQualifiedNameGHCi" <+> ppr rdr_name)
-                   ; return Nothing } }
+    do { dflags  <- getDynFlags
+       ; is_ghci <- getIsGHCi
+       ; go_for_it dflags is_ghci }
 
-  | otherwise
-  = return Nothing
   where
+    go_for_it dflags is_ghci
+      | Just (mod,occ) <- isQual_maybe rdr_name
+      , is_ghci
+      , gopt Opt_ImplicitImportQualified dflags   -- Enables this GHCi behaviour
+      , not (safeDirectImpsReq dflags)            -- See Note [Safe Haskell and GHCi]
+      = do { res <- loadSrcInterface_maybe doc mod False Nothing
+           ; case res of
+                Succeeded ifaces
+                  -> return [ name
+                            | iface <- ifaces
+                            , avail <- mi_exports iface
+                            , name  <- availNames avail
+                            , nameOccName name == occ ]
+
+                _ -> -- Either we couldn't load the interface, or
+                     -- we could but we didn't find the name in it
+                     do { traceRn (text "lookupQualifiedNameGHCi" <+> ppr rdr_name)
+                        ; return [] } }
+
+      | otherwise
+      = return []
+
     doc = ptext (sLit "Need to find") <+> ppr rdr_name
 
 {-
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 47fdd3a8a3..b4644007b8 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1892,38 +1892,17 @@ getModuleInterface hsc_env mod
     loadModuleInterface (ptext (sLit "getModuleInterface")) mod
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
+-- ^ Find all the Names that this RdrName could mean, in GHCi
 tcRnLookupRdrName hsc_env rdr_name
   = runTcInteractive hsc_env $
-    lookup_rdr_name rdr_name
-
-lookup_rdr_name :: RdrName -> TcM [Name]
-lookup_rdr_name rdr_name = do
-        -- If the identifier is a constructor (begins with an
-        -- upper-case letter), then we need to consider both
-        -- constructor and type class identifiers.
-    let rdr_names = dataTcOccs rdr_name
-
-        -- results :: [Either Messages Name]
-    results <- mapM (tryTcErrs . lookupOccRn) rdr_names
-
-    traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)])
-        -- The successful lookups will be (Just name)
-    let (warns_s, good_names) = unzip [ (msgs, name)
-                                      | (msgs, Just name) <- results]
-        errs_s = [msgs | (msgs, Nothing) <- results]
-
-        -- Fail if nothing good happened, else add warnings
-    if null good_names
-      then  addMessages (head errs_s) >> failM
-                -- No lookup succeeded, so
-                -- pick the first error message and report it
-                -- ToDo: If one of the errors is "could be Foo.X or Baz.X",
-                --       while the other is "X is not in scope",
-                --       we definitely want the former; but we might pick the latter
-      else      mapM_ addMessages warns_s
-                -- Add deprecation warnings
-    return good_names
-
+    do {   -- If the identifier is a constructor (begins with an
+           -- upper-case letter), then we need to consider both
+           -- constructor and type class identifiers.
+         let rdr_names = dataTcOccs rdr_name
+       ; names_s <- mapM lookupInfoOccRn rdr_names
+       ; let names = concat names_s
+       ; when (null names) (addErrTc (ptext (sLit "Not in scope:") <+> quotes (ppr rdr_name)))
+       ; return names }
 #endif
 
 tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
diff --git a/testsuite/tests/ghci.debugger/scripts/break019.stderr b/testsuite/tests/ghci.debugger/scripts/break019.stderr
index 36e9ac2327..d9675a8db4 100644
--- a/testsuite/tests/ghci.debugger/scripts/break019.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break019.stderr
@@ -1,2 +1,2 @@
 
-Top level: Not in scope: data constructor ‘Test2’
+Top level: Not in scope: ‘Test2’
diff --git a/testsuite/tests/ghci/scripts/T9881.script b/testsuite/tests/ghci/scripts/T9881.script
new file mode 100644
index 0000000000..30e1ef2489
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9881.script
@@ -0,0 +1,3 @@
+import Data.ByteString
+import Data.ByteString.Lazy
+:info ByteString
diff --git a/testsuite/tests/ghci/scripts/T9881.stdout b/testsuite/tests/ghci/scripts/T9881.stdout
new file mode 100644
index 0000000000..6866a6a79c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9881.stdout
@@ -0,0 +1,32 @@
+data Data.ByteString.Lazy.ByteString
+  = Data.ByteString.Lazy.Internal.Empty
+  | Data.ByteString.Lazy.Internal.Chunk {-# UNPACK #-}Data.ByteString.ByteString
+                                        Data.ByteString.Lazy.ByteString
+  	-- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Eq Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Ord Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Read Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Show Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Monoid Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
+
+data Data.ByteString.ByteString
+  = Data.ByteString.Internal.PS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr
+                                                 GHC.Word.Word8)
+                                {-# UNPACK #-}Int
+                                {-# UNPACK #-}Int
+  	-- Defined in ‘Data.ByteString.Internal’
+instance Eq Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
+instance Ord Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
+instance Read Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
+instance Show Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
+instance Monoid Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index a802027569..a78068a452 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -193,3 +193,4 @@ test('T9086b', normal, ghci_script, ['T9086b.script'])
 test('T9140', combined_output, ghci_script, ['T9140.script'])
 test('T9658', normal, ghci_script, ['T9658.script'])
 test('T9293', normal, ghci_script_without_flag('-fno-warn-tabs'), ['T9293.script'])
+test('T9881', normal, ghci_script, ['T9881.script'])
\ No newline at end of file