Warning messages

Output a warning when filtering out data/type instances and associated types
in instances. We don't show these in the documentation yet, and we need to
let the user know.

1 files changed, 34 insertions, 7 deletions

diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 7320af21..a72c7ce3 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -55,18 +55,21 @@ createInterface ghcMod flags modMap = do
       localNames    = ghcDefinedNames ghcMod
       subMap        = mkSubMap group
       decls         = topDecls group
-      declMap       = mkDeclMap decls
-      famMap        = Map.empty --mkFamMap decls
+      decls'        = filterOutInstances decls
+      declMap       = mkDeclMap decls'
+      famMap        = Map.empty --mkFamMap decls'
       ignoreExps    = Flag_IgnoreAllExports `elem` flags
       exportedNames = ghcExportedNames ghcMod
       origEnv       = Map.fromList [ (nameOccName n, n) | n <- exportedNames ]
       instances     = ghcInstances ghcMod
 
+  warnAboutFilteredDecls mod decls
+
   visibleNames <- mkVisibleNames mod modMap localNames 
                                  (ghcNamesInScope ghcMod) 
                                  subMap exports opts declMap 
 
-  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod)decls declMap
+  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls' declMap
                                famMap subMap opts exports ignoreExps instances
 
   -- prune the export list to just those declarations that have
@@ -212,14 +215,15 @@ declName (SigD sig) = fromJust $ sigNameNoLoc sig
 
 -- All the top-level declarations of a module, ordered by source location,
 -- with documentation attached if it exists.
--- TEMP hack to filter out all instances (we don't want them until
--- rendering is completely implemented).
 topDecls :: HsGroup Name -> [DeclWithDoc] 
-topDecls = filter (\(L _ d, _) -> not (isInstance d)) . collectDocs . sortByLoc . declsFromGroup
+topDecls = collectDocs . sortByLoc . declsFromGroup    
+
+
+filterOutInstances = filter (\(L _ d, _) -> not (isInstance d))
 
 
 -- | Pick out the declarations that we want from a group
-declsFromGroup :: HsGroup Name -> [LHsDecl Name] 
+declsFromGroup :: HsGroup Name -> [LHsDecl Name]
 declsFromGroup group = 
   decls hs_tyclds TyClD group ++
   decls hs_fords  ForD  group ++
@@ -239,6 +243,29 @@ decls field con struct = [ L loc (con decl) | L loc decl <- field struct ]
 sortByLoc = sortBy (comparing getLoc)
 
 
+warnAboutFilteredDecls mod decls = do
+  let modStr = moduleString mod
+  let typeInstances =
+        nub [ tcdName d | (L _ (TyClD d), _) <- decls, isFamInstDecl d ]
+
+  when (not $null typeInstances) $
+    tell $ nub [
+      "Warning: " ++ modStr ++ ": Instances of type and data "
+      ++ "families are not yet supported. Instances of the following families "
+      ++ "will be filtered out:\n  " ++ (concat $ intersperse ", "
+      $ map (occNameString . nameOccName) typeInstances) ]
+
+  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _) <- decls
+                                 , not (null ats) ]
+
+  when (not $ null instances) $
+
+    tell $ nub $ [
+      "Warning: " ++ modStr ++ ": Rendering of associated types for instances has "
+      ++ "not yet been implemented. Associated types will not be shown for the "
+      ++ "following instances:\n" ++ (concat $ intersperse ", " instances) ]
+
+
 --------------------------------------------------------------------------------
 -- Instances
 --------------------------------------------------------------------------------