Commit 0d1cb157 authored by Alan Zimmerman's avatar Alan Zimmerman
Browse files

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
parent ff9355e4
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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" ]
......
......@@ -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]