[haddock @ 2002-04-10 13:26:09 by simonmar]

Lots of changes, including:

- add index support to the HTML backend
- clean up the renamer, put it into a monad
- propogate unresolved names to the top level and report them in a nicer way
- various bugfixes

3 files changed, 330 insertions, 139 deletions

diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index ea6d3f73..277e45c4 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -11,7 +11,7 @@ import HaddockVersion
 import HaddockTypes
 import HsSyn
 
-import Maybe	( fromJust, isNothing )
+import Maybe	( fromJust, isNothing, isJust )
 import FiniteMap
 import List 	( sortBy )
 import Char	( toUpper, toLower )
@@ -283,24 +283,39 @@ ifaceToHtml mod iface
   | null exports = Html.emptyTable
   | otherwise =
     td << table ! [width "100%", cellpadding 0, cellspacing 15] << 
-	(body1 </> body2)
- where exports = iface_exports iface
-       doc_map = iface_name_docs iface
+	(description </> synopsis </> maybe_hr </> body)
+  where 
+	exports = iface_exports iface
+	doc_map = iface_name_docs iface
 
-       body1
+	has_doc (ExportDecl d)
+	 | Just x <- declMainBinder d = isJust (lookupFM doc_map x)
+	has_doc _ = True
+
+	no_doc_at_all = not (any has_doc exports)
+
+	description
          | Just doc <- iface_doc iface
          = (tda [theclass "section1"] << toHtml "Description") </>
 	   docBox (markup htmlMarkup doc)
 	 | otherwise
 	 = Html.emptyTable
 
-       body2 =
-         (tda [theclass "section1"] << toHtml "Synopsis") </>
-         (tda [width "100%", theclass "synopsis"] << 
-  	   table ! [width "100%", cellpadding 0, cellspacing 8, border 0] << 
-  	     aboves (map (processExport doc_map True)  exports)) </>
-         td << hr </>
-           aboves (map (processExport doc_map False) exports)
+	-- omit the synopsis if there are no documentation annotations at all
+	synopsis
+	  | no_doc_at_all = Html.emptyTable
+	  | otherwise
+	  = (tda [theclass "section1"] << toHtml "Synopsis") </>
+            (tda [width "100%", theclass "synopsis"] << 
+  	      table ! [width "100%", cellpadding 0, cellspacing 8, border 0] << 
+  	        aboves (map (processExport doc_map True)  exports))
+
+	maybe_hr
+	     | not (no_doc_at_all),  ExportGroup 1 _ <- head exports
+		 = td << hr
+	     | otherwise  = Html.emptyTable
+
+	body = aboves (map (processExport doc_map False) exports)
 
 processExport :: FiniteMap HsName Doc -> Bool -> ExportItem -> HtmlTable
 processExport doc_map summary (ExportGroup lev doc)
@@ -349,11 +364,12 @@ doDecl doc_map summary decl = do_decl decl
 		 ++ map ppHsName args) <+> equals <+> ppHsType ty)
 
      do_decl (HsNewTypeDecl loc ctx nm args con drv)
-	= ppHsDataDecl doc_map summary (HsDataDecl loc ctx nm args [con] drv)
+	= ppHsDataDecl doc_map summary True{-is newtype-}
+		(HsDataDecl loc ctx nm args [con] drv)
 	  -- print it as a single-constructor datatype
 
      do_decl decl@(HsDataDecl loc ctx nm args cons drv) 
-	= ppHsDataDecl doc_map summary decl
+	= ppHsDataDecl doc_map summary False{-not newtype-} decl
 
      do_decl decl@(HsClassDecl _ _ _)
 	= ppHsClassDecl doc_map summary decl
@@ -377,15 +393,17 @@ keepDecl _ = False
 -- -----------------------------------------------------------------------------
 -- Data & newtype declarations
 
-ppShortDataDecl doc_map summary (HsDataDecl loc ctx nm args [con] drv) =
+ppShortDataDecl doc_map summary is_newty 
+	(HsDataDecl loc ctx nm args [con] drv) =
    declBox (  -- single constructor special case
-      ppHsDataHeader summary nm args      
+      ppHsDataHeader summary is_newty nm args      
       <+> equals <+> ppShortConstr summary con
    )
-ppShortDataDecl doc_map summary (HsDataDecl loc ctx nm args cons drv) = 
+ppShortDataDecl doc_map summary is_newty
+	(HsDataDecl loc ctx nm args cons drv) = 
    declBox << vanillaTable << (
      aboves (
-	(declBox (ppHsDataHeader summary nm args) :
+	(declBox (ppHsDataHeader summary is_newty nm args) :
  	zipWith do_constr ('=':repeat '|') cons
      )
     )
@@ -395,20 +413,20 @@ ppShortDataDecl doc_map summary (HsDataDecl loc ctx nm args cons drv) =
 
 -- First, the abstract case:
 
-ppHsDataDecl doc_map summary (HsDataDecl loc ctx nm args [] drv) = 
+ppHsDataDecl doc_map summary is_newty (HsDataDecl loc ctx nm args [] drv) = 
    declWithDoc summary (lookupFM doc_map nm)
-     (ppHsDataHeader summary nm args)
+     (ppHsDataHeader summary is_newty nm args)
 
 -- The rest of the cases:
 
-ppHsDataDecl doc_map summary decl@(HsDataDecl loc ctx nm args cons drv)
+ppHsDataDecl doc_map summary is_newty decl@(HsDataDecl loc ctx nm args cons drv)
   | summary || (isNothing doc && all constr_has_no_doc cons)
-	= ppShortDataDecl doc_map summary decl
+	= ppShortDataDecl doc_map summary is_newty decl
 
   | otherwise
         = td << vanillaTable << (header </> datadoc </> constrs)
   where
-	header = declBox (ppHsDataHeader False nm args)
+	header = declBox (ppHsDataHeader False is_newty nm args)
 	datadoc = docBox (markup htmlMarkup (fromJust doc))
 
 	constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors"
@@ -428,6 +446,8 @@ ppHsDataDecl doc_map summary decl@(HsDataDecl loc ctx nm args cons drv)
 
 	constr_has_no_doc (HsConDecl _ nm _ _) 
 	   = isNothing (lookupFM doc_map nm)
+	constr_has_no_doc (HsRecDecl _ nm _ _) 
+	   = isNothing (lookupFM doc_map nm)
 
 
 ppShortConstr :: Bool -> HsConDecl -> Html
@@ -475,8 +495,9 @@ ppFullField _ _ = error "ppFullField"
 
 expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ]
 
-ppHsDataHeader summary nm args = 
-  keyword "data" <+> ppHsBinder summary nm <+> hsep (map ppHsName args)
+ppHsDataHeader summary is_newty nm args = 
+  (if is_newty then keyword "newtype" else keyword "data") <+> 
+	ppHsBinder summary nm <+> hsep (map ppHsName args)
 
 ppHsBangType :: HsBangType -> Html
 ppHsBangType (HsBangedTy ty) = char '!' +++ ppHsAType ty
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
new file mode 100644
index 00000000..4c5a631b
--- /dev/null
+++ b/src/HaddockRename.hs
@@ -0,0 +1,199 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2002
+--
+
+module HaddockRename (
+	RnM, runRn, runRnFM,	-- the monad (instance of Monad)
+
+	renameExportList, 
+	renameDecl,
+	renameExportItems,
+	renameDoc, resolveDoc,
+  ) where
+
+import HaddockTypes
+import HsSyn
+
+import FiniteMap
+import Monad
+
+-- -----------------------------------------------------------------------------
+-- Monad for renaming
+
+-- The monad does two things for us: it passes around the environment for
+-- renaming, and it returns a list of names which couldn't be found in 
+-- the environment.
+
+newtype GenRnM n a = RnM {unRn :: (n -> Maybe HsQName) -> (a,[n])}
+
+type RnM a = GenRnM HsQName a
+
+instance Monad (GenRnM n) where
+  (>>=) = thenRn
+  return = returnRn   
+
+returnRn a   = RnM (\lkp -> (a,[]))
+m `thenRn` k = RnM (\lkp -> case unRn m lkp of 
+				(a,out1) -> case unRn (k a) lkp of
+						(b,out2) -> (b,out1++out2))
+
+getLookupRn = RnM (\lkp -> (lkp,[]))
+outRn name = RnM (\lkp -> ((),[name]))
+
+lookupRn :: (HsQName -> a) -> HsQName -> RnM a
+lookupRn and_then name = do
+  lkp <- getLookupRn
+  case lkp name of
+	Nothing -> do outRn name; return (and_then name)
+	Just maps_to -> return (and_then maps_to)
+
+runRnFM :: FiniteMap HsQName HsQName -> RnM a -> (a,[HsQName])
+runRnFM env rn = unRn rn (lookupFM env)
+
+runRn :: (n -> Maybe HsQName) -> GenRnM n a -> (a,[n])
+runRn lkp rn = unRn rn lkp
+
+-- -----------------------------------------------------------------------------
+-- Renaming source code & documentation
+
+renameExportList :: [HsExportSpec] -> RnM [HsExportSpec]
+renameExportList spec = mapM renameExport spec
+  where
+    renameExport (HsEVar x) = lookupRn HsEVar x
+    renameExport (HsEAbs x) = lookupRn HsEAbs x
+    renameExport (HsEThingAll x) = lookupRn HsEThingAll x
+    renameExport (HsEThingWith x cs)
+	= do cs' <- mapM (lookupRn id) cs
+	     lookupRn (\x' -> HsEThingWith x' cs') x
+    renameExport (HsEModuleContents m) = return (HsEModuleContents m)
+    renameExport (HsEGroup lev str) = return (HsEGroup lev str)
+
+renameDecl :: HsDecl -> RnM HsDecl
+renameDecl decl
+  = case decl of
+	HsTypeDecl loc t args ty -> do
+	    ty <- renameType ty
+	    return (HsTypeDecl loc t args ty)
+	HsDataDecl loc ctx t args cons drv -> do
+	    cons <- mapM renameConDecl cons
+	    return (HsDataDecl loc ctx t args cons drv)
+        HsNewTypeDecl loc ctx t args con drv -> do
+	    con <- renameConDecl con
+	    return (HsNewTypeDecl loc ctx t args con drv)
+        HsClassDecl loc qt decls -> do
+	    qt <- renameClassHead qt
+	    decls <- mapM renameDecl decls
+	    return (HsClassDecl loc qt decls)
+	HsTypeSig loc fs qt -> do
+	    qt <- renameType qt
+	    return (HsTypeSig loc fs qt)
+	HsForeignImport loc cc safe ent n ty -> do
+	    ty <- renameType ty
+	    return (HsForeignImport loc cc safe ent n ty)
+	_ -> 
+	    return decl
+
+renameClassHead (HsForAllType tvs ctx ty) = do
+  ctx <- mapM renamePred ctx
+  return (HsForAllType tvs ctx ty)
+renameClassHead ty = do
+  return ty
+
+renameConDecl (HsConDecl loc nm tys maybe_doc) = do
+  tys <- mapM renameBangTy tys
+  return (HsConDecl loc nm tys maybe_doc)
+renameConDecl (HsRecDecl loc nm fields maybe_doc) = do
+  fields <- mapM renameField fields
+  return (HsRecDecl loc nm fields maybe_doc)
+
+renameField (HsFieldDecl ns ty doc) = do 
+  ty <- renameBangTy ty
+  return (HsFieldDecl ns ty doc)
+
+renameBangTy (HsBangedTy ty)   = HsBangedTy   `liftM` renameType ty
+renameBangTy (HsUnBangedTy ty) = HsUnBangedTy `liftM` renameType ty
+
+renamePred (c,tys) = do
+  tys <- mapM renameType tys
+  lookupRn (\c' -> (c',tys)) c
+
+renameType (HsForAllType tvs ctx ty) = do
+  ctx <- mapM renamePred ctx
+  ty <- renameType ty
+  return (HsForAllType tvs ctx ty)
+renameType (HsTyFun arg res) = do
+  arg <- renameType arg
+  res <- renameType res
+  return (HsTyFun arg res)
+renameType (HsTyTuple b tys) = do
+  tys <- mapM renameType tys
+  return (HsTyTuple b tys)
+renameType (HsTyApp ty arg) = do
+  ty <- renameType ty
+  arg <- renameType arg
+  return (HsTyApp ty arg)
+renameType (HsTyVar nm) =
+  return (HsTyVar nm)
+renameType (HsTyCon nm) =
+  lookupRn HsTyCon nm
+
+-- -----------------------------------------------------------------------------
+-- Renaming documentation
+
+-- Renaming documentation is done by "marking it up" from ordinary Doc
+-- into (Rn Doc), which can then be renamed with runRn.
+markupRename :: DocMarkup HsQName (RnM Doc)
+markupRename = Markup {
+  markupEmpty         = return DocEmpty,
+  markupString        = return . DocString,
+  markupParagraph     = liftM DocParagraph,
+  markupAppend        = liftM2 DocAppend,
+  markupIdentifier    = lookupRn DocIdentifier,
+  markupModule        = return . DocModule,
+  markupEmphasis      = liftM DocEmphasis,
+  markupMonospaced    = liftM DocMonospaced,
+  markupUnorderedList = liftM DocUnorderedList . sequence,
+  markupOrderedList   = liftM DocOrderedList . sequence,
+  markupCodeBlock     = liftM DocCodeBlock,
+  markupURL	      = return . DocURL
+  }
+
+renameDoc = markup markupRename
+
+markupResolveDoc :: DocMarkup String (GenRnM String Doc)
+markupResolveDoc = Markup {
+  markupEmpty         = return DocEmpty,
+  markupString        = return . DocString,
+  markupParagraph     = liftM DocParagraph,
+  markupAppend        = liftM2 DocAppend,
+  markupIdentifier    = lookupIdString,
+  markupModule        = return . DocModule,
+  markupEmphasis      = liftM DocEmphasis,
+  markupMonospaced    = liftM DocMonospaced,
+  markupUnorderedList = liftM DocUnorderedList . sequence,
+  markupOrderedList   = liftM DocOrderedList . sequence,
+  markupCodeBlock     = liftM DocCodeBlock,
+  markupURL	      = return . DocURL
+  }
+
+resolveDoc = markup markupResolveDoc
+
+lookupIdString :: String -> GenRnM String Doc
+lookupIdString str = do
+  fn <- getLookupRn
+  case fn str of
+	Nothing -> return (DocString str)
+	Just n  -> return (DocIdentifier n)
+
+-- -----------------------------------------------------------------------------
+
+renameExportItems items = mapM rn items
+  where
+ 	rn (ExportGroup lev doc) 
+	   = do doc <- renameDoc doc
+	        return (ExportGroup lev doc)
+	rn (ExportDecl decl)
+	   = do decl <- renameDecl decl
+		return (ExportDecl decl)
diff --git a/src/Main.hs b/src/Main.hs
index 218528bc..f57d5dd6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,6 +6,7 @@
 
 module Main (main) where
 
+import HaddockRename
 import HaddockParse
 import HaddockLex
 import HaddockDB
@@ -22,6 +23,7 @@ import FiniteMap
 
 --import Pretty
 
+import List	( nub )
 import Monad	( when )
 import Char	( isSpace )
 import IO
@@ -72,7 +74,8 @@ run flags files = do
   let ifaces = [ mkInterface module_map file parsed 
 	       | (file,parsed) <- zip files parsed_mods ]
 
-      module_map = listToFM ifaces
+      mod_ifaces = [ (m,i) | (m,i,_,_) <- ifaces ]
+      module_map = listToFM mod_ifaces
 
   let title = case [str | Flag_Heading str <- flags] of
 		[] -> ""
@@ -82,11 +85,14 @@ run flags files = do
 			[] -> Nothing
 			(t:ts) -> Just t
 
+  sequence [ reportMissingNames m ns_docs ns_decls 
+	   | (m, _, ns_docs, ns_decls) <- ifaces ]
+
   when (Flag_DocBook `elem` flags) $
-    putStr (ppDocBook ifaces)
+    putStr (ppDocBook mod_ifaces)
 
   when (Flag_Html `elem` flags) $
-    ppHtml title source_url ifaces
+    ppHtml title source_url mod_ifaces
 
 
 parse_file file = do
@@ -100,10 +106,23 @@ parse_file file = do
 				 exitWith (ExitFailure 1)
     )
 
+reportMissingNames m [] [] = return ()
+reportMissingNames (Module m) ns_docs ns_decls =  do
+  hPutStrLn stderr ("Warning: in module " ++ m ++ 
+		  ", the following names could not be resolved:")
+  let name_strings = nub (map show ns_decls ++ ns_docs)
+  hPutStrLn stderr ("   " ++ concat (map (' ':) name_strings))
+
 -----------------------------------------------------------------------------
 -- Figuring out the definitions that are exported from a module
 
-mkInterface :: ModuleMap -> FilePath -> HsModule -> (Module,Interface)
+mkInterface :: ModuleMap -> FilePath -> HsModule
+   -> (Module, 		-- the module name
+       Interface,	-- its "interface"
+       [String],	-- a list of names we couldn't resolve in the docs
+       [HsQName]	-- a list of names we couldn't resolve in the decls
+      )
+
 mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
   = (mod, Interface { 
 	   iface_filename = filename,
@@ -115,10 +134,18 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
 	   iface_maintainer  = "libraries@haskell.org",
 	   iface_stability   = "stable",
 	   iface_name_docs   = doc_map,
-	   iface_doc         = fmap (formatDocString (lookupForDoc import_env))
-				maybe_doc
-	} )
+	   iface_doc         = module_doc
+	},
+      missing_names_doc1 ++ missing_names_doc2,   
+      missing_names1 ++ missing_names2 --ignore missing_names3 for now,
+    )
   where
+  (module_doc, missing_names_doc1) = 
+    case maybe_doc of
+	Nothing  -> (Nothing, [])
+	Just doc -> (Just doc', ns)
+	  where (doc',ns) = formatDocString (lookupForDoc import_env) doc
+
   locally_defined_names = collectNames decls
 
   qual_local_names   = map (Qual mod) locally_defined_names
@@ -136,8 +163,11 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
   import_env = foldr plusFM local_env ext_import_envs  
 
   -- convert names in source code to original, fully qualified, names
-  orig_exports = fmap (renameExportList orig_env) exps
-  orig_decls   = map (renameDecl orig_env) decls
+  (orig_exports, missing_names1) 
+	= runRnFM orig_env (mapMaybeM renameExportList exps)
+
+  (orig_decls, missing_names2)
+	= runRnFM orig_env (mapM renameDecl decls)
 
   orig_decl_map :: FiniteMap HsName HsDecl
   orig_decl_map = listToFM [ (n,d) | d <- orig_decls, n <- declBinders d ]
@@ -150,15 +180,24 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
   final_decls = concat (map expandDecl orig_decls)
 
   -- match documentation to names, and resolve identifiers in the documentation
-  local_docs :: [(HsName,Doc)]
-  local_docs = [ (n, formatDocString (lookupForDoc import_env) doc) 
-	       | (n, doc) <- collectDoc final_decls
-	       ]
+  local_docstrings :: [(HsName,DocString)]
+  local_docstrings = collectDoc final_decls
+
+  local_docs_formatted :: [(HsName,(Doc,[String]))]
+  local_docs_formatted = 
+      [ (n, formatDocString (lookupForDoc orig_env) doc) 
+      | (n, doc) <- local_docstrings ]
+
+  local_docs :: [(HsName,Doc)]		-- with *original* names
+  local_docs = [ (n,doc) | (n,(doc,_)) <- local_docs_formatted ]
+
+  -- collect the list of names which we couldn't resolve in the documentation
+  missing_names_doc2 = concat [ ns | (n,(doc,ns)) <- local_docs_formatted ]
 
   -- get the documentation associated with entities exported from this module
   -- ToDo: we should really store the documentation in both orig and imported
   -- forms, like the export items.
-  doc_map :: FiniteMap HsName Doc
+  doc_map :: FiniteMap HsName Doc	-- with *imported* names
   doc_map = listToFM 
     [ (nameOfQName n, doc)
     | n <- exported_names,
@@ -168,12 +207,13 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
   decl_map = listToFM [ (n,d) | d <- final_decls, n <- declBinders d ]
 
   -- make the "export items", which will be converted into docs later
-  orig_export_list = mkExportItems mod_map mod import_env
+  orig_export_list = mkExportItems mod_map mod orig_env
 			decl_map final_decls orig_exports 
 
   -- rename names in the exported declarations to point to things that
   -- are closer, or maybe even exported by, the current module.
-  renamed_export_list = renameExportItems import_env orig_export_list
+  (renamed_export_list, missing_names3)
+     = runRnFM import_env (renameExportItems orig_export_list)
 
   name_env = listToFM [ (nameOfQName n, n) | n <- exported_names ]
 
@@ -187,12 +227,16 @@ lookupDoc mod_map this_mod local_doc env name
   = case name of
 	UnQual n -> Nothing
 	Qual mod n
-	  | mod == this_mod -> fmap (renameDoc env) (lookup n local_doc)
+	  | mod == this_mod -> 
+		fst (runRnFM env (mapMaybeM renameDoc (lookup n local_doc)))
+		-- ToDo: report missing names
 	  | otherwise       -> 
 		case lookupFM mod_map mod of
 		   Nothing -> Nothing
-		   Just iface -> fmap (renameDoc env)
-				  (lookupFM (iface_name_docs iface) n)
+		   Just iface -> 
+			fst (runRnFM env (mapMaybeM renameDoc
+				     (lookupFM (iface_name_docs iface) n)))
+		-- ToDo: report missing names
 
 -- -----------------------------------------------------------------------------
 -- Build the list of items that will become the documentation, from the
@@ -230,7 +274,9 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
 	= [ ExportDecl (restrictTo (map nameOfQName cs) decl) ]
     lookupExport (HsEModuleContents m) = fullContentsOf m
     lookupExport (HsEGroup lev str)
-	= [ ExportGroup lev (formatDocHeading (lookupForDoc env) str) ]
+	= [ ExportGroup lev doc ]
+	where (doc, _names) = formatDocHeading (lookupForDoc env) str
+	-- ToDo: report the unresolved names
     lookupExport _ = [] -- didn't find it?
 
     fullContentsOf m
@@ -242,7 +288,7 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
 
     findDecl :: HsQName -> Maybe HsDecl
     findDecl (UnQual n)
-	= trace ("Warning(mkExportItems): UnQual! " ++ show n) $ Nothing
+	= Nothing	-- must be a name we couldn't resolve
     findDecl (Qual m n)
 	| m == mod  = lookupFM decl_map n
 	| otherwise = 
@@ -251,18 +297,14 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
 		Nothing -> 
 		   trace ("Warning: module not found: " ++ show m) Nothing
 
-renameExportItems env items = map rn items
-  where
- 	rn (ExportGroup lev doc) 
-	   = ExportGroup lev (renameDoc env doc)
-	rn (ExportDecl decl)
-	   = ExportDecl (renameDecl env decl)
-
 fullContentsOfThisModule decls env = 
   [ mkExportItem decl | decl <- decls, keepDecl decl ]
   where mkExportItem (HsDocGroup lev str) =
-	   ExportGroup lev (formatDocHeading (lookupForDoc env) str)
-	mkExportItem decl = ExportDecl (renameDecl env decl)
+	   ExportGroup lev doc
+	  where
+	   (doc, _names) = formatDocHeading (lookupForDoc env) str
+	   -- ToDo: report the unresolved names
+	mkExportItem decl = ExportDecl decl
 
 
 keepDecl HsTypeSig{}     = True
@@ -349,78 +391,6 @@ expandDecl (HsClassDecl loc ty decls)
   = [ HsClassDecl loc ty (concat (map expandDecl decls)) ]
 expandDecl d = [ d ]
 
--- -----------------------------------------------------------------------------
--- Renaming source code
-
-renameExportList :: FiniteMap HsQName HsQName -> [HsExportSpec]
-	-> [HsExportSpec]
-renameExportList env spec = map renameExport spec
-  where
-    renameExport (HsEVar x) = HsEVar (rnLookupName env x)
-    renameExport (HsEAbs x) = HsEAbs (rnLookupName env x)
-    renameExport (HsEThingAll x) = HsEThingAll (rnLookupName env x)
-    renameExport (HsEThingWith x cs)
-	 = HsEThingWith (rnLookupName env x) (map (rnLookupName env) cs)
-    renameExport (HsEModuleContents m) = HsEModuleContents m
-    renameExport (HsEGroup lev str) = HsEGroup lev str
-
-renameDecl :: FiniteMap HsQName HsQName -> HsDecl -> HsDecl
-renameDecl scope decl
-  = case decl of
-	HsTypeDecl loc t args ty -> 
-	    HsTypeDecl loc t args (renameType scope ty)
-	HsDataDecl loc ctx t args cons drv -> 
-	    HsDataDecl loc ctx t args (map (renameConDecl scope) cons) drv
-        HsNewTypeDecl loc ctx t args con drv ->
-	    HsNewTypeDecl loc ctx t args (renameConDecl scope con) drv
-        HsClassDecl loc qt decls -> 
-	    HsClassDecl loc (renameClassHead scope qt) 
-		(map (renameDecl scope) decls)
-	HsTypeSig loc fs qt ->
-	    HsTypeSig loc fs (renameType scope qt)
-	HsForeignImport loc cc safe ent n ty ->
-	    HsForeignImport loc cc safe ent n (renameType scope ty)
-	_ -> decl
-
-renameClassHead s (HsForAllType tvs ctx ty)
-  = HsForAllType tvs (map (renamePred s) ctx) ty
-renameClassHead s ty
-  = ty
-
-renameConDecl s (HsConDecl loc nm tys maybe_doc)
-  = HsConDecl loc nm (map (renameBangTy s) tys) maybe_doc
-renameConDecl s (HsRecDecl loc nm fields maybe_doc)
-  = HsRecDecl loc nm (map (renameField s) fields) maybe_doc
-
-renameField s (HsFieldDecl ns ty doc) = HsFieldDecl ns (renameBangTy s ty) doc
-
-renameBangTy s (HsBangedTy ty) = HsBangedTy (renameType s ty)
-renameBangTy s (HsUnBangedTy ty) = HsUnBangedTy (renameType s ty)
-
-renamePred s (c,tys) = (rnLookupName s c, map (renameType s) tys)
-
-renameType s (HsForAllType tvs ctx ty)
-  = HsForAllType tvs (map (renamePred s) ctx) (renameType s ty)
-renameType s (HsTyFun arg res)
-  = HsTyFun (renameType s arg) (renameType s res)
-renameType s (HsTyTuple b tys)
-  = HsTyTuple b (map (renameType s) tys)
-renameType s (HsTyApp ty arg)
-  = HsTyApp  (renameType s ty) (renameType s arg)
-renameType s (HsTyVar nm)
-  = HsTyVar nm
-renameType s (HsTyCon nm)
-  = HsTyCon (rnLookupName s nm)
-
-rnLookupName :: FiniteMap HsQName HsQName -> HsQName -> HsQName
-rnLookupName s nm
-  = case lookupFM s nm of
-	Just n -> n
-	Nothing -> trace ("Warning: unknown name: " ++ show nm) nm
-
-renameDoc env = markup (mapIdent ident)
-  where ident id = DocIdentifier (rnLookupName env id)
-
 -----------------------------------------------------------------------------
 -- Collecting documentation and associating it with declarations
 
@@ -486,25 +456,21 @@ docsFromField (HsFieldDecl nms ty Nothing) rest
 -- description to this function to get the marked-up text.
 
 -- this one formats a heading
-formatDocHeading :: (String -> Maybe HsQName) -> DocString -> Doc
+formatDocHeading :: (String -> Maybe HsQName) -> DocString
+  -> (Doc,[String])
 formatDocHeading lookup string = format parseString lookup string
 
 -- this one formats a sequence of paragraphs
-formatDocString :: (String -> Maybe HsQName) -> DocString -> Doc
+formatDocString :: (String -> Maybe HsQName) -> DocString
+  -> (Doc,[String])
 formatDocString lookup string = format parseParas lookup string
 
 format 	:: ([Token] -> ParsedDoc)
 	-> (String -> Maybe HsQName)
 	-> DocString
-       	-> Doc
-format parse lookup string = markup (mapIdent ident) parsed_doc
-  where
-	--parsed_doc :: DocMarkup String a -> a
-	parsed_doc = parse (tokenise string)
-
-	ident str = case lookup str of
-			Just n  -> DocIdentifier n
-			Nothing -> DocString str
+       	-> (Doc, [String])
+format parse lookup string
+  = runRn lookup $ resolveDoc $ parse $ tokenise $ string
 
 -- ---------------------------------------------------------------------------
 -- Looking up names in documentation
@@ -513,7 +479,7 @@ lookupForDoc :: FiniteMap HsQName HsQName -> (String -> Maybe HsQName)
 lookupForDoc fm str
   = case [ n | Just n <- map (lookupFM fm) (strToHsQNames str) ] of
 	(n:_) -> Just n
-	[] -> trace ("Warning: unknown name: " ++ str) Nothing
+	[] -> Nothing
  
 strToHsQNames :: String -> [ HsQName ]
 strToHsQNames str
@@ -545,3 +511,8 @@ strToHsQNames str
 
 mapSnd f [] = []
 mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs
+
+mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
+mapMaybeM f Nothing = return Nothing
+mapMaybeM f (Just a) = f a >>= return . Just
+