Renamer now preserves location for IEThingWith list items
[ghc.git] / compiler / typecheck / TcRnExports.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE RankNTypes #-}
4 {-# LANGUAGE OverloadedStrings #-}
5 {-# LANGUAGE TypeFamilies #-}
6 module TcRnExports (tcRnExports, exports_from_avail) where
7
8 import HsSyn
9 import PrelNames
10 import RdrName
11 import TcRnMonad
12 import TcEnv
13 import TcMType
14 import TcType
15 import RnNames
16 import RnEnv
17 import RnUnbound ( reportUnboundName )
18 import ErrUtils
19 import Id
20 import IdInfo
21 import Module
22 import Name
23 import NameEnv
24 import NameSet
25 import Avail
26 import TyCon
27 import SrcLoc
28 import HscTypes
29 import Outputable
30 import ConLike
31 import DataCon
32 import PatSyn
33 import FastString
34 import Maybes
35 import Util (capitalise)
36
37
38 import Control.Monad
39 import DynFlags
40 import RnHsDoc ( rnHsDoc )
41 import RdrHsSyn ( setRdrNameSpace )
42 import Data.Either ( partitionEithers )
43
44 {-
45 ************************************************************************
46 * *
47 \subsection{Export list processing}
48 * *
49 ************************************************************************
50
51 Processing the export list.
52
53 You might think that we should record things that appear in the export
54 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
55 wrong. We do check (here) that they are in scope, but there is no
56 need to slurp in their actual declaration (which is what
57 @addOccurrenceName@ forces).
58
59 Indeed, doing so would big trouble when compiling @PrelBase@, because
60 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
61 @ConcBase.StateAndSynchVar#@, and so on...
62
63 Note [Exports of data families]
64 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
65 Suppose you see (Trac #5306)
66 module M where
67 import X( F )
68 data instance F Int = FInt
69 What does M export? AvailTC F [FInt]
70 or AvailTC F [F,FInt]?
71 The former is strictly right because F isn't defined in this module.
72 But then you can never do an explicit import of M, thus
73 import M( F( FInt ) )
74 because F isn't exported by M. Nor can you import FInt alone from here
75 import M( FInt )
76 because we don't have syntax to support that. (It looks like an import of
77 the type FInt.)
78
79 At one point I implemented a compromise:
80 * When constructing exports with no export list, or with module M(
81 module M ), we add the parent to the exports as well.
82 * But not when you see module M( f ), even if f is a
83 class method with a parent.
84 * Nor when you see module M( module N ), with N /= M.
85
86 But the compromise seemed too much of a hack, so we backed it out.
87 You just have to use an explicit export list:
88 module M( F(..) ) where ...
89 -}
90
91 data ExportAccum -- The type of the accumulating parameter of
92 -- the main worker function in rnExports
93 = ExportAccum
94 [(LIE GhcRn, Avails)] -- Export items with names and
95 -- their exported stuff
96 -- Not nub'd!
97 ExportOccMap -- Tracks exported occurrence names
98
99 emptyExportAccum :: ExportAccum
100 emptyExportAccum = ExportAccum [] emptyOccEnv
101
102 type ExportOccMap = OccEnv (Name, IE GhcPs)
103 -- Tracks what a particular exported OccName
104 -- in an export list refers to, and which item
105 -- it came from. It's illegal to export two distinct things
106 -- that have the same occurrence name
107
108 tcRnExports :: Bool -- False => no 'module M(..) where' header at all
109 -> Maybe (Located [LIE GhcPs]) -- Nothing => no explicit export list
110 -> TcGblEnv
111 -> RnM TcGblEnv
112
113 -- Complains if two distinct exports have same OccName
114 -- Warns about identical exports.
115 -- Complains about exports items not in scope
116
117 tcRnExports explicit_mod exports
118 tcg_env@TcGblEnv { tcg_mod = this_mod,
119 tcg_rdr_env = rdr_env,
120 tcg_imports = imports,
121 tcg_src = hsc_src }
122 = unsetWOptM Opt_WarnWarningsDeprecations $
123 -- Do not report deprecations arising from the export
124 -- list, to avoid bleating about re-exporting a deprecated
125 -- thing (especially via 'module Foo' export item)
126 do {
127 -- If the module header is omitted altogether, then behave
128 -- as if the user had written "module Main(main) where..."
129 -- EXCEPT in interactive mode, when we behave as if he had
130 -- written "module Main where ..."
131 -- Reason: don't want to complain about 'main' not in scope
132 -- in interactive mode
133 ; dflags <- getDynFlags
134 ; let real_exports
135 | explicit_mod = exports
136 | ghcLink dflags == LinkInMemory = Nothing
137 | otherwise
138 = Just (noLoc [noLoc
139 (IEVar (noLoc (IEName $ noLoc main_RDR_Unqual)))])
140 -- ToDo: the 'noLoc' here is unhelpful if 'main'
141 -- turns out to be out of scope
142
143 ; let do_it = exports_from_avail real_exports rdr_env imports this_mod
144 ; (rn_exports, final_avails)
145 <- if hsc_src == HsigFile
146 then do (msgs, mb_r) <- tryTc do_it
147 case mb_r of
148 Just r -> return r
149 Nothing -> addMessages msgs >> failM
150 else checkNoErrs do_it
151 ; let final_ns = availsToNameSetWithSelectors final_avails
152
153 ; traceRn "rnExports: Exports:" (ppr final_avails)
154
155 ; let new_tcg_env =
156 tcg_env { tcg_exports = final_avails,
157 tcg_rn_exports = case tcg_rn_exports tcg_env of
158 Nothing -> Nothing
159 Just _ -> rn_exports,
160 tcg_dus = tcg_dus tcg_env `plusDU`
161 usesOnly final_ns }
162 ; failIfErrsM
163 ; return new_tcg_env }
164
165 exports_from_avail :: Maybe (Located [LIE GhcPs])
166 -- Nothing => no explicit export list
167 -> GlobalRdrEnv
168 -> ImportAvails
169 -- Imported modules; this is used to test if a
170 -- 'module Foo' export is valid (it's not valid
171 -- if we didn't import Foo!)
172 -> Module
173 -> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
174 -- (Nothing, _) <=> no explicit export list
175 -- if explicit export list is present it contains
176 -- each renamed export item together with its exported
177 -- names.
178
179 exports_from_avail Nothing rdr_env _imports _this_mod
180 -- The same as (module M) where M is the current module name,
181 -- so that's how we handle it, except we also export the data family
182 -- when a data instance is exported.
183 = let avails =
184 map fix_faminst . gresToAvailInfo
185 . filter isLocalGRE . globalRdrEnvElts $ rdr_env
186 in return (Nothing, avails)
187 where
188 -- #11164: when we define a data instance
189 -- but not data family, re-export the family
190 -- Even though we don't check whether this is actually a data family
191 -- only data families can locally define subordinate things (`ns` here)
192 -- without locally defining (and instead importing) the parent (`n`)
193 fix_faminst (AvailTC n ns flds) =
194 let new_ns =
195 case ns of
196 [] -> [n]
197 (p:_) -> if p == n then ns else n:ns
198 in AvailTC n new_ns flds
199
200 fix_faminst avail = avail
201
202
203 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
204 = do ExportAccum ie_avails _
205 <- foldAndRecoverM do_litem emptyExportAccum rdr_items
206 let final_exports = nubAvails (concat (map snd ie_avails)) -- Combine families
207 return (Just ie_avails, final_exports)
208 where
209 do_litem :: ExportAccum -> LIE GhcPs -> RnM ExportAccum
210 do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
211
212 -- Maps a parent to its in-scope children
213 kids_env :: NameEnv [GlobalRdrElt]
214 kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
215
216
217 imported_modules = [ imv_name imv
218 | xs <- moduleEnvElts $ imp_mods imports
219 , imv <- importedByUser xs ]
220
221 exports_from_item :: ExportAccum -> LIE GhcPs -> RnM ExportAccum
222 exports_from_item acc@(ExportAccum ie_avails occs)
223 (L loc (IEModuleContents (L lm mod)))
224 | let earlier_mods = [ mod
225 | ((L _ (IEModuleContents (L _ mod))), _) <- ie_avails ]
226 , mod `elem` earlier_mods -- Duplicate export of M
227 = do { warnIfFlag Opt_WarnDuplicateExports True
228 (dupModuleExport mod) ;
229 return acc }
230
231 | otherwise
232 = do { let { exportValid = (mod `elem` imported_modules)
233 || (moduleName this_mod == mod)
234 ; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
235 ; new_exports = map (availFromGRE . fst) gre_prs
236 ; names = map (gre_name . fst) gre_prs
237 ; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
238 }
239
240 ; checkErr exportValid (moduleNotImported mod)
241 ; warnIfFlag Opt_WarnDodgyExports
242 (exportValid && null gre_prs)
243 (nullModuleExport mod)
244
245 ; traceRn "efa" (ppr mod $$ ppr all_gres)
246 ; addUsedGREs all_gres
247
248 ; occs' <- check_occs (IEModuleContents (noLoc mod)) occs names
249 -- This check_occs not only finds conflicts
250 -- between this item and others, but also
251 -- internally within this item. That is, if
252 -- 'M.x' is in scope in several ways, we'll have
253 -- several members of mod_avails with the same
254 -- OccName.
255 ; traceRn "export_mod"
256 (vcat [ ppr mod
257 , ppr new_exports ])
258
259 ; return (ExportAccum (((L loc (IEModuleContents (L lm mod))), new_exports) : ie_avails)
260 occs') }
261
262 exports_from_item acc@(ExportAccum lie_avails occs) (L loc ie)
263 | isDoc ie
264 = do new_ie <- lookup_doc_ie ie
265 return (ExportAccum ((L loc new_ie, []) : lie_avails) occs)
266
267 | otherwise
268 = do (new_ie, avail) <-
269 setSrcSpan loc $ lookup_ie ie
270 if isUnboundName (ieName new_ie)
271 then return acc -- Avoid error cascade
272 else do
273
274 occs' <- check_occs ie occs (availNames avail)
275
276 return (ExportAccum ((L loc new_ie, [avail]) : lie_avails) occs')
277
278 -------------
279 lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)
280 lookup_ie (IEVar (L l rdr))
281 = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
282 return (IEVar (L l (replaceWrappedName rdr name)), avail)
283
284 lookup_ie (IEThingAbs (L l rdr))
285 = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
286 return (IEThingAbs (L l (replaceWrappedName rdr name)), avail)
287
288 lookup_ie ie@(IEThingAll n')
289 = do
290 (n, avail, flds) <- lookup_ie_all ie n'
291 let name = unLoc n
292 return (IEThingAll (replaceLWrappedName n' (unLoc n))
293 , AvailTC name (name:avail) flds)
294
295
296 lookup_ie ie@(IEThingWith l wc sub_rdrs _)
297 = do
298 (lname, subs, avails, flds)
299 <- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs
300 (_, all_avail, all_flds) <-
301 case wc of
302 NoIEWildcard -> return (lname, [], [])
303 IEWildcard _ -> lookup_ie_all ie l
304 let name = unLoc lname
305 return (IEThingWith (replaceLWrappedName l name) wc subs
306 (flds ++ (map noLoc all_flds)),
307 AvailTC name (name : avails ++ all_avail)
308 (map unLoc flds ++ all_flds))
309
310
311 lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
312
313
314 lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
315 -> RnM (Located Name, [LIEWrappedName Name], [Name],
316 [Located FieldLabel])
317 lookup_ie_with (L l rdr) sub_rdrs
318 = do name <- lookupGlobalOccRn $ ieWrappedName rdr
319 (non_flds, flds) <- lookupChildrenExport name sub_rdrs
320 if isUnboundName name
321 then return (L l name, [], [name], [])
322 else return (L l name, non_flds
323 , map (ieWrappedName . unLoc) non_flds
324 , flds)
325
326 lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName
327 -> RnM (Located Name, [Name], [FieldLabel])
328 lookup_ie_all ie (L l rdr) =
329 do name <- lookupGlobalOccRn $ ieWrappedName rdr
330 let gres = findChildren kids_env name
331 (non_flds, flds) = classifyGREs gres
332 addUsedKids (ieWrappedName rdr) gres
333 warnDodgyExports <- woptM Opt_WarnDodgyExports
334 when (null gres) $
335 if isTyConName name
336 then when warnDodgyExports $
337 addWarn (Reason Opt_WarnDodgyExports)
338 (dodgyExportWarn name)
339 else -- This occurs when you export T(..), but
340 -- only import T abstractly, or T is a synonym.
341 addErr (exportItemErr ie)
342 return (L l name, non_flds, flds)
343
344 -------------
345 lookup_doc_ie :: IE GhcPs -> RnM (IE GhcRn)
346 lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
347 return (IEGroup lev rn_doc)
348 lookup_doc_ie (IEDoc doc) = do rn_doc <- rnHsDoc doc
349 return (IEDoc rn_doc)
350 lookup_doc_ie (IEDocNamed str) = return (IEDocNamed str)
351 lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier
352
353 -- In an export item M.T(A,B,C), we want to treat the uses of
354 -- A,B,C as if they were M.A, M.B, M.C
355 -- Happily pickGREs does just the right thing
356 addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
357 addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
358
359 classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
360 classifyGREs = partitionEithers . map classifyGRE
361
362 classifyGRE :: GlobalRdrElt -> Either Name FieldLabel
363 classifyGRE gre = case gre_par gre of
364 FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False n)
365 FldParent _ (Just lbl) -> Right (FieldLabel lbl True n)
366 _ -> Left n
367 where
368 n = gre_name gre
369
370 isDoc :: IE GhcPs -> Bool
371 isDoc (IEDoc _) = True
372 isDoc (IEDocNamed _) = True
373 isDoc (IEGroup _ _) = True
374 isDoc _ = False
375
376 -- Renaming and typechecking of exports happens after everything else has
377 -- been typechecked.
378
379
380
381 -- Renaming exports lists is a minefield. Five different things can appear in
382 -- children export lists ( T(A, B, C) ).
383 -- 1. Record selectors
384 -- 2. Type constructors
385 -- 3. Data constructors
386 -- 4. Pattern Synonyms
387 -- 5. Pattern Synonym Selectors
388 --
389 -- However, things get put into weird name spaces.
390 -- 1. Some type constructors are parsed as variables (-.->) for example.
391 -- 2. All data constructors are parsed as type constructors
392 -- 3. When there is ambiguity, we default type constructors to data
393 -- constructors and require the explicit `type` keyword for type
394 -- constructors.
395 --
396 -- This function first establishes the possible namespaces that an
397 -- identifier might be in (`choosePossibleNameSpaces`).
398 --
399 -- Then for each namespace in turn, tries to find the correct identifier
400 -- there returning the first positive result or the first terminating
401 -- error.
402 --
403
404
405
406 lookupChildrenExport :: Name -> [LIEWrappedName RdrName]
407 -> RnM ([LIEWrappedName Name], [Located FieldLabel])
408 lookupChildrenExport parent rdr_items =
409 do
410 xs <- mapAndReportM doOne rdr_items
411 return $ partitionEithers xs
412 where
413 -- Pick out the possible namespaces in order of priority
414 -- This is a consequence of how the parser parses all
415 -- data constructors as type constructors.
416 choosePossibleNamespaces :: NameSpace -> [NameSpace]
417 choosePossibleNamespaces ns
418 | ns == varName = [varName, tcName]
419 | ns == tcName = [dataName, tcName]
420 | otherwise = [ns]
421 -- Process an individual child
422 doOne :: LIEWrappedName RdrName
423 -> RnM (Either (LIEWrappedName Name) (Located FieldLabel))
424 doOne n = do
425
426 let bareName = (ieWrappedName . unLoc) n
427 lkup v = lookupSubBndrOcc_helper False True
428 parent (setRdrNameSpace bareName v)
429
430 name <- combineChildLookupResult . map lkup $
431 choosePossibleNamespaces (rdrNameSpace bareName)
432 traceRn "lookupChildrenExport" (ppr name)
433 -- Default to data constructors for slightly better error
434 -- messages
435 let unboundName :: RdrName
436 unboundName = if rdrNameSpace bareName == varName
437 then bareName
438 else setRdrNameSpace bareName dataName
439
440 -- Might need to check here for FLs as well
441 name' <- case name of
442 FoundName NoParent n -> checkPatSynParent parent n
443 _ -> return name
444
445 traceRn "lookupChildrenExport" (ppr name')
446
447 case name' of
448 NameNotFound -> do { ub <- reportUnboundName unboundName
449 ; let l = getLoc n
450 ; return (Left (L l (IEName (L l ub))))}
451 FoundFL fls -> return $ Right (L (getLoc n) fls)
452 FoundName _p name -> return $ Left (replaceLWrappedName n name)
453 NameErr err_msg -> reportError err_msg >> failM
454 IncorrectParent p g td gs -> do
455 mkDcErrMsg p g td gs >>= reportError
456 failM
457
458
459 -- | Also captures the current context
460 mkNameErr :: SDoc -> TcM ChildLookupResult
461 mkNameErr errMsg = NameErr <$> mkErrTc errMsg
462
463
464
465 --
466 -- Note: [Typing Pattern Synonym Exports]
467 -- It proved quite a challenge to precisely specify which pattern synonyms
468 -- should be allowed to be bundled with which type constructors.
469 -- In the end it was decided to be quite liberal in what we allow. Below is
470 -- how Simon described the implementation.
471 --
472 -- "Personally I think we should Keep It Simple. All this talk of
473 -- satisfiability makes me shiver. I suggest this: allow T( P ) in all
474 -- situations except where `P`'s type is ''visibly incompatible'' with
475 -- `T`.
476 --
477 -- What does "visibly incompatible" mean? `P` is visibly incompatible
478 -- with
479 -- `T` if
480 -- * `P`'s type is of form `... -> S t1 t2`
481 -- * `S` is a data/newtype constructor distinct from `T`
482 --
483 -- Nothing harmful happens if we allow `P` to be exported with
484 -- a type it can't possibly be useful for, but specifying a tighter
485 -- relationship is very awkward as you have discovered."
486 --
487 -- Note that this allows *any* pattern synonym to be bundled with any
488 -- datatype type constructor. For example, the following pattern `P` can be
489 -- bundled with any type.
490 --
491 -- ```
492 -- pattern P :: (A ~ f) => f
493 -- ```
494 --
495 -- So we provide basic type checking in order to help the user out, most
496 -- pattern synonyms are defined with definite type constructors, but don't
497 -- actually prevent a library author completely confusing their users if
498 -- they want to.
499 --
500 -- So, we check for exactly four things
501 -- 1. The name arises from a pattern synonym definition. (Either a pattern
502 -- synonym constructor or a pattern synonym selector)
503 -- 2. The pattern synonym is only bundled with a datatype or newtype.
504 -- 3. Check that the head of the result type constructor is an actual type
505 -- constructor and not a type variable. (See above example)
506 -- 4. Is so, check that this type constructor is the same as the parent
507 -- type constructor.
508 --
509 --
510 -- Note: [Types of TyCon]
511 --
512 -- This check appears to be overlly complicated, Richard asked why it
513 -- is not simply just `isAlgTyCon`. The answer for this is that
514 -- a classTyCon is also an `AlgTyCon` which we explicitly want to disallow.
515 -- (It is either a newtype or data depending on the number of methods)
516 --
517
518 -- | Given a resolved name in the children export list and a parent. Decide
519 -- whether we are allowed to export the child with the parent.
520 -- Invariant: gre_par == NoParent
521 -- See note [Typing Pattern Synonym Exports]
522 checkPatSynParent :: Name -- ^ Type constructor
523 -> Name -- ^ Either a
524 -- a) Pattern Synonym Constructor
525 -- b) A pattern synonym selector
526 -> TcM ChildLookupResult
527 checkPatSynParent parent mpat_syn
528 | isUnboundName parent -- Avoid an error cascade
529 = return (FoundName NoParent mpat_syn)
530 | otherwise = do
531 parent_ty_con <- tcLookupTyCon parent
532 mpat_syn_thing <- tcLookupGlobal mpat_syn
533 let expected_res_ty =
534 mkTyConApp parent_ty_con (mkTyVarTys (tyConTyVars parent_ty_con))
535
536 handlePatSyn errCtxt =
537 addErrCtxt errCtxt
538 . tc_one_ps_export_with expected_res_ty parent_ty_con
539 -- 1. Check that the Id was actually from a thing associated with patsyns
540 case mpat_syn_thing of
541 AnId i
542 | isId i ->
543 case idDetails i of
544 RecSelId { sel_tycon = RecSelPatSyn p } -> handlePatSyn (selErr i) p
545 _ -> NameErr <$> mkDcErrMsg parent mpat_syn (ppr mpat_syn) []
546 AConLike (PatSynCon p) -> handlePatSyn (psErr p) p
547 _ -> NameErr <$> mkDcErrMsg parent mpat_syn (ppr mpat_syn) []
548 where
549
550 psErr = exportErrCtxt "pattern synonym"
551 selErr = exportErrCtxt "pattern synonym record selector"
552
553 assocClassErr :: SDoc
554 assocClassErr =
555 text "Pattern synonyms can be bundled only with datatypes."
556
557 tc_one_ps_export_with :: TcTauType -- ^ TyCon type
558 -> TyCon -- ^ Parent TyCon
559 -> PatSyn -- ^ Corresponding bundled PatSyn
560 -- and pretty printed origin
561 -> TcM ChildLookupResult
562 tc_one_ps_export_with expected_res_ty ty_con pat_syn
563
564 -- 2. See note [Types of TyCon]
565 | not $ isTyConWithSrcDataCons ty_con = mkNameErr assocClassErr
566 -- 3. Is the head a type variable?
567 | Nothing <- mtycon = return (FoundName (ParentIs parent) mpat_syn)
568 -- 4. Ok. Check they are actually the same type constructor.
569 | Just p_ty_con <- mtycon, p_ty_con /= ty_con = mkNameErr typeMismatchError
570 -- 5. We passed!
571 | otherwise = return (FoundName (ParentIs parent) mpat_syn)
572
573 where
574 (_, _, _, _, _, res_ty) = patSynSig pat_syn
575 mtycon = fst <$> tcSplitTyConApp_maybe res_ty
576 typeMismatchError :: SDoc
577 typeMismatchError =
578 text "Pattern synonyms can only be bundled with matching type constructors"
579 $$ text "Couldn't match expected type of"
580 <+> quotes (ppr expected_res_ty)
581 <+> text "with actual type of"
582 <+> quotes (ppr res_ty)
583
584
585
586
587 {-===========================================================================-}
588
589
590 check_occs :: IE GhcPs -> ExportOccMap -> [Name] -> RnM ExportOccMap
591 check_occs ie occs names -- 'names' are the entities specifed by 'ie'
592 = foldlM check occs names
593 where
594 check occs name
595 = case lookupOccEnv occs name_occ of
596 Nothing -> return (extendOccEnv occs name_occ (name, ie))
597
598 Just (name', ie')
599 | name == name' -- Duplicate export
600 -- But we don't want to warn if the same thing is exported
601 -- by two different module exports. See ticket #4478.
602 -> do { warnIfFlag Opt_WarnDuplicateExports
603 (not (dupExport_ok name ie ie'))
604 (dupExportWarn name_occ ie ie')
605 ; return occs }
606
607 | otherwise -- Same occ name but different names: an error
608 -> do { global_env <- getGlobalRdrEnv ;
609 addErr (exportClashErr global_env name' name ie' ie) ;
610 return occs }
611 where
612 name_occ = nameOccName name
613
614
615 dupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool
616 -- The Name is exported by both IEs. Is that ok?
617 -- "No" iff the name is mentioned explicitly in both IEs
618 -- or one of the IEs mentions the name *alone*
619 -- "Yes" otherwise
620 --
621 -- Examples of "no": module M( f, f )
622 -- module M( fmap, Functor(..) )
623 -- module M( module Data.List, head )
624 --
625 -- Example of "yes"
626 -- module M( module A, module B ) where
627 -- import A( f )
628 -- import B( f )
629 --
630 -- Example of "yes" (Trac #2436)
631 -- module M( C(..), T(..) ) where
632 -- class C a where { data T a }
633 -- instance C Int where { data T Int = TInt }
634 --
635 -- Example of "yes" (Trac #2436)
636 -- module Foo ( T ) where
637 -- data family T a
638 -- module Bar ( T(..), module Foo ) where
639 -- import Foo
640 -- data instance T Int = TInt
641
642 dupExport_ok n ie1 ie2
643 = not ( single ie1 || single ie2
644 || (explicit_in ie1 && explicit_in ie2) )
645 where
646 explicit_in (IEModuleContents _) = False -- module M
647 explicit_in (IEThingAll r)
648 = nameOccName n == rdrNameOcc (ieWrappedName $ unLoc r) -- T(..)
649 explicit_in _ = True
650
651 single IEVar {} = True
652 single IEThingAbs {} = True
653 single _ = False
654
655
656 dupModuleExport :: ModuleName -> SDoc
657 dupModuleExport mod
658 = hsep [text "Duplicate",
659 quotes (text "Module" <+> ppr mod),
660 text "in export list"]
661
662 moduleNotImported :: ModuleName -> SDoc
663 moduleNotImported mod
664 = text "The export item `module" <+> ppr mod <>
665 text "' is not imported"
666
667 nullModuleExport :: ModuleName -> SDoc
668 nullModuleExport mod
669 = text "The export item `module" <+> ppr mod <> ptext (sLit "' exports nothing")
670
671
672 dodgyExportWarn :: Name -> SDoc
673 dodgyExportWarn item
674 = dodgyMsg (text "export") item (dodgyMsgInsert item :: IE GhcRn)
675
676 exportErrCtxt :: Outputable o => String -> o -> SDoc
677 exportErrCtxt herald exp =
678 text "In the" <+> text (herald ++ ":") <+> ppr exp
679
680
681 addExportErrCtxt :: (OutputableBndrId s) => IE s -> TcM a -> TcM a
682 addExportErrCtxt ie = addErrCtxt exportCtxt
683 where
684 exportCtxt = text "In the export:" <+> ppr ie
685
686 exportItemErr :: IE GhcPs -> SDoc
687 exportItemErr export_item
688 = sep [ text "The export item" <+> quotes (ppr export_item),
689 text "attempts to export constructors or class methods that are not visible here" ]
690
691
692 dupExportWarn :: OccName -> IE GhcPs -> IE GhcPs -> SDoc
693 dupExportWarn occ_name ie1 ie2
694 = hsep [quotes (ppr occ_name),
695 text "is exported by", quotes (ppr ie1),
696 text "and", quotes (ppr ie2)]
697
698 dcErrMsg :: Name -> String -> SDoc -> [SDoc] -> SDoc
699 dcErrMsg ty_con what_is thing parents =
700 text "The type constructor" <+> quotes (ppr ty_con)
701 <+> text "is not the parent of the" <+> text what_is
702 <+> quotes thing <> char '.'
703 $$ text (capitalise what_is)
704 <> text "s can only be exported with their parent type constructor."
705 $$ (case parents of
706 [] -> empty
707 [_] -> text "Parent:"
708 _ -> text "Parents:") <+> fsep (punctuate comma parents)
709
710 mkDcErrMsg :: Name -> Name -> SDoc -> [Name] -> TcM ErrMsg
711 mkDcErrMsg parent thing thing_doc parents = do
712 ty_thing <- tcLookupGlobal thing
713 mkErrTc $
714 dcErrMsg parent (tyThingCategory' ty_thing) thing_doc (map ppr parents)
715 where
716 tyThingCategory' :: TyThing -> String
717 tyThingCategory' (AnId i)
718 | isRecordSelector i = "record selector"
719 tyThingCategory' i = tyThingCategory i
720
721
722 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE GhcPs -> IE GhcPs
723 -> MsgDoc
724 exportClashErr global_env name1 name2 ie1 ie2
725 = vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon
726 , ppr_export ie1' name1'
727 , ppr_export ie2' name2' ]
728 where
729 occ = nameOccName name1
730 ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> text "exports" <+>
731 quotes (ppr name))
732 2 (pprNameProvenance (get_gre name)))
733
734 -- get_gre finds a GRE for the Name, so that we can show its provenance
735 get_gre name
736 = fromMaybe (pprPanic "exportClashErr" (ppr name)) (lookupGRE_Name global_env name)
737 get_loc name = greSrcSpan (get_gre name)
738 (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2
739 then (name1, ie1, name2, ie2)
740 else (name2, ie2, name1, ie1)