Make type import/export API Annotation friendly

Summary:
At the moment an export of the form

   type C(..)

is parsed by the rule

```
  |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                     [mj AnnType $1,mj AnnVal $2] }
```

This means that the origiinal oqtycon loses its location which is then retained
in the AnnVal annotation.

The problem is if the oqtycon has its own annotations, these get lost.

e.g. in

  type (?)(..)

the parens annotations for (?) get lost.

This patch adds a wrapper around the name in the IE type to

(a) provide a distinct location for the adornment annotation and

(b) identify the specific adornment, for use in the pretty printer rather than
occName magic.

Updates haddock submodule

Test Plan: ./validate

Reviewers: mpickering, dfeuer, bgamari, austin

Reviewed By: dfeuer

Subscribers: dfeuer, thomie, mpickering

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

GHC Trac Issues: #13163

12 files changed, 324 insertions, 119 deletions

diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs
index 8641f1ff3f..3424a0816c 100644
--- a/compiler/hsSyn/HsImpExp.hs
+++ b/compiler/hsSyn/HsImpExp.hs
@@ -12,7 +12,7 @@ module HsImpExp where
 
 import Module           ( ModuleName )
 import HsDoc            ( HsDocString )
-import OccName          ( HasOccName(..), isTcOcc, isSymOcc, isDataOcc )
+import OccName          ( HasOccName(..), isTcOcc, isSymOcc )
 import BasicTypes       ( SourceText(..), StringLiteral(..), pprWithSourceText )
 import FieldLabel       ( FieldLbl(..) )
 
@@ -134,6 +134,22 @@ instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name)
 ************************************************************************
 -}
 
+-- | A name in an import or export specfication which may have adornments. Used
+-- primarily for accurate pretty printing of ParsedSource, and API Annotation
+-- placement.
+data IEWrappedName name
+  = IEName    (Located name)  -- ^ no extra
+  | IEPattern (Located name)  -- ^ pattern X
+  | IEType    (Located name)  -- ^ type (:+:)
+  deriving (Eq,Data)
+
+-- | Located name with possible adornment
+-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
+--         'ApiAnnotation.AnnPattern'
+type LIEWrappedName name = Located (IEWrappedName name)
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+
 -- | Located Import or Export
 type LIE name = Located (IE name)
         -- ^ When in a list this may have
@@ -144,15 +160,10 @@ type LIE name = Located (IE name)
 
 -- | Imported or exported entity.
 data IE name
-  = IEVar       (Located name)
+  = IEVar       (LIEWrappedName name)
         -- ^ Imported or Exported Variable
-        --
-        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
-        --             'ApiAnnotation.AnnType'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
-        -- See Note [Located RdrNames] in HsExpr
-  | IEThingAbs  (Located name)
+  | IEThingAbs  (LIEWrappedName name)
         -- ^ Imported or exported Thing with Absent list
         --
         -- The thing is a Class/Type (can't tell)
@@ -161,7 +172,7 @@ data IE name
 
         -- For details on above see note [Api annotations] in ApiAnnotation
         -- See Note [Located RdrNames] in HsExpr
-  | IEThingAll  (Located name)
+  | IEThingAll  (LIEWrappedName name)
         -- ^ Imported or exported Thing with All imported or exported
         --
         -- The thing is a Class/Type and the All refers to methods/constructors
@@ -173,9 +184,9 @@ data IE name
         -- For details on above see note [Api annotations] in ApiAnnotation
         -- See Note [Located RdrNames] in HsExpr
 
-  | IEThingWith (Located name)
+  | IEThingWith (LIEWrappedName name)
                 IEWildcard
-                [Located name]
+                [LIEWrappedName name]
                 [Located (FieldLbl name)]
         -- ^ Imported or exported Thing With given imported or exported
         --
@@ -221,50 +232,79 @@ See Note [Representing fields in AvailInfo] in Avail for more details.
 -}
 
 ieName :: IE name -> name
-ieName (IEVar (L _ n))              = n
-ieName (IEThingAbs  (L _ n))        = n
-ieName (IEThingWith (L _ n) _ _ _)  = n
-ieName (IEThingAll  (L _ n))        = n
+ieName (IEVar (L _ n))              = ieWrappedName n
+ieName (IEThingAbs  (L _ n))        = ieWrappedName n
+ieName (IEThingWith (L _ n) _ _ _)  = ieWrappedName n
+ieName (IEThingAll  (L _ n))        = ieWrappedName n
 ieName _ = panic "ieName failed pattern match!"
 
 ieNames :: IE a -> [a]
-ieNames (IEVar       (L _ n)   )     = [n]
-ieNames (IEThingAbs  (L _ n)   )     = [n]
-ieNames (IEThingAll  (L _ n)   )     = [n]
-ieNames (IEThingWith (L _ n) _ ns _) = n : map unLoc ns
+ieNames (IEVar       (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAbs  (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAll  (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingWith (L _ n) _ ns _) = ieWrappedName n
+                                       : map (ieWrappedName . unLoc) ns
 ieNames (IEModuleContents _    )     = []
 ieNames (IEGroup          _ _  )     = []
 ieNames (IEDoc            _    )     = []
 ieNames (IEDocNamed       _    )     = []
 
-pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
-pprImpExp name = type_pref <+> pprPrefixOcc name
-    where
-    occ = occName name
-    type_pref | isTcOcc occ && isSymOcc occ = text "type"
-              | otherwise                   = empty
+ieWrappedName :: IEWrappedName name -> name
+ieWrappedName (IEName    (L _ n)) = n
+ieWrappedName (IEPattern (L _ n)) = n
+ieWrappedName (IEType    (L _ n)) = n
+
+ieLWrappedName :: LIEWrappedName name -> Located name
+ieLWrappedName (L l n) = L l (ieWrappedName n)
+
+replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2
+replaceWrappedName (IEName    (L l _)) n = IEName    (L l n)
+replaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)
+replaceWrappedName (IEType    (L l _)) n = IEType    (L l n)
+
+replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
+replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
 
 instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
-    ppr (IEVar          var)
-      -- This is a messy test, should perhaps create IEPatternVar
-      = (if isDataOcc $ occName $ unLoc var then text "pattern" else empty)
-        <+> pprPrefixOcc (unLoc var)
-    ppr (IEThingAbs     thing)  = pprImpExp (unLoc thing)
-    ppr (IEThingAll      thing) = hcat [pprImpExp (unLoc thing), text "(..)"]
+    ppr (IEVar          var) = ppr (unLoc var)
+    ppr (IEThingAbs     thing) = ppr (unLoc thing)
+    ppr (IEThingAll     thing) = hcat [ppr (unLoc thing), text "(..)"]
     ppr (IEThingWith thing wc withs flds)
-        = pprImpExp (unLoc thing) <> parens (fsep (punctuate comma
+        = ppr (unLoc thing) <> parens (fsep (punctuate comma
                                               (ppWiths ++
                                               map (ppr . flLabel . unLoc) flds)))
       where
         ppWiths =
           case wc of
               NoIEWildcard ->
-                map (pprImpExp . unLoc) withs
+                map (ppr . unLoc) withs
               IEWildcard pos ->
-                let (bs, as) = splitAt pos (map (pprImpExp . unLoc) withs)
+                let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
                 in bs ++ [text ".."] ++ as
     ppr (IEModuleContents mod')
         = text "module" <+> ppr mod'
     ppr (IEGroup n _)           = text ("<IEGroup: " ++ show n ++ ">")
     ppr (IEDoc doc)             = ppr doc
     ppr (IEDocNamed string)     = text ("<IEDocNamed: " ++ string ++ ">")
+
+instance (HasOccName name) => HasOccName (IEWrappedName name) where
+  occName w = occName (ieWrappedName w)
+
+instance (OutputableBndr name, HasOccName name)
+           => OutputableBndr (IEWrappedName name) where
+  pprBndr bs   w = pprBndr bs   (ieWrappedName w)
+  pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
+  pprInfixOcc  w = pprInfixOcc  (ieWrappedName w)
+
+instance (HasOccName name, OutputableBndr name)
+            => Outputable (IEWrappedName name) where
+  ppr (IEName    n) = pprPrefixOcc (unLoc n)
+  ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)
+  ppr (IEType    n) = text "type"    <+> pprPrefixOcc (unLoc n)
+
+pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
+pprImpExp name = type_pref <+> pprPrefixOcc name
+    where
+    occ = occName name
+    type_pref | isTcOcc occ && isSymOcc occ = text "type"
+              | otherwise                   = empty
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 2b70fb7999..e0e060e053 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -793,7 +793,7 @@ export  :: { OrdList (LIE RdrName) }
                                           >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
         |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
                                              [mj AnnModule $1] }
-        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
+        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar (sLL $1 $> (IEPattern $2))))
                                              [mj AnnPattern $1] }
 
 export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
@@ -803,13 +803,13 @@ export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
                                             (as ++ [mop $1,mcp $3] ++ fst $2, ie) }
 
 
-qcnames :: { ([AddAnn], [Located (Maybe RdrName)]) }
+qcnames :: { ([AddAnn], [Located ImpExpQcSpec]) }
   : {- empty -}                   { ([],[]) }
   | qcnames1                      { $1 }
 
-qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
+qcnames1 :: { ([AddAnn], [Located ImpExpQcSpec]) }     -- A reversed list
         :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
-                                                    l@(L _ Nothing) ->
+                                                    l@(L _ ImpExpQcWildcard) ->
                                                        return ([mj AnnComma $2, mj AnnDotdot l]
                                                                ,(snd (unLoc $3)  : snd $1))
                                                     l -> (ams (head (snd $1)) [mj AnnComma $2] >>
@@ -822,14 +822,15 @@ qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
 
 -- Variable, data constructor or wildcard
 -- or tagged type constructor
-qcname_ext_w_wildcard :: { Located ([AddAnn],Located (Maybe RdrName)) }
-        :  qcname_ext               { sL1 $1 ([],Just `fmap` $1) }
-        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 Nothing) }
-
-qcname_ext :: { Located RdrName }
-        :  qcname                   { $1 }
-        |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
-                                            [mj AnnType $1,mj AnnVal $2] }
+qcname_ext_w_wildcard :: { Located ([AddAnn], Located ImpExpQcSpec) }
+        :  qcname_ext               { sL1 $1 ([],$1) }
+        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 ImpExpQcWildcard)  }
+
+qcname_ext :: { Located ImpExpQcSpec }
+        :  qcname                   { sL1 $1 (ImpExpQcName $1) }
+        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2
+                                          ; ams (sLL $1 $> (ImpExpQcType n))
+                                                [mj AnnType $1] } }
 
 qcname  :: { Located RdrName }  -- Variable or type constructor
         :  qvar                 { $1 } -- Things which look like functions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 64a60c4841..2c63c428b6 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -56,6 +56,7 @@ module   RdrHsSyn (
 
         -- Help with processing exports
         ImpExpSubSpec(..),
+        ImpExpQcSpec(..),
         mkModuleImpExp,
         mkTypeImpExp,
         mkImpExpSubSpec,
@@ -1436,30 +1437,37 @@ mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
 
 data ImpExpSubSpec = ImpExpAbs
                    | ImpExpAll
-                   | ImpExpList [Located RdrName]
-                   | ImpExpAllWith [Located (Maybe RdrName)]
+                   | ImpExpList [Located ImpExpQcSpec]
+                   | ImpExpAllWith [Located ImpExpQcSpec]
 
-mkModuleImpExp :: Located RdrName -> ImpExpSubSpec -> P (IE RdrName)
-mkModuleImpExp n@(L l name) subs =
+data ImpExpQcSpec = ImpExpQcName (Located RdrName)
+                  | ImpExpQcType (Located RdrName)
+                  | ImpExpQcWildcard
+
+mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE RdrName)
+mkModuleImpExp (L l specname) subs =
   case subs of
     ImpExpAbs
-      | isVarNameSpace (rdrNameSpace name) -> return $ IEVar  n
-      | otherwise                          -> IEThingAbs . L l <$> nameT
-    ImpExpAll                              -> IEThingAll . L l <$> nameT
-    ImpExpList xs                          ->
-      (\newName -> IEThingWith (L l newName) NoIEWildcard xs []) <$> nameT
+      | isVarNameSpace (rdrNameSpace name)
+                               -> return $ IEVar (L l (ieNameFromSpec specname))
+      | otherwise              -> IEThingAbs . L l <$> nameT
+    ImpExpAll                  -> IEThingAll . L l <$> nameT
+    ImpExpList xs              ->
+      (\newName -> IEThingWith (L l newName) NoIEWildcard (wrapped xs) [])
+        <$> nameT
     ImpExpAllWith xs                       ->
       do allowed <- extension patternSynonymsEnabled
          if allowed
           then
             let withs = map unLoc xs
                 pos   = maybe NoIEWildcard IEWildcard
-                          (findIndex isNothing withs)
-                ies   = [L l n | L l (Just n) <- xs]
+                          (findIndex isImpExpQcWildcard withs)
+                ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
             in (\newName -> IEThingWith (L l newName) pos ies []) <$> nameT
           else parseErrorSDoc l
             (text "Illegal export form (use PatternSynonyms to enable)")
   where
+    name = ieNameVal specname
     nameT =
       if isVarNameSpace (rdrNameSpace name)
         then parseErrorSDoc l
@@ -1469,7 +1477,17 @@ mkModuleImpExp n@(L l name) subs =
                    then text "If" <+> quotes (ppr name) <+> text "is a type constructor"
                     <+> text "then enable ExplicitNamespaces and use the 'type' keyword."
                    else empty)
-        else return $ name
+        else return $ ieNameFromSpec specname
+
+    ieNameVal (ImpExpQcName ln)  = unLoc ln
+    ieNameVal (ImpExpQcType ln)  = unLoc ln
+    ieNameVal (ImpExpQcWildcard) = panic "ieNameVal got wildcard"
+
+    ieNameFromSpec (ImpExpQcName ln)  = IEName ln
+    ieNameFromSpec (ImpExpQcType ln)  = IEType ln
+    ieNameFromSpec (ImpExpQcWildcard) = panic "ieName got wildcard"
+
+    wrapped = map (\(L l x) -> L l (ieNameFromSpec x))
 
 mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
              -> P (Located RdrName)
@@ -1492,15 +1510,18 @@ checkImportSpec ie@(L _ specs) =
         $+$ text "pattern synonyms with types in module exports.")
 
 -- In the correct order
-mkImpExpSubSpec :: [Located (Maybe RdrName)] -> P ([AddAnn], ImpExpSubSpec)
+mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)
 mkImpExpSubSpec [] = return ([], ImpExpList [])
-mkImpExpSubSpec [L l Nothing] =
-  return ([\s -> addAnnotation s AnnDotdot l], ImpExpAll)
+mkImpExpSubSpec [L _ ImpExpQcWildcard] =
+  return ([], ImpExpAll)
 mkImpExpSubSpec xs =
-  if (any (isNothing . unLoc) xs)
+  if (any (isImpExpQcWildcard . unLoc) xs)
     then return $ ([], ImpExpAllWith xs)
-    else return $ ([], ImpExpList ([L l x | L l (Just x) <- xs]))
+    else return $ ([], ImpExpList xs)
 
+isImpExpQcWildcard :: ImpExpQcSpec -> Bool
+isImpExpQcWildcard ImpExpQcWildcard = True
+isImpExpQcWildcard _                = False
 
 -----------------------------------------------------------------------------
 -- Misc utils
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 9d2de7439e..2cde294678 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -873,18 +873,19 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
     lookup_ie ie = handle_bad_import $ do
       case ie of
         IEVar (L l n) -> do
-            (name, avail, _) <- lookup_name n
-            return ([(IEVar (L l name), trimAvail avail name)], [])
+            (name, avail, _) <- lookup_name $ ieWrappedName n
+            return ([(IEVar (L l (replaceWrappedName n name)),
+                                                  trimAvail avail name)], [])
 
         IEThingAll (L l tc) -> do
-            (name, avail, mb_parent) <- lookup_name tc
+            (name, avail, mb_parent) <- lookup_name $ ieWrappedName tc
             let warns = case avail of
                           Avail {}                     -- e.g. f(..)
-                            -> [DodgyImport tc]
+                            -> [DodgyImport $ ieWrappedName tc]
 
                           AvailTC _ subs fs
                             | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym
-                            -> [DodgyImport tc]
+                            -> [DodgyImport $ ieWrappedName tc]
 
                             | not (is_qual decl_spec)  -- e.g. import M( T(..) )
                             -> [MissingImportList]
@@ -892,7 +893,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
                             | otherwise
                             -> []
 
-                renamed_ie = IEThingAll (L l name)
+                renamed_ie = IEThingAll (L l (replaceWrappedName tc name))
                 sub_avails = case avail of
                                Avail {}              -> []
                                AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
@@ -902,23 +903,26 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
               Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)
                              -- associated type
 
-        IEThingAbs (L l tc)
+        IEThingAbs (L l tc')
             | want_hiding   -- hiding ( C )
                        -- Here the 'C' can be a data constructor
                        --  *or* a type/class, or even both
-            -> let tc_name = lookup_name tc
+            -> let tc = ieWrappedName tc'
+                   tc_name = lookup_name tc
                    dc_name = lookup_name (setRdrNameSpace tc srcDataName)
                in
                case catIELookupM [ tc_name, dc_name ] of
                  []    -> failLookupWith BadImport
-                 names -> return ([mkIEThingAbs l name | name <- names], [])
+                 names -> return ([mkIEThingAbs tc' l name | name <- names], [])
             | otherwise
-            -> do nameAvail <- lookup_name tc
-                  return ([mkIEThingAbs l nameAvail], [])
+            -> do nameAvail <- lookup_name (ieWrappedName tc')
+                  return ([mkIEThingAbs tc' l nameAvail]
+                         , [])
 
-        IEThingWith (L l rdr_tc) wc rdr_ns rdr_fs ->
+        IEThingWith (L l rdr_tc) wc rdr_ns' rdr_fs ->
           ASSERT2(null rdr_fs, ppr rdr_fs) do
-           (name, AvailTC _ ns subflds, mb_parent) <- lookup_name rdr_tc
+           (name, AvailTC _ ns subflds, mb_parent)
+                                         <- lookup_name (ieWrappedName rdr_tc)
 
            -- Look up the children in the sub-names of the parent
            let subnames = case ns of   -- The tc is first in ns,
@@ -926,32 +930,41 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
                                        -- See the AvailTC Invariant in Avail.hs
                             (n1:ns1) | n1 == name -> ns1
                                      | otherwise  -> ns
+               rdr_ns = map ieLWrappedName rdr_ns'
            case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
              Nothing                      -> failLookupWith BadImport
              Just (childnames, childflds) ->
                case mb_parent of
                  -- non-associated ty/cls
                  Nothing
-                   -> return ([(IEThingWith (L l name) wc childnames childflds,
+                   -> return ([(IEThingWith (L l name') wc childnames'
+                                                           childflds,
                                AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
                               [])
+                   where name' = replaceWrappedName rdr_tc name
+                         childnames' = map to_ie_post_rn childnames
+                         -- childnames' = postrn_ies childnames
                  -- associated ty
                  Just parent
-                   -> return ([(IEThingWith (L l name) wc childnames childflds,
+                   -> return ([(IEThingWith (L l name') wc childnames'
+                                                           childflds,
                                 AvailTC name (map unLoc childnames) (map unLoc childflds)),
-                               (IEThingWith (L l name) wc childnames childflds,
+                               (IEThingWith (L l name') wc childnames'
+                                                           childflds,
                                 AvailTC parent [name] [])],
                               [])
+                   where name' = replaceWrappedName rdr_tc name
+                         childnames' = map to_ie_post_rn childnames
 
         _other -> failLookupWith IllegalImport
         -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
         -- all errors.
 
       where
-        mkIEThingAbs l (n, av, Nothing    ) = (IEThingAbs (L l n),
-                                               trimAvail av n)
-        mkIEThingAbs l (n, _,  Just parent) = (IEThingAbs (L l n),
-                                               AvailTC parent [n] [])
+        mkIEThingAbs tc l (n, av, Nothing    )
+          = (IEThingAbs (L l (replaceWrappedName tc n)), trimAvail av n)
+        mkIEThingAbs tc l (n, _,  Just parent)
+          = (IEThingAbs (L l (replaceWrappedName tc n)), AvailTC parent [n] [])
 
         handle_bad_import m = catchIELookup m $ \err -> case err of
           BadImport | want_hiding -> return ([], [BadImportW])
@@ -995,7 +1008,7 @@ gresFromIE decl_spec (L loc ie, avail)
   = gresFromAvail prov_fn avail
   where
     is_explicit = case ie of
-                    IEThingAll (L _ name) -> \n -> n == name
+                    IEThingAll (L _ name) -> \n -> n == ieWrappedName name
                     _                     -> \_ -> True
     prov_fn name
       = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })
@@ -1251,15 +1264,19 @@ findImportUsage imports used_gres
               _other -> emptyNameSet -- No explicit import list => no unused-name list
 
         add_unused :: IE Name -> NameSet -> NameSet
-        add_unused (IEVar (L _ n))      acc = add_unused_name n acc
-        add_unused (IEThingAbs (L _ n)) acc = add_unused_name n acc
-        add_unused (IEThingAll (L _ n)) acc = add_unused_all  n acc
+        add_unused (IEVar (L _ n))      acc
+                                       = add_unused_name (ieWrappedName n) acc
+        add_unused (IEThingAbs (L _ n)) acc
+                                       = add_unused_name (ieWrappedName n) acc
+        add_unused (IEThingAll (L _ n)) acc
+                                       = add_unused_all  (ieWrappedName n) acc
         add_unused (IEThingWith (L _ p) wc ns fs) acc =
-          add_wc_all (add_unused_with p xs acc)
-          where xs = map unLoc ns ++ map (flSelector . unLoc) fs
+          add_wc_all (add_unused_with (ieWrappedName p) xs acc)
+          where xs = map (ieWrappedName . unLoc) ns
+                          ++ map (flSelector . unLoc) fs
                 add_wc_all = case wc of
                             NoIEWildcard -> id
-                            IEWildcard _ -> add_unused_all p
+                            IEWildcard _ -> add_unused_all (ieWrappedName p)
         add_unused _ acc = acc
 
         add_unused_name n acc
@@ -1394,24 +1411,29 @@ printMinimalImports imports_w_usage
     -- we want to say "T(..)", but if we're importing only a subset we want
     -- to say "T(A,B,C)".  So we have to find out what the module exports.
     to_ie _ (Avail n)
-       = [IEVar (noLoc n)]
+       = [IEVar (to_ie_post_rn $ noLoc n)]
     to_ie _ (AvailTC n [m] [])
-       | n==m = [IEThingAbs (noLoc n)]
+       | n==m = [IEThingAbs (to_ie_post_rn $ noLoc n)]
     to_ie iface (AvailTC n ns fs)
       = case [(xs,gs) |  AvailTC x xs gs <- mi_exports iface
                  , x == n
                  , x `elem` xs    -- Note [Partial export]
                  ] of
-           [xs] | all_used xs -> [IEThingAll (noLoc n)]
-                | otherwise   -> [IEThingWith (noLoc n) NoIEWildcard
-                                              (map noLoc (filter (/= n) ns))
-                                              (map noLoc fs)]
+           [xs] | all_used xs -> [IEThingAll (to_ie_post_rn $ noLoc n)]
+                | otherwise   ->
+                   [IEThingWith (to_ie_post_rn $ noLoc n) NoIEWildcard
+                                (map (to_ie_post_rn . noLoc) (filter (/= n) ns))
+                                (map noLoc fs)]
                                           -- Note [Overloaded field import]
            _other | all_non_overloaded fs
-                              -> map (IEVar . noLoc) $ ns ++ map flSelector fs
-                  | otherwise -> [IEThingWith (noLoc n) NoIEWildcard
-                                              (map noLoc (filter (/= n) ns)) (map noLoc fs)]
+                              -> map (IEVar . to_ie_post_rn_var . noLoc) $ ns
+                                 ++ map flSelector fs
+                  | otherwise ->
+                      [IEThingWith (to_ie_post_rn $ noLoc n) NoIEWildcard
+                                (map (to_ie_post_rn . noLoc) (filter (/= n) ns))
+                                (map noLoc fs)]
         where
+
           fld_lbls = map flLabel fs
 
           all_used (avail_occs, avail_flds)
@@ -1420,6 +1442,18 @@ printMinimalImports imports_w_usage
 
           all_non_overloaded = all (not . flIsOverloaded)
 
+to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name
+to_ie_post_rn_var (L l n)
+  | isDataOcc $ occName n = L l (IEPattern (L l n))
+  | otherwise             = L l (IEName    (L l n))
+
+
+to_ie_post_rn :: (HasOccName name) => Located name -> LIEWrappedName name
+to_ie_post_rn (L l n)
+  | isTcOcc occ && isSymOcc occ = L l (IEType (L l n))
+  | otherwise                   = L l (IEName (L l n))
+  where occ = occName n
+
 {-
 Note [Partial export]
 ~~~~~~~~~~~~~~~~~~~~~
@@ -1528,7 +1562,7 @@ dodgyImportWarn item = dodgyMsg (text "import") item
 dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc
 dodgyMsg kind tc
   = sep [ text "The" <+> kind <+> ptext (sLit "item")
-                             <+> quotes (ppr (IEThingAll (noLoc tc)))
+                     <+> quotes (ppr (IEThingAll (noLoc (IEName $ noLoc tc))))
                 <+> text "suggests that",
           quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,",
           text "but it has none" ]
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index 7e47901e42..99ab7474ad 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -133,7 +133,8 @@ tcRnExports explicit_mod exports
                  | explicit_mod = exports
                  | ghcLink dflags == LinkInMemory = Nothing
                  | otherwise
-                          = Just (noLoc [noLoc (IEVar (noLoc main_RDR_Unqual))])
+                          = Just (noLoc [noLoc
+                              (IEVar (noLoc (IEName $ noLoc main_RDR_Unqual)))])
                         -- ToDo: the 'noLoc' here is unhelpful if 'main'
                         --       turns out to be out of scope
 
@@ -267,18 +268,19 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
     -------------
     lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
     lookup_ie (IEVar (L l rdr))
-        = do (name, avail) <- lookupGreAvailRn rdr
-             return (IEVar (L l name), avail)
+        = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
+             return (IEVar (L l (replaceWrappedName rdr name)), avail)
 
     lookup_ie (IEThingAbs (L l rdr))
-        = do (name, avail) <- lookupGreAvailRn rdr
-             return (IEThingAbs (L l name), avail)
+        = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
+             return (IEThingAbs (L l (replaceWrappedName rdr name)), avail)
 
-    lookup_ie ie@(IEThingAll n)
+    lookup_ie ie@(IEThingAll n')
         = do
-            (n, avail, flds) <- lookup_ie_all ie n
+            (n, avail, flds) <- lookup_ie_all ie n'
             let name = unLoc n
-            return (IEThingAll n, AvailTC name (name:avail) flds)
+            return (IEThingAll (replaceLWrappedName n' (unLoc n))
+                   , AvailTC name (name:avail) flds)
 
 
     lookup_ie ie@(IEThingWith l wc sub_rdrs _)
@@ -290,7 +292,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                 NoIEWildcard -> return (lname, [], [])
                 IEWildcard _ -> lookup_ie_all ie l
             let name = unLoc lname
-            return (IEThingWith lname wc subs (map noLoc (flds ++ all_flds)),
+                subs' = map (replaceLWrappedName l . unLoc) subs
+            return (IEThingWith (replaceLWrappedName l name) wc subs'
+                                (map noLoc (flds ++ all_flds)),
                     AvailTC name (name : avails ++ all_avail)
                                  (flds ++ all_flds))
 
@@ -299,23 +303,24 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
 
     lookup_ie _ = panic "lookup_ie"    -- Other cases covered earlier
 
-    lookup_ie_with :: Located RdrName -> [Located RdrName]
+    lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
                    -> RnM (Located Name, [Located Name], [Name], [FieldLabel])
     lookup_ie_with (L l rdr) sub_rdrs
-        = do name <- lookupGlobalOccRn rdr
-             (non_flds, flds) <- lookupChildrenExport name sub_rdrs
+        = do name <- lookupGlobalOccRn $ ieWrappedName rdr
+             (non_flds, flds) <- lookupChildrenExport name
+                                                  (map ieLWrappedName sub_rdrs)
              if isUnboundName name
                 then return (L l name, [], [name], [])
                 else return (L l name, non_flds
                             , map unLoc non_flds
                             , map unLoc flds)
-    lookup_ie_all :: IE RdrName -> Located RdrName
+    lookup_ie_all :: IE RdrName -> LIEWrappedName RdrName
                   -> RnM (Located Name, [Name], [FieldLabel])
     lookup_ie_all ie (L l rdr) =
-          do name <- lookupGlobalOccRn rdr
+          do name <- lookupGlobalOccRn $ ieWrappedName rdr
              let gres = findChildren kids_env name
                  (non_flds, flds) = classifyGREs gres
-             addUsedKids rdr gres
+             addUsedKids (ieWrappedName rdr) gres
              warnDodgyExports <- woptM Opt_WarnDodgyExports
              when (null gres) $
                   if isTyConName name
@@ -765,8 +770,9 @@ dupExport_ok n ie1 ie2
   = not (  single ie1 || single ie2
         || (explicit_in ie1 && explicit_in ie2) )
   where
-    explicit_in (IEModuleContents _) = False                -- module M
-    explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc (unLoc r)  -- T(..)
+    explicit_in (IEModuleContents _) = False                   -- module M
+    explicit_in (IEThingAll r)
+      = nameOccName n == rdrNameOcc (ieWrappedName $ unLoc r)  -- T(..)
     explicit_in _              = True
 
     single IEVar {}      = True
diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py
index 3f2cf5cc4b..a6b04dd04d 100644
--- a/testsuite/driver/extra_files.py
+++ b/testsuite/driver/extra_files.py
@@ -44,6 +44,7 @@ extra_src_files = {
   'T10396': ['Test10396.hs'],
   'T10399': ['Test10399.hs'],
   'T12417': ['Test12417.hs'],
+  'T13163': ['Test13163.hs'],
   'T10420': ['rule-defining-plugin/'],
   'T10458': ['A.c'],
   'T10529a': ['hpc_sample_non_existing_module.tix'],
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 6a6addae70..2da5fc00a9 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -137,3 +137,7 @@ load-main:
 .PHONY: T12417
 T12417:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test12417.hs
+
+.PHONY: T13163
+T13163:
+	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test13163.hs
diff --git a/testsuite/tests/ghc-api/annotations/T13163.stdout b/testsuite/tests/ghc-api/annotations/T13163.stdout
new file mode 100644
index 0000000000..f216acdf98
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T13163.stdout
@@ -0,0 +1,78 @@
+---Problems (should be empty list)---
+[]
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+--    list of locations the keyword item appears in
+[
+((Test13163.hs:1:1,AnnModule), [Test13163.hs:4:1-6]),
+((Test13163.hs:1:1,AnnWhere), [Test13163.hs:8:5-9]),
+((Test13163.hs:(5,3)-(8,3),AnnCloseP), [Test13163.hs:8:3]),
+((Test13163.hs:(5,3)-(8,3),AnnOpenP), [Test13163.hs:5:3]),
+((Test13163.hs:5:5-14,AnnCloseP), [Test13163.hs:5:14]),
+((Test13163.hs:5:5-14,AnnComma), [Test13163.hs:6:3]),
+((Test13163.hs:5:5-14,AnnDotdot), [Test13163.hs:5:12-13]),
+((Test13163.hs:5:5-14,AnnOpenP), [Test13163.hs:5:11]),
+((Test13163.hs:6:5-12,AnnType), [Test13163.hs:6:5-8]),
+((Test13163.hs:6:5-16,AnnCloseP), [Test13163.hs:6:16]),
+((Test13163.hs:6:5-16,AnnComma), [Test13163.hs:7:3]),
+((Test13163.hs:6:5-16,AnnDotdot), [Test13163.hs:6:14-15]),
+((Test13163.hs:6:5-16,AnnOpenP), [Test13163.hs:6:13]),
+((Test13163.hs:6:10-12,AnnCloseP), [Test13163.hs:6:12]),
+((Test13163.hs:6:10-12,AnnOpenP), [Test13163.hs:6:10]),
+((Test13163.hs:6:10-12,AnnVal), [Test13163.hs:6:11]),
+((Test13163.hs:7:5,AnnComma), [Test13163.hs:7:6]),
+((Test13163.hs:7:8-15,AnnComma), [Test13163.hs:7:16]),
+((Test13163.hs:7:8-15,AnnType), [Test13163.hs:7:8-11]),
+((Test13163.hs:7:13-15,AnnCloseP), [Test13163.hs:7:15]),
+((Test13163.hs:7:13-15,AnnOpenP), [Test13163.hs:7:13]),
+((Test13163.hs:7:13-15,AnnVal), [Test13163.hs:7:14]),
+((Test13163.hs:7:18-31,AnnPattern), [Test13163.hs:7:18-24]),
+((Test13163.hs:10:1-78,AnnImport), [Test13163.hs:10:1-6]),
+((Test13163.hs:10:1-78,AnnSemi), [Test13163.hs:11:1]),
+((Test13163.hs:10:31-78,AnnCloseP), [Test13163.hs:10:78]),
+((Test13163.hs:10:31-78,AnnOpenP), [Test13163.hs:10:31]),
+((Test13163.hs:10:32-41,AnnComma), [Test13163.hs:10:42]),
+((Test13163.hs:10:32-41,AnnType), [Test13163.hs:10:32-35]),
+((Test13163.hs:10:37-41,AnnCloseP), [Test13163.hs:10:41]),
+((Test13163.hs:10:37-41,AnnOpenP), [Test13163.hs:10:37]),
+((Test13163.hs:10:37-41,AnnVal), [Test13163.hs:10:38-40]),
+((Test13163.hs:10:44-53,AnnComma), [Test13163.hs:10:54]),
+((Test13163.hs:10:44-53,AnnType), [Test13163.hs:10:44-47]),
+((Test13163.hs:10:49-53,AnnCloseP), [Test13163.hs:10:53]),
+((Test13163.hs:10:49-53,AnnOpenP), [Test13163.hs:10:49]),
+((Test13163.hs:10:49-53,AnnVal), [Test13163.hs:10:50-52]),
+((Test13163.hs:10:56-65,AnnComma), [Test13163.hs:10:66]),
+((Test13163.hs:10:56-65,AnnType), [Test13163.hs:10:56-59]),
+((Test13163.hs:10:61-65,AnnCloseP), [Test13163.hs:10:65]),
+((Test13163.hs:10:61-65,AnnOpenP), [Test13163.hs:10:61]),
+((Test13163.hs:10:61-65,AnnVal), [Test13163.hs:10:62-64]),
+((Test13163.hs:10:68-77,AnnType), [Test13163.hs:10:68-71]),
+((Test13163.hs:10:73-77,AnnCloseP), [Test13163.hs:10:77]),
+((Test13163.hs:10:73-77,AnnOpenP), [Test13163.hs:10:73]),
+((Test13163.hs:10:73-77,AnnVal), [Test13163.hs:10:74-76]),
+((Test13163.hs:11:1-61,AnnImport), [Test13163.hs:11:1-6]),
+((Test13163.hs:11:1-61,AnnSemi), [Test13163.hs:12:1]),
+((Test13163.hs:11:24-61,AnnCloseP), [Test13163.hs:11:61]),
+((Test13163.hs:11:24-61,AnnOpenP), [Test13163.hs:11:24]),
+((Test13163.hs:11:25-31,AnnComma), [Test13163.hs:11:32]),
+((Test13163.hs:11:34-44,AnnComma), [Test13163.hs:11:45]),
+((Test13163.hs:11:47-56,AnnType), [Test13163.hs:11:47-50]),
+((Test13163.hs:11:47-60,AnnCloseP), [Test13163.hs:11:60]),
+((Test13163.hs:11:47-60,AnnDotdot), [Test13163.hs:11:58-59]),
+((Test13163.hs:11:47-60,AnnOpenP), [Test13163.hs:11:57]),
+((Test13163.hs:11:52-56,AnnCloseP), [Test13163.hs:11:56]),
+((Test13163.hs:11:52-56,AnnOpenP), [Test13163.hs:11:52]),
+((Test13163.hs:11:52-56,AnnVal), [Test13163.hs:11:53-55]),
+((Test13163.hs:12:1-19,AnnImport), [Test13163.hs:12:1-6]),
+((Test13163.hs:12:1-19,AnnSemi), [Test13163.hs:14:1]),
+((Test13163.hs:14:1-22,AnnEqual), [Test13163.hs:14:18]),
+((Test13163.hs:14:1-22,AnnPattern), [Test13163.hs:14:1-7]),
+((Test13163.hs:14:1-22,AnnSemi), [Test13163.hs:16:1]),
+((Test13163.hs:14:20-22,AnnCloseS), [Test13163.hs:14:22]),
+((Test13163.hs:14:20-22,AnnOpenS), [Test13163.hs:14:20]),
+((Test13163.hs:16:1-13,AnnEqual), [Test13163.hs:16:3]),
+((Test13163.hs:16:1-13,AnnFunId), [Test13163.hs:16:1]),
+((Test13163.hs:16:1-13,AnnSemi), [Test13163.hs:17:1]),
+((<no location info>,AnnEofPos), [Test13163.hs:17:1])
+]
+
diff --git a/testsuite/tests/ghc-api/annotations/Test13163.hs b/testsuite/tests/ghc-api/annotations/Test13163.hs
new file mode 100644
index 0000000000..439d825386
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test13163.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+module T13163
+  ( Record(..)
+  , type (?)(..)
+  , f, type (+), pattern Single
+  ) where
+
+import Data.Promotion.Prelude (type (:+$), type (:*$), type (:^$), type (:-$))
+import Options.Generic (Generic, ParseRecord, type (<?>)(..))
+import GHC.TypeLits
+
+pattern Single x = [x]
+
+f = undefined
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index fbe8c3e35f..1028626575 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -27,3 +27,4 @@ test('T11332',      ignore_stderr, run_command, ['$MAKE -s --no-print-directory
 test('T11430',      ignore_stderr, run_command, ['$MAKE -s --no-print-directory T11430'])
 test('load-main',   ignore_stderr, run_command, ['$MAKE -s --no-print-directory load-main'])
 test('T12417',      ignore_stderr, run_command, ['$MAKE -s --no-print-directory T12417'])
+test('T13163',      ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13163'])
diff --git a/utils/check-ppr/README b/utils/check-ppr/README
index d31442a9e9..f9b502e4a7 100644
--- a/utils/check-ppr/README
+++ b/utils/check-ppr/README
@@ -19,5 +19,8 @@ In a test Makefile
 
 See examples in (REPO_HOME)/testsuite/tests/printer/Makefile
 
-If passed the --dump flag check-ppr will produce .new and .old files containing
-the ASTs before and after round-tripping to aid debugging.
+The utility generates the following files for ToBeTested.hs
+
+  - ToBeTested.ppr.hs      : the ppr result
+  - ToBeTested.hs.ast      : the AST of the original source
+  - ToBeTested.hs.ast.new  : the AST of the re-parsed ppr source
diff --git a/utils/haddock b/utils/haddock
-Subproject 4349092ef61ca7da7c7cbcd9aa7dcbb97fe59bd
+Subproject 7f1987b35eb7bb15ca2fd93321440af519dd8cd