From 202f6995495614a329cb79c91a56384492239df3 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Mon, 8 Dec 2008 23:19:48 +0000
Subject: Make visible names from ExportItems

Instead of a complicated calculation of visible names out of GHC's export
items, we can get them straight out of the already calculated ExportItems.  The
ExportItems should represent exactly those items that are visible in an
interface.

If store all the exported sub-names in ExportDecl instead of only those with
documentation, the calculation becomes very simple. So we do this change as
well (should perhaps have been a separate patch).

This should fix the problem with names from ghc-prim not appearing in the link
environment.
---
 src/Haddock/Interface/Create.hs | 76 ++++++++++-------------------------------
 src/Haddock/Interface/Rename.hs |  2 +-
 2 files changed, 19 insertions(+), 59 deletions(-)

(limited to 'src/Haddock/Interface')

diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index b7c82267..a5bbff3c 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -62,13 +62,11 @@ createInterface ghcMod flags modMap = do
 
   warnAboutFilteredDecls mod decls0
 
-  visibleNames <- mkVisibleNames mod modMap localNames 
-                                 (ghcNamesInScope ghcMod) 
-                                 exports opts declMap 
-
   exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls declMap
                                opts exports ignoreExps instances
 
+  let visibleNames = mkVisibleNames exportItems
+  
   -- prune the export list to just those declarations that have
   -- documentation, if the 'prune' option is on.
   let 
@@ -377,15 +375,13 @@ mkExportItems modMap this_mod exported_names decls declMap
         t `notElem` declATs (unL decl) = return [ mkExportDecl t x ]
       | otherwise = return []
 
-
     mkExportDecl :: Name -> DeclInfo -> ExportItem Name
     mkExportDecl n (decl, doc, subs) = decl'
       where
-        decl' = ExportDecl (restrictTo subs' (extractDecl n mdl decl)) doc subdocs []
+        decl' = ExportDecl (restrictTo sub_names (extractDecl n mdl decl)) doc subs' []
         mdl = nameModule n
-        subs' = filter (`elem` exported_names) $ map fst subs
-        subdocs = [ (n, doc) | (n, Just doc) <- subs ]
-
+        subs' = filter ((`elem` exported_names) . fst) subs
+        sub_names = map fst subs'
 
     fullContentsOf m  
 	| m == this_mod = return (fullContentsOfThisModule this_mod decls)
@@ -412,8 +408,7 @@ fullContentsOfThisModule module_ decls = catMaybes (map mkExportItem decls)
   where
     mkExportItem (L _ (DocD (DocGroup lev doc)), _, _) = Just $ ExportGroup lev "" doc
     mkExportItem (L _ (DocD (DocCommentNamed _ doc)), _, _)   = Just $ ExportDoc doc
-    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subdocs []
-      where subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subs []
 
 --    mkExportItem _ = Nothing -- TODO: see if this is really needed
 
@@ -486,53 +481,18 @@ pruneExportItems items = filter hasDoc items
 	hasDoc _ = True
 
 
--- | Gather a list of original names exported from this module
-mkVisibleNames :: Module 
-             -> ModuleMap
-             -> [Name] 
-             -> [Name]
-             -> Maybe [IE Name]
-             -> [DocOption]
-             -> Map Name DeclInfo
-             -> ErrMsgM [Name]
-
-mkVisibleNames mdl modMap localNames scope maybeExps opts declMap 
-  -- if no export list, just return all local names 
-  | Nothing <- maybeExps         = return (filter hasDecl localNames)
-  | OptIgnoreExports `elem` opts = return localNames
-  | Just expspecs <- maybeExps = do
-      visibleNames <- mapM extract expspecs
-      return $ filter isNotPackageName (concat visibleNames)
- where
-  hasDecl name = isJust (Map.lookup name declMap)
-  isNotPackageName name = nameMod == mdl || isJust (Map.lookup nameMod modMap)
-    where nameMod = nameModule name
-
-  extract e = 
-   case e of
-    IEVar x -> return [x]
-    IEThingAbs t -> return [t]
-    IEThingAll t -> return (t : all_subs)
-	 where
-	      all_subs | nameModule t == mdl = subsOfName t declMap
-		       | otherwise = allSubsOfName modMap t
-
-    IEThingWith t cs -> return (t : cs)
-	
-    IEModuleContents m
-	| mkModule (modulePackageId mdl) m == mdl -> return localNames 
-	| otherwise -> let m' = mkModule (modulePackageId mdl) m in
-	  case Map.lookup m' modMap of
-	    Just mod
-		| OptHide `elem` ifaceOptions mod ->
-		    return (filter (`elem` scope) (ifaceExports mod))
-		| otherwise -> return []
-	    Nothing
-		-> tell (exportModuleMissingErr mdl m') >> return []
-  
-    _ -> return []
-
-
+mkVisibleNames :: [ExportItem Name] -> [Name]
+mkVisibleNames exports = concatMap exportName exports
+  where
+    exportName e@ExportDecl {} =
+      case getMainDeclBinder $ unL $ expItemDecl e of
+        Just n -> n : subs
+        Nothing -> subs
+      where subs = map fst (expItemSubDocs e) 
+    exportName e@ExportNoDecl {} = expItemName e : expItemSubs e
+    exportName _ = []
+
+      
 exportModuleMissingErr this mdl 
   = ["Warning: in export list of " ++ show (moduleString this)
 	 ++ ": module not found: " ++ show (moduleString mdl)]
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 0e0da5a6..3eb52d8f 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -416,5 +416,5 @@ renameExportItem item = case item of
 
 renameSub (n,doc) = do
   n' <- rename n
-  doc' <- renameDoc doc
+  doc' <- mapM renameDoc doc
   return (n', doc')
-- 
cgit v1.2.3