Forbid variables to be parents in import lists.

In the long discussion on #11432, it was decided that when a type
constructor is parsed as a variable ((--.->) is one example) then in
order to export the type constructor then the user should be required to
use the ExplicitNamespaces keyword.

This was implemented in quite an indirect manner in the renamer. It
is much more direct to enforce this in the parser at the expense of
slighty worse error messages. Further to this, the check in the
renamer was actually slightly wrong. If the variable was in scope
then no error was raised, this was causing panics, see #12026 for an
example.

Reviewers: austin, bgamari

Subscribers: davean, skvadrik, thomie

Differential Revision: https://phabricator.haskell.org/D2181

GHC Trac Issues: #12026

10 files changed, 48 insertions, 47 deletions

diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 28ee4f07a0..c3f1d53d65 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -1387,10 +1387,10 @@ mkModuleImpExp n@(L l name) subs =
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name) -> return $ IEVar  n
-      | otherwise                          -> return $ IEThingAbs  (L l name)
-    ImpExpAll                              -> return $ IEThingAll  (L l name)
+      | otherwise                          -> IEThingAbs . L l <$> nameT
+    ImpExpAll                              -> IEThingAll . L l <$> nameT
     ImpExpList xs                          ->
-      return $ IEThingWith (L l name) NoIEWildcard xs []
+      (\newName -> IEThingWith (L l newName) NoIEWildcard xs []) <$> nameT
     ImpExpAllWith xs                       ->
       do allowed <- extension patternSynonymsEnabled
          if allowed
@@ -1399,9 +1399,19 @@ mkModuleImpExp n@(L l name) subs =
                 pos   = maybe NoIEWildcard IEWildcard
                           (findIndex isNothing withs)
                 ies   = [L l n | L l (Just n) <- xs]
-            in return (IEThingWith (L l name) pos ies [])
+            in (\newName -> IEThingWith (L l newName) pos ies []) <$> nameT
           else parseErrorSDoc l
             (text "Illegal export form (use PatternSynonyms to enable)")
+  where
+    nameT =
+      if isVarNameSpace (rdrNameSpace name)
+        then parseErrorSDoc l
+              (text "Expecting a type constructor but found a variable."
+              $$ if isSymOcc $ rdrNameOcc name
+                   then text "If" <+> quotes (ppr name) <+> text "is a type constructor"
+                   else empty
+              <+> text "then enable ExplicitNamespaces and use the 'type' keyword.")
+        else return $ name
 
 mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
              -> P (Located RdrName)
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 9f43169543..4ab67ad56c 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -13,7 +13,7 @@ module RnEnv (
         lookupLocalOccRn_maybe, lookupInfoOccRn,
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
-        lookupGlobalOccRn, lookupGlobalOccRnExport, lookupGlobalOccRn_maybe,
+        lookupGlobalOccRn, lookupGlobalOccRn_maybe,
         lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
         reportUnboundName, unknownNameSuggestions,
         addNameClashErrRn,
@@ -858,27 +858,6 @@ lookupGlobalOccRn rdr_name
            Nothing -> do { traceRn (text "lookupGlobalOccRn" <+> ppr rdr_name)
                          ; unboundName WL_Global rdr_name } }
 
--- like lookupGlobalOccRn but suggests adding 'type' keyword
--- to export type constructors mistaken for data constructors
-lookupGlobalOccRnExport :: RdrName -> RnM Name
-lookupGlobalOccRnExport rdr_name
-  = do { mb_name <- lookupGlobalOccRn_maybe rdr_name
-       ; case mb_name of
-           Just n  -> return n
-           Nothing -> do { env <- getGlobalRdrEnv
-                         ; let tycon = setOccNameSpace tcClsName (rdrNameOcc rdr_name)
-                               msg = case lookupOccEnv env tycon of
-                                   Just (gre : _) -> make_msg gre
-                                   _              -> Outputable.empty
-                               make_msg gre = hang
-                                   (hsep [text "Note: use",
-                                       quotes (text "type"),
-                                       text "keyword to export type constructor",
-                                       quotes (ppr (gre_name gre))])
-                                   2 (vcat [pprNameProvenance gre,
-                                       text "(requires TypeOperators extension)"])
-                         ; unboundNameX WL_Global rdr_name msg } }
-
 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
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 1e704bf22d..40049bf787 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -1357,7 +1357,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
     lookup_ie_with :: IE RdrName -> Located RdrName -> [Located RdrName]
                    -> RnM (Located Name, [Located Name], [Name], [FieldLabel])
     lookup_ie_with ie (L l rdr) sub_rdrs
-        = do name <- lookupGlobalOccRnExport rdr
+        = do name <- lookupGlobalOccRn rdr
              let gres = findChildren kids_env name
                  mchildren =
                   lookupChildren (map classifyGRE (gres ++ pat_syns)) sub_rdrs
@@ -1377,7 +1377,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
     lookup_ie_all :: IE RdrName -> Located RdrName
                   -> RnM (Located Name, [Name], [FieldLabel])
     lookup_ie_all ie (L l rdr) =
-          do name <- lookupGlobalOccRnExport rdr
+          do name <- lookupGlobalOccRn rdr
              let gres = findChildren kids_env name
                  (non_flds, flds) = classifyGREs gres
              addUsedKids rdr gres
diff --git a/testsuite/tests/module/T11432.stderr b/testsuite/tests/module/T11432.stderr
index bf2a58b0a0..9e61092e37 100644
--- a/testsuite/tests/module/T11432.stderr
+++ b/testsuite/tests/module/T11432.stderr
@@ -1,10 +1,4 @@
 
-T11432.hs:7:16:
-    Not in scope: ‘-.->’
-    Note: use ‘type’ keyword to export type constructor ‘-.->’
-      defined at T11432.hs:9:1
-      (requires TypeOperators extension)
-
-T11432.hs:7:16:
-    The export item ‘(-.->)(..)’
-    attempts to export constructors or class methods that are not visible here
+T11432.hs:7:16: error:
+    Expecting a type constructor but found a variable.
+    If  ‘-.->’ is a type constructor then enable ExplicitNamespaces and use the 'type' keyword.
diff --git a/testsuite/tests/module/T11432a.hs b/testsuite/tests/module/T11432a.hs
new file mode 100644
index 0000000000..824fd6f0f5
--- /dev/null
+++ b/testsuite/tests/module/T11432a.hs
@@ -0,0 +1,11 @@
+{-
+We expect to get a suggestion to add 'type' keyword
+and enable TypeOperators extension.
+-}
+
+{-# LANGUAGE TypeOperators #-}
+module T11432a ((-.->)()) where
+
+newtype (f -.-> g) a = Fn { apFn :: f a -> g a }
+
+(-.->) = id
diff --git a/testsuite/tests/module/T11432a.stderr b/testsuite/tests/module/T11432a.stderr
new file mode 100644
index 0000000000..2542af3fe0
--- /dev/null
+++ b/testsuite/tests/module/T11432a.stderr
@@ -0,0 +1,4 @@
+
+T11432a.hs:7:17: error:
+    Expecting a type constructor but found a variable.
+    If ‘-.->’ is a type constructor then enable ExplicitNamespaces and use the 'type' keyword.
diff --git a/testsuite/tests/module/T12026.hs b/testsuite/tests/module/T12026.hs
new file mode 100644
index 0000000000..3e831791c1
--- /dev/null
+++ b/testsuite/tests/module/T12026.hs
@@ -0,0 +1,3 @@
+module T12026 where
+
+import Prelude (map ())
diff --git a/testsuite/tests/module/T12026.stderr b/testsuite/tests/module/T12026.stderr
new file mode 100644
index 0000000000..38d53d7049
--- /dev/null
+++ b/testsuite/tests/module/T12026.stderr
@@ -0,0 +1,4 @@
+
+T12026.hs:3:17: error:
+    Expecting a type constructor but found a variable.
+    If  ‘map’ is a type constructor then enable ExplicitNamespaces and use the 'type' keyword.
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T
index d86dfede9d..ca81c5e9e8 100644
--- a/testsuite/tests/module/all.T
+++ b/testsuite/tests/module/all.T
@@ -116,7 +116,7 @@ test('mod85', normal, compile, [''])
 test('mod86', normal, compile, [''])
 test('mod87', normal, compile_fail, [''])
 test('mod88', normal, compile_fail, [''])
-test('mod89', normal, compile, [''])
+test('mod89', normal, compile_fail, [''])
 test('mod90', normal, compile_fail, [''])
 test('mod91', normal, compile_fail, [''])
 test('mod92', normal, compile, [''])
@@ -348,3 +348,5 @@ test('T9997', normal, compile, [''])
 test('T10233', extra_clean(['T01233a.hi', 'T01233a.o']),
      multimod_compile, ['T10233', '-v0'])
 test('T11432', normal, compile_fail, [''])
+test('T11432a', normal, compile_fail, [''])
+test('T12026', normal, compile_fail, [''])
diff --git a/testsuite/tests/module/mod89.stderr b/testsuite/tests/module/mod89.stderr
index a1e335c9ff..afdc46466f 100644
--- a/testsuite/tests/module/mod89.stderr
+++ b/testsuite/tests/module/mod89.stderr
@@ -1,10 +1,4 @@
 
-mod89.hs:5:1: warning: [-Wdodgy-imports (in -Wextra)]
-    The import item ‘map(..)’ suggests that
-    ‘map’ has (in-scope) constructors or class methods,
-    but it has none
-
-mod89.hs:5:1: warning: [-Wunused-imports (in -Wextra)]
-    The import of ‘Prelude’ is redundant
-      except perhaps to import instances from ‘Prelude’
-    To import instances alone, use: import Prelude()
+mod89.hs:5:16: error:
+    Expecting a type constructor but found a variable.
+    If  ‘map’ is a type constructor then enable ExplicitNamespaces and use the 'type' keyword.