[commit: ghc] master: Give a hint when a TH splice has a bad package key, partially fixes #10279 (bf4f3e6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/bf4f3e653407d02593a69618fb199b2e2d529c92/ghc

>---------------------------------------------------------------

commit bf4f3e653407d02593a69618fb199b2e2d529c92
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Mon Apr 20 14:02:36 2015 -0700

    Give a hint when a TH splice has a bad package key, partially fixes #10279
    
    Previously, if we got a package key in our splice, we'd give
    a very unhelpful error message saying we couldn't find
    a package 'base-4.7.0.1', despite there being a package with
    that source package ID.  Really, we couldn't find a package with
    that *key*, so clarify, and also tell the user what the real
    package key is.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>


>---------------------------------------------------------------

bf4f3e653407d02593a69618fb199b2e2d529c92
 compiler/main/Finder.hs          | 16 ++++++++++++++--
 testsuite/tests/th/T10279.hs     | 10 ++++++++++
 testsuite/tests/th/T10279.stderr |  8 ++++++++
 testsuite/tests/th/all.T         |  1 +
 4 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index ac17fd2..d8aef57 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -577,8 +577,8 @@ cantFindErr cannot_find _ dflags mod_name find_result
     more_info
       = case find_result of
             NoPackage pkg
-                -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
-                   ptext (sLit "was found")
+                -> ptext (sLit "no package key matching") <+> quotes (ppr pkg) <+>
+                   ptext (sLit "was found") $$ looks_like_srcpkgid pkg
 
             NotFound { fr_paths = files, fr_pkg = mb_pkg
                      , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
@@ -640,6 +640,18 @@ cantFindErr cannot_find _ dflags mod_name find_result
               ptext (sLit "to the build-depends in your .cabal file.")
      | otherwise = Outputable.empty
 
+    looks_like_srcpkgid :: PackageKey -> SDoc
+    looks_like_srcpkgid pk
+     -- Unsafely coerce a package key FastString into a source package ID
+     -- FastString and see if it means anything.
+     | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (packageKeyFS pk))
+     = parens (text "This package key looks like the source package ID;" $$
+       text "the real package key is" <+> quotes (ftext (packageKeyFS (packageKey pkg))) $$
+       (if null pkgs then Outputable.empty
+        else text "and" <+> int (length pkgs) <+> text "other candidates"))
+     -- Todo: also check if it looks like a package name!
+     | otherwise = Outputable.empty
+
     mod_hidden pkg =
         ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
 
diff --git a/testsuite/tests/th/T10279.hs b/testsuite/tests/th/T10279.hs
new file mode 100644
index 0000000..fbc2dbb
--- /dev/null
+++ b/testsuite/tests/th/T10279.hs
@@ -0,0 +1,10 @@
+module T10279 where
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+-- NB: rts-1.0 is used here because it doesn't change.
+-- You do need to pick the right version number, otherwise the
+-- error message doesn't recognize it as a source package ID,
+-- (This is OK,  since it will look obviously wrong when they
+-- try to find the package in their package database.)
+blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName "rts-1.0") (mkModName "A"))))
diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr
new file mode 100644
index 0000000..c5f7834
--- /dev/null
+++ b/testsuite/tests/th/T10279.stderr
@@ -0,0 +1,8 @@
+
+T10279.hs:10:10: error:
+    Failed to load interface for ‘A’
+    no package key matching ‘rts-1.0’ was found
+    (This package key looks like the source package ID;
+     the real package key is ‘rts’)
+    In the expression: (rts-1.0:A.Foo)
+    In an equation for ‘blah’: blah = (rts-1.0:A.Foo)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b7c2419..dda8274 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -360,6 +360,7 @@ test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
 test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
+test('T10279', normal, compile_fail, ['-v0'])
 test('T10306', normal, compile, ['-v0'])
 
 test('TH_abstractFamily', normal, compile_fail, [''])