From 658e79eddf0ac941d2719ec0a3aea58f42ef1277 Mon Sep 17 00:00:00 2001
From: David Waern <unknown>
Date: Wed, 29 Aug 2007 22:40:23 +0000
Subject: Major refactoring

---
 src/Haddock/Backends/DevHelp.hs   |   81 ++
 src/Haddock/Backends/HH.hs        |  180 +++++
 src/Haddock/Backends/HH2.hs       |  190 +++++
 src/Haddock/Backends/HaddockDB.hs |  165 ++++
 src/Haddock/Backends/Hoogle.hs    |  184 +++++
 src/Haddock/Backends/Html.hs      | 1510 +++++++++++++++++++++++++++++++++++++
 src/Haddock/DevHelp.hs            |   81 --
 src/Haddock/GHC/Typecheck.hs      |  106 +++
 src/Haddock/GHC/Utils.hs          |   79 ++
 src/Haddock/HH.hs                 |  180 -----
 src/Haddock/HH2.hs                |  188 -----
 src/Haddock/HaddockDB.hs          |  165 ----
 src/Haddock/Hoogle.hs             |  184 -----
 src/Haddock/Html.hs               | 1508 ------------------------------------
 src/Haddock/Interface.hs          |   91 +++
 src/Haddock/InterfaceFile.hs      |    2 +-
 src/Haddock/Options.hs            |    3 +-
 src/Haddock/Packages.hs           |   89 +--
 src/Haddock/Rename.hs             |  330 --------
 src/Haddock/Syntax/Rename.hs      |  333 ++++++++
 src/Haddock/Typecheck.hs          |  123 ---
 src/Haddock/Types.hs              |   32 +-
 src/Haddock/Utils/GHC.hs          |   76 --
 23 files changed, 2971 insertions(+), 2909 deletions(-)
 create mode 100644 src/Haddock/Backends/DevHelp.hs
 create mode 100644 src/Haddock/Backends/HH.hs
 create mode 100644 src/Haddock/Backends/HH2.hs
 create mode 100644 src/Haddock/Backends/HaddockDB.hs
 create mode 100644 src/Haddock/Backends/Hoogle.hs
 create mode 100644 src/Haddock/Backends/Html.hs
 delete mode 100644 src/Haddock/DevHelp.hs
 create mode 100644 src/Haddock/GHC/Typecheck.hs
 create mode 100644 src/Haddock/GHC/Utils.hs
 delete mode 100644 src/Haddock/HH.hs
 delete mode 100644 src/Haddock/HH2.hs
 delete mode 100644 src/Haddock/HaddockDB.hs
 delete mode 100644 src/Haddock/Hoogle.hs
 delete mode 100644 src/Haddock/Html.hs
 create mode 100644 src/Haddock/Interface.hs
 delete mode 100644 src/Haddock/Rename.hs
 create mode 100644 src/Haddock/Syntax/Rename.hs
 delete mode 100644 src/Haddock/Typecheck.hs
 delete mode 100644 src/Haddock/Utils/GHC.hs

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs
new file mode 100644
index 00000000..9441d4a9
--- /dev/null
+++ b/src/Haddock/Backends/DevHelp.hs
@@ -0,0 +1,81 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+module Haddock.Backends.DevHelp (ppDevHelpFile) where
+
+import Haddock.ModuleTree
+import Haddock.Types
+import Haddock.Utils
+
+import Module        ( moduleName, moduleNameString, Module, mkModule, mkModuleName )
+import PackageConfig ( stringToPackageId )
+import Name          ( Name, nameModule, getOccString )
+
+import Data.Maybe    ( fromMaybe )
+import qualified Data.Map as Map
+import Text.PrettyPrint
+
+ppDevHelpFile :: FilePath -> String -> Maybe String -> [HaddockModule] -> IO ()
+ppDevHelpFile odir doctitle maybe_package modules = do
+  let devHelpFile = package++".devhelp"
+      tree = mkModuleTree True [ (hmod_mod mod, toDescription mod) | mod <- modules ]
+      doc =
+        text "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$
+        (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>
+            text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$
+        text "<chapters>" $$
+        nest 4 (ppModuleTree [] tree) $+$
+        text "</chapters>" $$
+        text "<functions>" $$
+        nest 4 (ppList index) $+$
+        text "</functions>" $$
+        text "</book>"
+  writeFile (pathJoin [odir, devHelpFile]) (render doc)
+  where    
+    package = fromMaybe "pkg" maybe_package
+
+    ppModuleTree :: [String] -> [ModuleTree] -> Doc
+    ppModuleTree ss [x]    = ppNode ss x
+    ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs
+    ppModuleTree _  []     = error "HaddockHH.ppHHContents.fn: no module trees given"
+
+    ppNode :: [String] -> ModuleTree -> Doc
+    ppNode ss (Node s leaf _ _short ts) =
+        case ts of
+          [] -> text "<sub"<+>ppAttribs<>text "/>"
+          ts -> 
+            text "<sub"<+>ppAttribs<>text ">" $$
+            nest 4 (ppModuleTree (s:ss) ts) $+$
+            text "</sub>"
+        where
+          ppLink | leaf      = text (moduleHtmlFile (mkModule (stringToPackageId "") 
+                                                              (mkModuleName mdl)))
+                 | otherwise = empty
+
+          ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink
+
+          mdl = foldr (++) "" (s' : map ('.':) ss')
+          (s':ss') = reverse (s:ss)
+		-- reconstruct the module name
+
+    index :: [(Name, [Module])]
+    index = Map.toAscList (foldr getModuleIndex Map.empty modules)
+
+    getModuleIndex hmod fm =
+	Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mod]) | name <- hmod_exports hmod, nameModule name == mod]) fm
+	where mod = hmod_mod hmod
+
+    ppList :: [(Name, [Module])] -> Doc
+    ppList [] = empty
+    ppList ((name,refs):mdls)  =
+      ppReference name refs $$
+      ppList mdls
+
+    ppReference :: Name -> [Module] -> Doc
+    ppReference name [] = empty
+    ppReference name (mod:refs) =  
+      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mod name)<>text"\"/>" $$
+      ppReference name refs
diff --git a/src/Haddock/Backends/HH.hs b/src/Haddock/Backends/HH.hs
new file mode 100644
index 00000000..6cb5491d
--- /dev/null
+++ b/src/Haddock/Backends/HH.hs
@@ -0,0 +1,180 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+module Haddock.Backends.HH (ppHHContents, ppHHIndex, ppHHProject) where
+
+ppHHContents = error "not yet"
+ppHHIndex = error "not yet"
+ppHHProject = error "not yet"
+
+{-
+import HaddockModuleTree
+import HaddockTypes
+import HaddockUtil
+import HsSyn2 hiding(Doc)
+import qualified Map
+
+import Data.Char ( toUpper )
+import Data.Maybe ( fromMaybe )
+import Text.PrettyPrint
+
+ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
+ppHHContents odir doctitle maybe_package tree = do
+  let contentsHHFile = package++".hhc"
+
+      html =
+      	text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
+	text "<HTML>" $$
+	text "<HEAD>" $$
+	text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
+	text "<!-- Sitemap 1.0 -->" $$
+	text "</HEAD><BODY>" $$
+	ppModuleTree tree $$
+	text "</BODY><HTML>"
+  writeFile (pathJoin [odir, contentsHHFile]) (render html)
+  where
+	package = fromMaybe "pkg" maybe_package
+	
+	ppModuleTree :: [ModuleTree] -> Doc
+	ppModuleTree ts =
+		text "<OBJECT type=\"text/site properties\">" $$
+		text "<PARAM name=\"FrameName\" value=\"main\">" $$
+		text "</OBJECT>" $$
+		text "<UL>" $+$
+		nest 4 (text "<LI>" <> nest 4
+		                (text "<OBJECT type=\"text/sitemap\">" $$
+		                 nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$
+		                         text "<PARAM name=\"Local\" value=\"index.html\">") $$
+		                 text "</OBJECT>") $+$
+		        text "</LI>" $$
+		        text "<UL>" $+$
+		        nest 4 (fn [] ts) $+$
+		        text "</UL>") $+$
+		text "</UL>"
+
+	fn :: [String] -> [ModuleTree] -> Doc
+	fn ss [x]    = ppNode ss x
+	fn ss (x:xs) = ppNode ss x $$ fn ss xs
+        fn _  []     = error "HaddockHH.ppHHContents.fn: no module trees given"
+
+	ppNode :: [String] -> ModuleTree -> Doc
+	ppNode ss (Node s leaf _pkg _ []) =
+	  ppLeaf s ss leaf
+	ppNode ss (Node s leaf _pkg _ ts) =
+	  ppLeaf s ss leaf $$
+	  text "<UL>" $+$
+	  nest 4 (fn (s:ss) ts) $+$
+	  text "</UL>"
+
+	ppLeaf s ss isleaf  =
+		text "<LI>" <> nest 4
+			(text "<OBJECT type=\"text/sitemap\">" $$
+			 text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$
+			 (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile mdl) <> text "\">" else empty) $$
+			 text "</OBJECT>") $+$
+		text "</LI>"
+		where 
+			mdl = foldr (++) "" (s' : map ('.':) ss')
+			(s':ss') = reverse (s:ss)
+			-- reconstruct the module name
+		
+-------------------------------
+ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO ()
+ppHHIndex odir maybe_package ifaces = do
+  let indexHHFile = package++".hhk"
+  
+      html = 
+      	text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
+	text "<HTML>" $$
+	text "<HEAD>" $$
+	text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
+	text "<!-- Sitemap 1.0 -->" $$
+	text "</HEAD><BODY>" $$
+	text "<UL>" $+$
+	nest 4 (ppList index) $+$
+	text "</UL>" $$
+	text "</BODY><HTML>"
+  writeFile (pathJoin [odir, indexHHFile]) (render html)
+  where
+	package = fromMaybe "pkg" maybe_package
+  	
+	index :: [(HsName, [Module])]
+	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
+
+	getIfaceIndex iface fm =
+		foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']
+		where mdl = iface_module iface
+	
+	ppList [] = empty
+	ppList ((name,refs):mdls)  =
+		text "<LI>" <> nest 4
+				(text "<OBJECT type=\"text/sitemap\">" $$
+				 text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$
+				 ppReference name refs $$
+				 text "</OBJECT>") $+$
+		text "</LI>" $$
+		ppList mdls
+
+	ppReference name [] = empty
+	ppReference name (Module mdl:refs) =
+		text "<PARAM name=\"Local\" value=\"" <> text (nameHtmlRef mdl name) <> text "\">" $$
+		ppReference name refs
+
+
+ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO ()
+ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
+  let projectHHFile = package++".hhp"
+      doc =
+        text "[OPTIONS]" $$
+        text "Compatibility=1.1 or later" $$
+        text "Compiled file=" <> text package <> text ".chm" $$
+        text "Contents file=" <> text package <> text ".hhc" $$
+        text "Default topic=" <> text contentsHtmlFile $$
+        text "Display compile progress=No" $$
+        text "Index file=" <> text package <> text ".hhk" $$
+        text "Title=" <> text doctitle $$
+	space $$
+        text "[FILES]" $$
+        ppMods ifaces $$
+        text contentsHtmlFile $$
+        text indexHtmlFile $$
+        ppIndexFiles chars $$
+        ppLibFiles ("":pkg_paths)
+  writeFile (pathJoin [odir, projectHHFile]) (render doc)
+  where
+    package = fromMaybe "pkg" maybe_package
+	
+    ppMods [] = empty
+    ppMods (iface:ifaces) =
+	let Module mdl = iface_module iface in
+        text (moduleHtmlFile mdl) $$
+        ppMods ifaces
+		
+    ppIndexFiles []     = empty
+    ppIndexFiles (c:cs) =
+        text (subIndexHtmlFile c) $$
+        ppIndexFiles cs
+        
+    ppLibFiles []           = empty
+    ppLibFiles (path:paths) =
+        ppLibFile cssFile   $$
+    	ppLibFile iconFile  $$
+    	ppLibFile jsFile    $$
+    	ppLibFile plusFile  $$
+        ppLibFile minusFile $$
+        ppLibFiles paths
+        where
+            toPath fname | null path = fname
+	                 | otherwise = pathJoin [path, fname]
+            ppLibFile fname = text (toPath fname)
+
+    chars :: [Char]
+    chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
+
+    getIfaceIndex iface fm =
+        Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	where mdl = iface_module iface
+-}
diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs
new file mode 100644
index 00000000..685be3ad
--- /dev/null
+++ b/src/Haddock/Backends/HH2.hs
@@ -0,0 +1,190 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+
+module Haddock.Backends.HH2 (ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where
+
+
+ppHH2Contents = error "not yet"
+ppHH2Index = error "not yet"
+ppHH2Files = error "not yet"
+ppHH2Collection = error "not yet"
+
+{-
+import HaddockModuleTree
+import HaddockTypes
+import HaddockUtil
+import HsSyn2 hiding(Doc)
+import qualified Map
+
+import Data.Char ( toUpper )
+import Data.Maybe ( fromMaybe )
+import Text.PrettyPrint
+
+ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
+ppHH2Contents odir doctitle maybe_package tree = do
+  let 	
+	contentsHH2File = package++".HxT"
+
+	doc  =
+		text "<?xml version=\"1.0\"?>" $$
+		text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$
+		text "<HelpTOC DTDVersion=\"1.0\">" $$
+		nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$
+		        nest 4 (ppModuleTree [] tree) $+$
+		        text "</HelpTOCNode>") $$
+		text "</HelpTOC>"
+  writeFile (pathJoin [odir, contentsHH2File]) (render doc)
+  where
+	package = fromMaybe "pkg" maybe_package
+	
+	ppModuleTree :: [String] -> [ModuleTree] -> Doc
+	ppModuleTree ss [x]    = ppNode ss x
+	ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs
+	ppModuleTree _  []     = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given"
+
+	ppNode :: [String] -> ModuleTree -> Doc
+	ppNode ss (Node s leaf _pkg _short []) =
+	  text "<HelpTOCNode"  <+> ppAttributes leaf (s:ss) <> text "/>"
+	ppNode ss (Node s leaf _pkg _short ts) =
+	  text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$
+	  nest 4 (ppModuleTree (s:ss) ts) $+$
+	  text "</HelpTOCNode>"
+			
+	ppAttributes :: Bool -> [String] -> Doc
+	ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl]
+	  where
+	    mdl = foldr (++) "" (s' : map ('.':) ss')
+	    (s':ss') = reverse ss
+	                -- reconstruct the module name
+	    
+	    ppId = text "Id=" <> doubleQuotes (text mdl)
+	    
+	    ppTitle = text "Title=" <> doubleQuotes (text (head ss))
+	    
+	    ppUrl | isleaf    = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl))
+	          | otherwise = empty
+
+-----------------------------------------------------------------------------------
+
+ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO ()
+ppHH2Index odir maybe_package ifaces = do
+  let 
+	indexKHH2File     = package++"K.HxK"
+	indexNHH2File     = package++"N.HxK"
+	docK = 
+		text "<?xml version=\"1.0\"?>" $$
+		text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
+		text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$
+		nest 4 (ppList index) $+$
+		text "</HelpIndex>"  
+	docN = 
+		text "<?xml version=\"1.0\"?>" $$
+		text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
+		text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$
+		text "<Keyword Term=\"HomePage\">" $$
+		nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$
+		text "</Keyword>" $$
+		text "</HelpIndex>"
+  writeFile (pathJoin [odir, indexKHH2File]) (render docK)
+  writeFile (pathJoin [odir, indexNHH2File]) (render docN)
+  where
+	package = fromMaybe "pkg" maybe_package
+    
+	index :: [(HsName, [Module])]
+	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
+
+	getIfaceIndex iface fm =
+	    Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	    where mdl = iface_module iface
+	
+	ppList [] = empty
+	ppList ((name,mdls):vs)  =
+		text "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$
+		nest 4 (vcat (map (ppJump name) mdls)) $$
+		text "</Keyword>" $$
+		ppList vs
+
+	ppJump name (Module mdl) = text "<Jump Url=\"" <> text (nameHtmlRef mdl name) <> text "\"/>"
+
+
+-----------------------------------------------------------------------------------
+
+ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
+ppHH2Files odir maybe_package ifaces pkg_paths = do
+  let filesHH2File = package++".HxF"
+      doc =
+        text "<?xml version=\"1.0\"?>" $$
+        text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$
+        text "<HelpFileList DTDVersion=\"1.0\">" $$
+        nest 4 (ppMods ifaces $$
+                text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$
+                text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$
+                ppIndexFiles chars $$
+                ppLibFiles ("":pkg_paths)) $$
+        text "</HelpFileList>"
+  writeFile (pathJoin [odir, filesHH2File]) (render doc)
+  where
+    package = fromMaybe "pkg" maybe_package
+	
+    ppMods [] = empty
+    ppMods (iface:ifaces) =
+		text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$
+		ppMods ifaces
+		where Module mdl = iface_module iface
+		
+    ppIndexFiles []     = empty
+    ppIndexFiles (c:cs) =
+        text "<File Url=\""<>text (subIndexHtmlFile c)<>text "\"/>" $$
+        ppIndexFiles cs
+        
+    ppLibFiles []           = empty
+    ppLibFiles (path:paths) =        
+        ppLibFile cssFile   $$
+	ppLibFile iconFile  $$
+	ppLibFile jsFile    $$
+	ppLibFile plusFile  $$
+        ppLibFile minusFile $$
+        ppLibFiles paths
+        where
+            toPath fname | null path = fname
+                         | otherwise = pathJoin [path, fname]
+            ppLibFile fname = text "<File Url=\""<>text (toPath fname)<>text "\"/>"
+
+    chars :: [Char]
+    chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
+
+    getIfaceIndex iface fm =
+        Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	where mdl = iface_module iface
+
+-----------------------------------------------------------------------------------
+
+ppHH2Collection :: FilePath -> String -> Maybe String -> IO ()
+ppHH2Collection odir doctitle maybe_package = do
+  let 
+	package = fromMaybe "pkg" maybe_package
+	collectionHH2File = package++".HxC"
+	
+	doc =
+		text "<?xml version=\"1.0\"?>" $$
+		text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$
+		text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$
+		nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$
+		        nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$
+		        text "</CompilerOptions>" $$
+		        text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$
+		        text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$
+		        text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$
+		        text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$
+		        text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$
+		        text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$
+		        text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$
+		        text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$
+		        text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$
+		text "</HelpCollection>"
+  writeFile (pathJoin [odir, collectionHH2File]) (render doc)
+-}
diff --git a/src/Haddock/Backends/HaddockDB.hs b/src/Haddock/Backends/HaddockDB.hs
new file mode 100644
index 00000000..9be79c27
--- /dev/null
+++ b/src/Haddock/Backends/HaddockDB.hs
@@ -0,0 +1,165 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+module Haddock.Backends.HaddockDB (ppDocBook) where
+
+{-
+import HaddockTypes
+import HaddockUtil
+import HsSyn2
+
+import Text.PrettyPrint
+-}
+
+-----------------------------------------------------------------------------
+-- Printing the results in DocBook format
+
+ppDocBook = error "not working"
+{-
+ppDocBook :: FilePath -> [(Module, Interface)] -> String
+ppDocBook odir mods = render (ppIfaces mods)
+
+ppIfaces mods
+  =  text "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["
+  $$ text "]>"
+  $$ text "<book>"
+  $$ text "<bookinfo>"
+  $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"
+  $$ text "</bookinfo>"
+  $$ text "<article>"
+  $$ vcat (map do_mod mods)
+  $$ text "</article></book>"
+  where
+     do_mod (Module mod, iface)
+        =  text "<sect1 id=\"sec-" <> text mod <> text "\">"
+        $$ text "<title><literal>" 
+	   <> text mod
+	   <> text "</literal></title>"
+	$$ text "<indexterm><primary><literal>"
+	   <> text mod
+	   <> text "</literal></primary></indexterm>"
+	$$ text "<variablelist>"
+	$$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))
+	$$ text "</variablelist>"
+	$$ text "</sect1>"
+ 
+     do_export mod decl | (nm:_) <- declBinders decl
+	=  text "<varlistentry id=" <> ppLinkId mod nm <> char '>'
+	$$ text "<term><literal>" 
+		<> do_decl decl
+		<> text "</literal></term>"
+	$$ text "<listitem>"
+	$$ text "<para>"
+	$$ text "</para>"
+	$$ text "</listitem>"
+	$$ text "</varlistentry>"
+     do_export _ _ = empty
+
+     do_decl (HsTypeSig _ [nm] ty _) 
+	=  ppHsName nm <> text " :: " <> ppHsType ty
+     do_decl (HsTypeDecl _ nm args ty _)
+	=  hsep ([text "type", ppHsName nm ]
+		 ++ map ppHsName args 
+		 ++ [equals, ppHsType ty])
+     do_decl (HsNewTypeDecl loc ctx nm args con drv _)
+	= hsep ([text "data", ppHsName nm] -- data, not newtype
+		++ map ppHsName args
+		) <+> equals <+> ppHsConstr con -- ToDo: derivings
+     do_decl (HsDataDecl loc ctx nm args cons drv _)
+	= hsep ([text "data", {-ToDo: context-}ppHsName nm]
+	        ++ map ppHsName args)
+            <+> vcat (zipWith (<+>) (equals : repeat (char '|'))
+                                    (map ppHsConstr cons))
+     do_decl (HsClassDecl loc ty fds decl _)
+	= hsep [text "class", ppHsType ty]
+     do_decl decl
+	= empty
+
+ppHsConstr :: HsConDecl -> Doc
+ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) =
+	 ppHsName name
+	 <> (braces . hsep . punctuate comma . map ppField $ fieldList)
+ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = 
+	 hsep (ppHsName name : map ppHsBangType typeList)
+
+ppField (HsFieldDecl ns ty doc)
+   = hsep (punctuate comma (map ppHsName ns) ++
+	 	[text "::", ppHsBangType ty])
+
+ppHsBangType :: HsBangType -> Doc
+ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty
+ppHsBangType (HsUnBangedTy ty) = ppHsType ty
+
+ppHsContext :: HsContext -> Doc
+ppHsContext []      = empty
+ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> 
+					 hsep (map ppHsAType b)) context)
+
+ppHsType :: HsType -> Doc
+ppHsType (HsForAllType Nothing context htype) =
+     hsep [ ppHsContext context, text "=>", ppHsType htype]
+ppHsType (HsForAllType (Just tvs) [] htype) =
+     hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype])
+ppHsType (HsForAllType (Just tvs) context htype) =
+     hsep (text "forall" : map ppHsName tvs ++ text "." : 
+	   ppHsContext context : text "=>" : [ppHsType htype])
+ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "-&gt;", ppHsType b]
+ppHsType (HsTyIP n t)  = fsep [(char '?' <> ppHsName n), text "::", ppHsType t]
+ppHsType t = ppHsBType t
+
+ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
+  = brackets $ ppHsType b
+ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b]
+ppHsBType t = ppHsAType t
+
+ppHsAType :: HsType -> Doc
+ppHsAType (HsTyTuple True l)  = parenList . map ppHsType $ l
+ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l
+-- special case
+ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
+  = brackets $ ppHsType b
+ppHsAType (HsTyVar name) = ppHsName name
+ppHsAType (HsTyCon name) = ppHsQName name
+ppHsAType t = parens $ ppHsType t
+
+ppHsQName :: HsQName -> Doc
+ppHsQName (UnQual str)			= ppHsName str
+ppHsQName n@(Qual (Module mod) str)
+	 | n == unit_con_name		= ppHsName str
+	 | isSpecial str 		= ppHsName str
+	 | otherwise 
+		=  text "<link linkend=" <> ppLinkId mod str <> char '>'
+		<> ppHsName str
+		<> text "</link>"
+
+isSpecial (HsTyClsName id) | HsSpecial _ <- id = True
+isSpecial (HsVarName id) | HsSpecial _ <- id = True
+isSpecial _ = False
+
+ppHsName :: HsName -> Doc
+ppHsName (HsTyClsName id) = ppHsIdentifier id
+ppHsName (HsVarName id) = ppHsIdentifier id
+
+ppHsIdentifier :: HsIdentifier -> Doc
+ppHsIdentifier (HsIdent str)	= text str
+ppHsIdentifier (HsSymbol str) = text str
+ppHsIdentifier (HsSpecial str) = text str
+
+ppLinkId :: String -> HsName -> Doc
+ppLinkId mod str
+  = hcat [char '\"', text mod, char '.', ppHsName str, char '\"']
+
+-- -----------------------------------------------------------------------------
+-- * Misc
+
+parenList :: [Doc] -> Doc
+parenList = parens . fsep . punctuate comma
+
+ubxParenList :: [Doc] -> Doc
+ubxParenList = ubxparens . fsep . punctuate comma
+
+ubxparens p = text "(#" <> p <> text "#)"
+-}
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
new file mode 100644
index 00000000..d93c055b
--- /dev/null
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -0,0 +1,184 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+-- This file, (c) Neil Mitchell 2006
+-- Write out Hoogle compatible documentation
+-- http://www.haskell.org/hoogle/
+
+module Haddock.Backends.Hoogle ( 
+	ppHoogle
+  ) where
+
+ppHoogle = undefined
+
+{-
+import HaddockTypes
+import HaddockUtil
+import HsSyn2
+
+import Data.List ( intersperse )
+
+
+
+prefix = ["-- Hoogle documentation, generated by Haddock",
+          "-- See Hoogle, http://www.haskell.org/hoogle/"]
+
+ppHoogle :: Maybe String -> [Interface] -> FilePath -> IO ()
+ppHoogle maybe_package ifaces odir =
+    do
+        let
+            filename = case maybe_package of
+                        Just x -> x ++ ".txt"
+                        Nothing -> "hoogle.txt"
+
+            visible_ifaces = filter visible ifaces
+            visible i = OptHide `notElem` iface_options i
+
+            contents = prefix : map ppModule visible_ifaces
+
+        writeFile (pathJoin [odir, filename]) (unlines $ concat contents)
+ 
+
+
+-- ---------------------------------------------------------------------------
+-- Generate the HTML page for a module
+
+
+ppDecl :: HsDecl -> [String]
+ppDecl (HsNewTypeDecl src context name args ctor unknown docs) =
+    ppData "newtype" context name args [ctor]
+
+ppDecl (HsDataDecl src context name args ctors unknown docs) =
+    ppData "data" context name args ctors
+
+ppDecl (HsTypeSig src names t doc) = map (`ppFunc` t) names
+
+ppDecl (HsForeignImport src _ _ _ name t doc) = ppDecl $ HsTypeSig src [name] t doc
+
+ppDecl (HsClassDecl src context name args fundeps members doc) =
+    ("class " ++ ppContext context ++ ppType typ) : concatMap f members
+    where
+        typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args)
+        newcontext = (UnQual name, map HsTyVar args)
+        f (HsTypeSig src names t doc) = ppDecl (HsTypeSig src names (addContext newcontext t) doc)
+        f (HsFunBind{}) = []
+        f (HsPatBind{}) = []
+        f x = ["-- ERR " ++ show x]
+
+ppDecl (HsTypeDecl src name args t doc) =
+    ["type " ++ show name ++ concatMap (\x -> ' ':show x) args ++ " = " ++ ppType t]
+
+ppDecl x = ["-- ERR " ++ show x]
+
+
+
+addContext :: HsAsst -> HsType -> HsType
+addContext ctx (HsForAllType Nothing context t) = HsForAllType Nothing (HsAssump ctx : context) t
+addContext ctx x = HsForAllType Nothing [HsAssump ctx] x
+
+
+
+ppFunc :: HsName -> HsType -> String
+ppFunc name typ = show name ++ " :: " ++ ppType typ
+
+
+ppData :: String -> HsContext -> HsName -> [HsName] -> [HsConDecl] -> [String]
+ppData mode context name args ctors = (mode ++ " " ++ ppType typ) : concatMap (ppCtor typ) ctors
+    where
+        typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args)
+        
+        
+deBang :: HsBangType -> HsType
+deBang (HsBangedTy   x) = x
+deBang (HsUnBangedTy x) = x
+
+
+ppCtor :: HsType -> HsConDecl -> [String]
+ppCtor result (HsConDecl src name types context typ doc) =
+    [show name ++ " :: " ++ ppContext context ++ ppTypesArr (map deBang typ ++ [result])]
+
+ppCtor result (HsRecDecl src name types context fields doc) =
+        ppCtor result (HsConDecl src name types context (map snd fields2) doc) ++
+        concatMap f fields2
+    where
+        fields2 = [(name, typ) | HsFieldDecl names typ _ <- fields, name <- names]
+        f (name, typ) = ppDecl $ HsTypeSig src [name] (HsTyFun result (deBang typ)) doc
+
+
+brack True  x = "(" ++ x ++ ")"
+brack False x = x
+
+ppContext :: HsContext -> String
+ppContext [] = ""
+ppContext xs = brack (length xs > 1) (concat $ intersperse ", " $ map ppContextItem xs) ++ " => "
+
+ppContextItem :: HsAsst -> String
+ppContextItem (name, types) = ppQName name ++ concatMap (\x -> ' ':ppType x) types
+
+ppContext2 :: HsIPContext -> String
+ppContext2 xs = ppContext [x | HsAssump x <- xs]
+
+
+ppType :: HsType -> String
+ppType x = f 0 x
+    where
+        f _ (HsTyTuple _ xs) = brack True $ concat $ intersperse ", " $ map (f 0) xs
+        f _ (HsTyCon x) = ppQName x
+        f _ (HsTyVar x) = show x
+
+        -- ignore ForAll types as Hoogle does not support them
+        f n (HsForAllType (Just items) context t) =
+            -- brack (n > 1) $
+            -- "forall" ++ concatMap (\x -> ' ':toStr x) items ++ " . " ++ f 0 t
+            f n t
+
+        f n (HsForAllType Nothing context t) = brack (n > 1) $
+            ppContext2 context ++ f 0 t
+
+        f n (HsTyFun a b) = brack g $ f (h 3) a ++ " -> " ++ f (h 2) b
+            where
+                g = n > 2
+                h x = if g then 0 else x
+        
+        f n (HsTyApp a b) | ppType a == "[]" = "[" ++ f 0 b ++ "]"
+        
+        f n (HsTyApp a b) = brack g $ f (h 3) a ++ " " ++ f (h 4) b
+            where
+                g = n > 3
+                h x = if g then 0 else x
+        
+        f n (HsTyDoc x _) = f n x
+
+        f n x = brack True $ show x
+
+
+ppQName :: HsQName -> String
+ppQName (Qual _ name) = show name
+ppQName (UnQual name) = show name
+
+
+
+ppTypesArr :: [HsType] -> String
+ppTypesArr xs = ppType $ foldr1 HsTyFun xs
+
+
+
+ppInst :: InstHead -> String
+ppInst (context, item) = "instance " ++ ppContext context ++ ppContextItem item
+
+
+
+ppModule :: Interface -> [String]
+ppModule iface = "" : ("module " ++ mdl) : concatMap ppExport (iface_exports iface)
+    where
+        Module mdl = iface_module iface
+
+
+ppExport :: ExportItem -> [String]
+ppExport (ExportDecl name decl insts) = ppDecl decl ++ map ppInst insts
+ppExport _ = []
+
+
+-}
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
new file mode 100644
index 00000000..b49bf213
--- /dev/null
+++ b/src/Haddock/Backends/Html.hs
@@ -0,0 +1,1510 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+
+module Haddock.Backends.Html ( 
+  ppHtml, copyHtmlBits, 
+  ppHtmlIndex, ppHtmlContents,
+  ppHtmlHelpFiles
+) where
+
+
+import Prelude hiding (div)
+
+import Haddock.Backends.DevHelp
+import Haddock.Backends.HH
+import Haddock.Backends.HH2
+import Haddock.ModuleTree
+import Haddock.Types
+import Haddock.Version
+import Haddock.Utils
+import Haddock.Utils.GHC
+import Haddock.Utils.Html
+import qualified Haddock.Utils.Html as Html
+
+import Control.Exception     ( bracket )
+import Control.Monad         ( when, unless )
+import Data.Char             ( isUpper, toUpper )
+import Data.List             ( sortBy )
+import Data.Maybe            ( fromJust, isJust, mapMaybe, fromMaybe )
+import Foreign.Marshal.Alloc ( allocaBytes )
+import System.IO             ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
+import Data.Map              ( Map )
+import qualified Data.Map as Map hiding ( Map )
+
+import GHC hiding ( NoLink )
+import Name
+import Module
+import PackageConfig         ( stringToPackageId )
+import RdrName hiding ( Qual )
+import SrcLoc   
+import FastString            ( unpackFS )
+import BasicTypes            ( IPName(..), Boxity(..) )
+import Type                  ( Kind )
+import Outputable            ( ppr, defaultUserStyle, showSDoc )
+
+-- the base, module and entity URLs for the source code and wiki links.
+type SourceURLs = (Maybe String, Maybe String, Maybe String)
+type WikiURLs = (Maybe String, Maybe String, Maybe String)
+
+-- -----------------------------------------------------------------------------
+-- Generating HTML documentation
+
+ppHtml	:: String
+	-> Maybe String				-- package
+	-> [HaddockModule]
+	-> FilePath			-- destination directory
+	-> Maybe (GHC.HsDoc GHC.RdrName)    -- prologue text, maybe
+	-> Maybe String		        -- the Html Help format (--html-help)
+	-> SourceURLs			-- the source URL (--source)
+	-> WikiURLs			-- the wiki URL (--wiki)
+	-> Maybe String			-- the contents URL (--use-contents)
+	-> Maybe String			-- the index URL (--use-index)
+	-> IO ()
+
+ppHtml doctitle maybe_package hmods odir prologue maybe_html_help_format
+	maybe_source_url maybe_wiki_url
+	maybe_contents_url maybe_index_url =  do
+  let
+	visible_hmods = filter visible hmods
+	visible i = OptHide `notElem` hmod_options i
+
+  when (not (isJust maybe_contents_url)) $ 
+    ppHtmlContents odir doctitle maybe_package
+        maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url
+	visible_hmods
+	False -- we don't want to display the packages in a single-package contents
+	prologue
+
+  when (not (isJust maybe_index_url)) $ 
+    ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
+      maybe_contents_url maybe_source_url maybe_wiki_url visible_hmods
+    
+  when (not (isJust maybe_contents_url && isJust maybe_index_url)) $ 
+	ppHtmlHelpFiles doctitle maybe_package hmods odir maybe_html_help_format []
+
+  mapM_ (ppHtmlModule odir doctitle
+	   maybe_source_url maybe_wiki_url
+	   maybe_contents_url maybe_index_url) visible_hmods
+
+ppHtmlHelpFiles	
+    :: String                   -- doctitle
+    -> Maybe String				-- package
+	-> [HaddockModule]
+	-> FilePath                 -- destination directory
+	-> Maybe String             -- the Html Help format (--html-help)
+	-> [FilePath]               -- external packages paths
+	-> IO ()
+ppHtmlHelpFiles doctitle maybe_package hmods odir maybe_html_help_format pkg_paths =  do
+  let
+	visible_hmods = filter visible hmods
+	visible i = OptHide `notElem` hmod_options i
+
+  -- Generate index and contents page for Html Help if requested
+  case maybe_html_help_format of
+    Nothing        -> return ()
+    Just "mshelp"  -> ppHHProject odir doctitle maybe_package visible_hmods pkg_paths
+    Just "mshelp2" -> do
+		ppHH2Files      odir maybe_package visible_hmods pkg_paths
+		ppHH2Collection odir doctitle maybe_package
+    Just "devhelp" -> ppDevHelpFile odir doctitle maybe_package visible_hmods
+    Just format    -> fail ("The "++format++" format is not implemented")
+
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+	(bracket (openFile fromFPath ReadMode) hClose $ \hFrom ->
+	 bracket (openFile toFPath WriteMode) hClose $ \hTo ->
+	 allocaBytes bufferSize $ \buffer ->
+		copyContents hFrom hTo buffer)
+	where
+		bufferSize = 1024
+		
+		copyContents hFrom hTo buffer = do
+			count <- hGetBuf hFrom buffer bufferSize
+			when (count > 0) $ do
+				hPutBuf hTo buffer count
+				copyContents hFrom hTo buffer
+
+
+copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO ()
+copyHtmlBits odir libdir maybe_css = do
+  let 
+	libhtmldir = pathJoin [libdir, "html"]
+	css_file = case maybe_css of
+			Nothing -> pathJoin [libhtmldir, cssFile]
+			Just f  -> f
+	css_destination = pathJoin [odir, cssFile]
+	copyLibFile f = do
+	   copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
+  copyFile css_file css_destination
+  mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ]
+
+footer :: HtmlTable
+footer = 
+  tda [theclass "botbar"] << 
+	( toHtml "Produced by" <+> 
+	  (anchor ! [href projectUrl] << toHtml projectName) <+>
+	  toHtml ("version " ++ projectVersion)
+	)
+   
+srcButton :: SourceURLs -> Maybe HaddockModule -> HtmlTable
+srcButton (Just src_base_url, _, _) Nothing =
+  topButBox (anchor ! [href src_base_url] << toHtml "Source code")
+
+srcButton (_, Just src_module_url, _) (Just hmod) =
+  let url = spliceURL (Just $ hmod_orig_filename hmod)
+                      (Just $ hmod_mod hmod) Nothing src_module_url
+   in topButBox (anchor ! [href url] << toHtml "Source code")
+
+srcButton _ _ =
+  Html.emptyTable
+ 
+spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> String -> String
+spliceURL maybe_file maybe_mod maybe_name url = run url
+ where
+  file = fromMaybe "" maybe_file
+  mod = case maybe_mod of
+          Nothing           -> ""
+          Just mod -> moduleString mod 
+  
+  (name, kind) =
+    case maybe_name of
+      Nothing             -> ("","")
+      Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v")
+             | otherwise -> (escapeStr (getOccString n), "t")
+
+  run "" = ""
+  run ('%':'M':rest) = mod ++ run rest
+  run ('%':'F':rest) = file ++ run rest
+  run ('%':'N':rest) = name ++ run rest
+  run ('%':'K':rest) = kind ++ run rest
+
+  run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest
+  run ('%':'{':'F':'I':'L':'E':'}':rest)         = file ++ run rest
+  run ('%':'{':'N':'A':'M':'E':'}':rest)         = name ++ run rest
+  run ('%':'{':'K':'I':'N':'D':'}':rest)         = kind ++ run rest
+
+  run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) =
+    map (\x -> if x == '.' then c else x) mod ++ run rest
+
+  run (c:rest) = c : run rest
+  
+wikiButton :: WikiURLs -> Maybe Module -> HtmlTable
+wikiButton (Just wiki_base_url, _, _) Nothing =
+  topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments")
+
+wikiButton (_, Just wiki_module_url, _) (Just mod) =
+  let url = spliceURL Nothing (Just mod) Nothing wiki_module_url
+   in topButBox (anchor ! [href url] << toHtml "User Comments")
+
+wikiButton _ _ =
+  Html.emptyTable
+
+contentsButton :: Maybe String -> HtmlTable
+contentsButton maybe_contents_url 
+  = topButBox (anchor ! [href url] << toHtml "Contents")
+  where url = case maybe_contents_url of
+			Nothing -> contentsHtmlFile
+			Just url -> url
+
+indexButton :: Maybe String -> HtmlTable
+indexButton maybe_index_url 
+  = topButBox (anchor ! [href url] << toHtml "Index")
+  where url = case maybe_index_url of
+			Nothing -> indexHtmlFile
+			Just url -> url
+
+simpleHeader :: String -> Maybe String -> Maybe String
+             -> SourceURLs -> WikiURLs -> HtmlTable
+simpleHeader doctitle maybe_contents_url maybe_index_url
+  maybe_source_url maybe_wiki_url = 
+  (tda [theclass "topbar"] << 
+     vanillaTable << (
+       (td << 
+  	image ! [src "haskell_icon.gif", width "16", height 16, alt " " ]
+       ) <->
+       (tda [theclass "title"] << toHtml doctitle) <->
+	srcButton maybe_source_url Nothing <->
+        wikiButton maybe_wiki_url Nothing <->
+	contentsButton maybe_contents_url <-> indexButton maybe_index_url
+   ))
+
+pageHeader :: String -> HaddockModule -> String
+    -> SourceURLs -> WikiURLs
+    -> Maybe String -> Maybe String -> HtmlTable
+pageHeader mdl hmod doctitle
+           maybe_source_url maybe_wiki_url
+           maybe_contents_url maybe_index_url =
+  (tda [theclass "topbar"] << 
+    vanillaTable << (
+       (td << 
+  	image ! [src "haskell_icon.gif", width "16", height 16, alt " "]
+       ) <->
+       (tda [theclass "title"] << toHtml doctitle) <->
+	srcButton maybe_source_url (Just hmod) <->
+	wikiButton maybe_wiki_url (Just $ hmod_mod hmod) <->
+	contentsButton maybe_contents_url <->
+	indexButton maybe_index_url
+    )
+   ) </>
+   tda [theclass "modulebar"] <<
+	(vanillaTable << (
+	  (td << font ! [size "6"] << toHtml mdl) <->
+	  moduleInfo hmod
+	)
+    )
+
+moduleInfo :: HaddockModule -> HtmlTable
+moduleInfo hmod = 
+   let
+      info = hmod_info hmod
+
+      doOneEntry :: (String, (GHC.HaddockModInfo GHC.Name) -> Maybe String) -> Maybe HtmlTable
+      doOneEntry (fieldName,field) = case field info of
+         Nothing -> Nothing
+         Just fieldValue -> 
+            Just ((tda [theclass "infohead"] << toHtml fieldName)
+               <-> (tda [theclass "infoval"]) << toHtml fieldValue)
+     
+      entries :: [HtmlTable]
+      entries = mapMaybe doOneEntry [
+         ("Portability",GHC.hmi_portability),
+         ("Stability",GHC.hmi_stability),
+         ("Maintainer",GHC.hmi_maintainer)
+         ]
+   in
+      case entries of
+         [] -> Html.emptyTable
+         _ -> tda [align "right"] << narrowTable << (foldl1 (</>) entries)
+
+-- ---------------------------------------------------------------------------
+-- Generate the module contents
+
+ppHtmlContents
+   :: FilePath
+   -> String
+   -> Maybe String
+   -> Maybe String
+   -> Maybe String
+   -> SourceURLs
+   -> WikiURLs
+   -> [HaddockModule] -> Bool -> Maybe (GHC.HsDoc GHC.RdrName)
+   -> IO ()
+ppHtmlContents odir doctitle
+  maybe_package maybe_html_help_format maybe_index_url
+  maybe_source_url maybe_wiki_url modules showPkgs prologue = do
+  let tree = mkModuleTree showPkgs
+         [(hmod_mod mod, toDescription mod) | mod <- modules]
+      html = 
+	header 
+		(documentCharacterEncoding +++
+		 thetitle (toHtml doctitle) +++
+		 styleSheet +++
+		 (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+        body << vanillaTable << (
+   	    simpleHeader doctitle Nothing maybe_index_url
+                         maybe_source_url maybe_wiki_url </>
+	    ppPrologue doctitle prologue </>
+	    ppModuleTree doctitle tree </>
+	    s15 </>
+	    footer
+	  )
+  writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html)
+  
+  -- Generate contents page for Html Help if requested
+  case maybe_html_help_format of
+    Nothing        -> return ()
+    Just "mshelp"  -> ppHHContents  odir doctitle maybe_package tree
+    Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree
+    Just "devhelp" -> return ()
+    Just format    -> fail ("The "++format++" format is not implemented")
+
+ppPrologue :: String -> Maybe (GHC.HsDoc GHC.RdrName) -> HtmlTable
+ppPrologue title Nothing = Html.emptyTable
+ppPrologue title (Just doc) = 
+  (tda [theclass "section1"] << toHtml title) </>
+  docBox (rdrDocToHtml doc)
+
+ppModuleTree :: String -> [ModuleTree] -> HtmlTable
+ppModuleTree _ ts = 
+  tda [theclass "section1"] << toHtml "Modules" </>
+  td << vanillaTable2 << htmlTable
+  where
+    genTable htmlTable id []     = (htmlTable,id)
+    genTable htmlTable id (x:xs) = genTable (htmlTable </> u) id' xs      
+      where
+        (u,id') = mkNode [] x 0 id
+
+    (htmlTable,_) = genTable emptyTable 0 ts
+
+mkNode :: [String] -> ModuleTree -> Int -> Int -> (HtmlTable,Int)
+mkNode ss (Node s leaf pkg short ts) depth id = htmlNode
+  where
+    htmlNode = case ts of
+      [] -> (td_pad_w 1.25 depth << htmlModule  <-> shortDescr <-> htmlPkg,id)
+      _  -> (td_w depth << (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg </> 
+                (td_subtree << sub_tree), id')
+
+    mod_width = 50::Int {-em-}
+
+    td_pad_w pad depth = 
+	tda [thestyle ("padding-left: " ++ show pad ++ "em;" ++
+		       "width: " ++ show (mod_width - depth*2) ++ "em")]
+
+    td_w depth = 
+	tda [thestyle ("width: " ++ show (mod_width - depth*2) ++ "em")]
+
+    td_subtree =
+	tda [thestyle ("padding: 0; padding-left: 2em")]
+
+    shortDescr :: HtmlTable
+    shortDescr = case short of
+	Nothing -> td empty
+	Just doc -> tda [theclass "rdoc"] (origDocToHtml doc)
+
+    htmlModule 
+      | leaf      = ppModule (mkModule (stringToPackageId pkgName) 
+                                       (mkModuleName mdl)) ""
+      | otherwise = toHtml s
+
+    -- ehm.. TODO: change the ModuleTree type
+    (htmlPkg, pkgName) = case pkg of
+      Nothing -> (td << empty, "")
+      Just p  -> (td << toHtml p, p)
+
+    mdl = foldr (++) "" (s' : map ('.':) ss')
+    (s':ss') = reverse (s:ss)
+	 -- reconstruct the module name
+    
+    id_s = "n:" ++ show id
+    
+    (sub_tree,id') = genSubTree emptyTable (id+1) ts
+    
+    genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int)
+    genSubTree htmlTable id [] = (sub_tree,id)
+      where
+        sub_tree = collapsed vanillaTable2 id_s htmlTable
+    genSubTree htmlTable id (x:xs) = genSubTree (htmlTable </> u) id' xs      
+      where
+        (u,id') = mkNode (s:ss) x (depth+1) id
+
+-- The URL for source and wiki links, and the current module
+type LinksInfo = (SourceURLs, WikiURLs, HaddockModule)
+
+
+-- ---------------------------------------------------------------------------
+-- Generate the index
+
+ppHtmlIndex :: FilePath
+            -> String 
+            -> Maybe String
+            -> Maybe String
+            -> Maybe String
+            -> SourceURLs
+            -> WikiURLs
+            -> [HaddockModule] 
+            -> IO ()
+ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
+  maybe_contents_url maybe_source_url maybe_wiki_url modules = do
+  let html = 
+	header (documentCharacterEncoding +++
+		thetitle (toHtml (doctitle ++ " (Index)")) +++
+		styleSheet) +++
+        body << vanillaTable << (
+	    simpleHeader doctitle maybe_contents_url Nothing
+                         maybe_source_url maybe_wiki_url </>
+	    index_html
+	   )
+
+  when split_indices $
+    mapM_ (do_sub_index index) initialChars
+
+  writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html)
+  
+    -- Generate index and contents page for Html Help if requested
+  case maybe_html_help_format of
+    Nothing        -> return ()
+    Just "mshelp"  -> ppHHIndex  odir maybe_package modules
+    Just "mshelp2" -> ppHH2Index odir maybe_package modules
+    Just "devhelp" -> return ()
+    Just format    -> fail ("The "++format++" format is not implemented")
+ where
+  split_indices = length index > 50
+
+  index_html
+    | split_indices = 
+	tda [theclass "section1"] << 
+	      	toHtml ("Index") </>
+	indexInitialLetterLinks
+   | otherwise =
+	td << table ! [cellpadding 0, cellspacing 5] <<
+	  aboves (map indexElt index) 
+ 	
+  indexInitialLetterLinks = 
+	td << table ! [cellpadding 0, cellspacing 5] <<
+	    besides [ td << anchor ! [href (subIndexHtmlFile c)] <<
+			 toHtml [c]
+		    | c <- initialChars
+                    , any ((==c) . toUpper . head . fst) index ]
+
+  do_sub_index this_ix c
+    = unless (null index_part) $
+        writeFile (pathJoin [odir, subIndexHtmlFile c]) (renderHtml html)
+    where 
+      html = header (documentCharacterEncoding +++
+		thetitle (toHtml (doctitle ++ " (Index)")) +++
+		styleSheet) +++
+             body << vanillaTable << (
+	        simpleHeader doctitle maybe_contents_url Nothing
+                             maybe_source_url maybe_wiki_url </>
+		indexInitialLetterLinks </>
+	        tda [theclass "section1"] << 
+	      	toHtml ("Index (" ++ c:")") </>
+	        td << table ! [cellpadding 0, cellspacing 5] <<
+	      	  aboves (map indexElt index_part) 
+	       )
+
+      index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c]
+
+  index :: [(String, Map GHC.Name [(Module,Bool)])]
+  index = sortBy cmp (Map.toAscList full_index)
+    where cmp (n1,_) (n2,_) = n1 `compare` n2
+
+  -- for each name (a plain string), we have a number of original HsNames that
+  -- it can refer to, and for each of those we have a list of modules
+  -- that export that entity.  Each of the modules exports the entity
+  -- in a visible or invisible way (hence the Bool).
+  full_index :: Map String (Map GHC.Name [(Module,Bool)])
+  full_index = Map.fromListWith (flip (Map.unionWith (++)))
+		(concat (map getHModIndex modules))
+
+  getHModIndex hmod = 
+    [ (getOccString name, 
+	Map.fromList [(name, [(mdl, name `elem` hmod_visible_exports hmod)])])
+    | name <- hmod_exports hmod ]
+    where mdl = hmod_mod hmod
+
+  indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable
+  indexElt (str, entities) = 
+     case Map.toAscList entities of
+	[(nm,entries)] ->  
+	    tda [ theclass "indexentry" ] << toHtml str <-> 
+			indexLinks nm entries
+	many_entities ->
+	    tda [ theclass "indexentry" ] << toHtml str </> 
+		aboves (map doAnnotatedEntity (zip [1..] many_entities))
+
+  doAnnotatedEntity (j,(nm,entries))
+	= tda [ theclass "indexannot" ] << 
+		toHtml (show j) <+> parens (ppAnnot (nameOccName nm)) <->
+		 indexLinks nm entries
+
+  ppAnnot n | not (isValOcc n) = toHtml "Type/Class"
+            | isDataOcc n      = toHtml "Data Constructor"
+            | otherwise        = toHtml "Function"
+
+  indexLinks nm entries = 
+     tda [ theclass "indexlinks" ] << 
+	hsep (punctuate comma 
+	[ if visible then
+	     linkId mod (Just nm) << toHtml (moduleString mod)
+	  else
+	     toHtml (moduleString mod)
+	| (mod, visible) <- entries ])
+
+  initialChars = [ 'A'..'Z' ] ++ ":!#$%&*+./<=>?@\\^|-~"
+
+-- ---------------------------------------------------------------------------
+-- Generate the HTML page for a module
+
+ppHtmlModule
+	:: FilePath -> String
+	-> SourceURLs -> WikiURLs
+	-> Maybe String -> Maybe String
+	-> HaddockModule -> IO ()
+ppHtmlModule odir doctitle
+  maybe_source_url maybe_wiki_url
+  maybe_contents_url maybe_index_url hmod = do
+  let 
+      mod = hmod_mod hmod
+      mdl = moduleString mod
+      html = 
+	header (documentCharacterEncoding +++
+		thetitle (toHtml mdl) +++
+		styleSheet +++
+		(script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+        body << vanillaTable << (
+	    pageHeader mdl hmod doctitle
+		maybe_source_url maybe_wiki_url
+		maybe_contents_url maybe_index_url </> s15 </>
+	    hmodToHtml maybe_source_url maybe_wiki_url hmod </> s15 </>
+	    footer
+         )
+  writeFile (pathJoin [odir, moduleHtmlFile mod]) (renderHtml html)
+
+hmodToHtml :: SourceURLs -> WikiURLs -> HaddockModule -> HtmlTable
+hmodToHtml maybe_source_url maybe_wiki_url hmod
+  = abovesSep s15 (contents: description: synopsis: maybe_doc_hdr: bdy)
+  where
+        docMap = hmod_rn_doc_map hmod
+ 
+	exports = numberSectionHeadings (hmod_rn_export_items hmod)
+
+	has_doc (ExportDecl _ _ doc _) = isJust doc
+	has_doc (ExportNoDecl _ _ _) = False
+	has_doc (ExportModule _) = False
+	has_doc _ = True
+
+	no_doc_at_all = not (any has_doc exports)
+
+ 	contents = td << vanillaTable << ppModuleContents exports
+
+	description
+          = case hmod_rn_doc hmod of
+              Nothing -> Html.emptyTable
+              Just doc -> (tda [theclass "section1"] << toHtml "Description") </>
+                          docBox (docToHtml doc)
+
+	-- omit the synopsis if there are no documentation annotations at all
+	synopsis
+	  | no_doc_at_all = Html.emptyTable
+	  | otherwise
+	  = (tda [theclass "section1"] << toHtml "Synopsis") </>
+	    s15 </>
+            (tda [theclass "body"] << vanillaTable <<
+  	        abovesSep s8 (map (processExport True linksInfo docMap)
+			(filter forSummary exports))
+	    )
+
+	-- if the documentation doesn't begin with a section header, then
+	-- add one ("Documentation").
+	maybe_doc_hdr
+	    = case exports of		   
+		   [] -> Html.emptyTable
+		   ExportGroup _ _ _ : _ -> Html.emptyTable
+		   _ -> tda [ theclass "section1" ] << toHtml "Documentation"
+
+	bdy  = map (processExport False linksInfo docMap) exports
+	linksInfo = (maybe_source_url, maybe_wiki_url, hmod)
+
+ppModuleContents :: [ExportItem DocName] -> HtmlTable
+ppModuleContents exports
+  | length sections == 0 = Html.emptyTable
+  | otherwise            = tda [theclass "section4"] << bold << toHtml "Contents"
+  		           </> td << dlist << concatHtml sections
+ where
+  (sections, _leftovers{-should be []-}) = process 0 exports
+
+  process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName])
+  process _ [] = ([], [])
+  process n items@(ExportGroup lev id0 doc : rest) 
+    | lev <= n  = ( [], items )
+    | otherwise = ( html:secs, rest2 )
+    where
+	html = (dterm << linkedAnchor id0 << docToHtml doc)
+		 +++ mk_subsections ssecs
+	(ssecs, rest1) = process lev rest
+	(secs,  rest2) = process n   rest1
+  process n (_ : rest) = process n rest
+
+  mk_subsections [] = noHtml
+  mk_subsections ss = ddef << dlist << concatHtml ss
+
+-- we need to assign a unique id to each section heading so we can hyperlink
+-- them from the contents:
+numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName]
+numberSectionHeadings exports = go 1 exports
+  where go :: Int -> [ExportItem DocName] -> [ExportItem DocName]
+        go _ [] = []
+	go n (ExportGroup lev _ doc : es) 
+	  = ExportGroup lev (show n) doc : go (n+1) es
+	go n (other:es)
+	  = other : go n es
+
+processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable
+processExport _ _ _ (ExportGroup lev id0 doc)
+  = ppDocGroup lev (namedAnchor id0 << docToHtml doc)
+processExport summary links docMap (ExportDecl x decl doc insts)
+  = doDecl summary links x decl doc insts docMap
+processExport summmary _ _ (ExportNoDecl _ y [])
+  = declBox (ppDocName y)
+processExport summmary _ _ (ExportNoDecl _ y subs)
+  = declBox (ppDocName y <+> parenList (map ppDocName subs))
+processExport _ _ _ (ExportDoc doc)
+  = docBox (docToHtml doc)
+processExport _ _ _ (ExportModule mod)
+  = declBox (toHtml "module" <+> ppModule mod "")
+
+forSummary :: (ExportItem DocName) -> Bool
+forSummary (ExportGroup _ _ _) = False
+forSummary (ExportDoc _)       = False
+forSummary _                    = True
+
+ppDocGroup :: Int -> Html -> HtmlTable
+ppDocGroup lev doc
+  | lev == 1  = tda [ theclass "section1" ] << doc
+  | lev == 2  = tda [ theclass "section2" ] << doc
+  | lev == 3  = tda [ theclass "section3" ] << doc
+  | otherwise = tda [ theclass "section4" ] << doc
+
+declWithDoc :: Bool -> LinksInfo -> SrcSpan -> Name -> Maybe (HsDoc DocName) -> Html -> HtmlTable
+declWithDoc True  _     _   _  _          html_decl = declBox html_decl
+declWithDoc False links loc nm Nothing    html_decl = topDeclBox links loc nm html_decl
+declWithDoc False links loc nm (Just doc) html_decl = 
+		topDeclBox links loc nm html_decl </> docBox (docToHtml doc)
+
+doDecl :: Bool -> LinksInfo -> Name -> LHsDecl DocName -> 
+          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable
+doDecl summary links x (L loc d) mbDoc instances docMap = doDecl d
+  where
+    doDecl (TyClD d) = doTyClD d 
+    doDecl (SigD s) = ppSig summary links loc mbDoc s
+    doDecl (ForD d) = ppFor summary links loc mbDoc d
+
+    doTyClD d0@(TyData {}) = ppDataDecl summary links instances x loc mbDoc d0
+    doTyClD d0@(TySynonym {}) = ppTySyn summary links loc mbDoc d0
+    doTyClD d0@(ClassDecl {}) = ppClassDecl summary links instances x loc mbDoc docMap d0
+
+ppSig :: Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) -> Sig DocName -> HtmlTable
+ppSig summary links loc mbDoc (TypeSig lname ltype) 
+  | summary || noArgDocs t = 
+    declWithDoc summary links loc n mbDoc (ppTypeSig summary n t)
+  | otherwise = topDeclBox links loc n (ppBinder False n) </>
+    (tda [theclass "body"] << vanillaTable <<  (
+      do_args dcolon t </>
+        (case mbDoc of 
+          Just doc -> ndocBox (docToHtml doc)
+          Nothing -> Html.emptyTable)
+	))
+
+  where 
+  t = unLoc ltype
+  NoLink n = unLoc lname
+
+  noLArgDocs (L _ t) = noArgDocs t
+  noArgDocs (HsForAllTy _ _ _ t) = noLArgDocs t
+  noArgDocs (HsFunTy (L _ (HsDocTy _ _)) _) = False 
+  noArgDocs (HsFunTy _ r) = noLArgDocs r
+  noArgDocs (HsDocTy _ _) = False
+  noArgDocs _ = True
+
+  do_largs leader (L _ t) = do_args leader t  
+  do_args :: Html -> (HsType DocName) -> HtmlTable
+  do_args leader (HsForAllTy Explicit tvs lctxt ltype)
+    = (argBox (
+        leader <+> 
+        hsep (keyword "forall" : ppTyVars tvs ++ [dot]) <+>
+        ppLContextNoArrow lctxt)
+          <-> rdocBox noHtml) </> 
+          do_largs darrow ltype
+  do_args leader (HsForAllTy Implicit _ lctxt ltype)
+    = (argBox (leader <+> ppLContextNoArrow lctxt)
+        <-> rdocBox noHtml) </> 
+        do_largs darrow ltype
+  do_args leader (HsFunTy (L _ (HsDocTy lt ldoc)) r)
+    = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc)))
+        </> do_largs arrow r
+  do_args leader (HsFunTy lt r)
+    = (argBox (leader <+> ppLType lt) <-> rdocBox noHtml) </> do_largs arrow r
+  do_args leader (HsDocTy lt ldoc)
+    = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc)))
+  do_args leader t
+    = argBox (leader <+> ppType t) <-> rdocBox (noHtml)
+
+ppTyVars tvs = map ppName (tyvarNames tvs)
+
+tyvarNames = map f 
+  where f x = let NoLink n = hsTyVarName (unLoc x) in n
+  
+ppFor summary links loc mbDoc (ForeignImport lname ltype _)
+  = ppSig summary links loc mbDoc (TypeSig lname ltype)
+ppFor _ _ _ _ _ = error "ppFor"
+
+-- we skip type patterns for now
+ppTySyn summary links loc mbDoc (TySynonym lname ltyvars _ ltype) 
+  = declWithDoc summary links loc n mbDoc (
+    hsep ([keyword "type", ppBinder summary n]
+    ++ ppTyVars ltyvars) <+> equals <+> ppLType ltype)
+  where NoLink n = unLoc lname
+
+ppLType (L _ t) = ppType t
+
+ppTypeSig :: Bool -> Name -> (HsType DocName) -> Html
+ppTypeSig summary nm ty = ppBinder summary nm <+> dcolon <+> ppType ty
+
+--------------------------------------------------------------------------------
+-- Contexts 
+--------------------------------------------------------------------------------
+
+ppLContext        = ppContext        . unLoc
+ppLContextNoArrow = ppContextNoArrow . unLoc
+
+ppContextNoArrow :: HsContext DocName -> Html
+ppContextNoArrow []  = empty
+ppContextNoArrow cxt = pp_hs_context (map unLoc cxt) 
+
+ppContextNoLocs :: [HsPred DocName] -> Html
+ppContextNoLocs []  = empty
+ppContextNoLocs cxt = pp_hs_context cxt <+> darrow  
+
+ppContext :: HsContext DocName -> Html
+ppContext cxt = ppContextNoLocs (map unLoc cxt)
+
+pp_hs_context []  = empty
+pp_hs_context [p] = ppPred p
+pp_hs_context cxt = parenList (map ppPred cxt) 
+
+ppLPred = ppPred . unLoc
+
+ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts)
+-- TODO: find out what happened to the Dupable/Linear distinction
+ppPred (HsIParam (IPName n) t) 
+  = toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t
+
+-- -----------------------------------------------------------------------------
+-- Class declarations
+
+ppClassHdr summ (L _ []) n tvs fds = 
+  keyword "class"
+	<+> ppBinder summ n <+> hsep (ppTyVars tvs)
+	<+> ppFds fds
+ppClassHdr summ lctxt n tvs fds = 
+  keyword "class" <+> ppLContext lctxt
+	<+> ppBinder summ n <+> hsep (ppTyVars tvs)
+	<+> ppFds fds
+
+ppFds fds =
+  if null fds then noHtml else 
+	char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
+  where
+	fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
+			       hsep (map ppDocName vars2)
+
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap = 
+  if null sigs && null ats
+    then (if summary then declBox else topDeclBox links loc nm) hdr
+    else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
+	    </> 
+           (tda [theclass "body"] << 
+	     vanillaTable << 
+         aboves ([ ppAT summary at | L _ at <- ats ] ++
+	        [ ppSig summary links loc mbDoc sig  
+		      | L _ sig@(TypeSig (L _ (NoLink n)) ty) <- sigs, let mbDoc = Map.lookup n docMap ])
+          )
+  where
+    hdr = ppClassHdr summary lctxt nm tvs fds
+    NoLink nm = unLoc lname
+    
+    ppAT summary at = case at of
+      TyData {} -> topDeclBox links loc nm (ppDataHeader summary at)
+      _ -> error "associated type synonyms or type families not supported yet"
+
+-- we skip ATs for now
+ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan ->
+                          Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> 
+                          HtmlTable
+ppClassDecl summary links instances orig_c loc mbDoc docMap
+	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ _ _)
+  | summary = ppShortClassDecl summary links decl loc docMap
+  | otherwise
+    = classheader </>
+      tda [theclass "body"] << vanillaTable << (
+        classdoc </> methodsBit </> instancesBit
+      )
+  where 
+    classheader
+      | null lsigs = topDeclBox links loc nm hdr
+      | otherwise  = topDeclBox links loc nm (hdr <+> keyword "where")
+
+    NoLink nm = unLoc lname
+    ctxt = unLoc lctxt
+
+    hdr = ppClassHdr summary lctxt nm ltyvars lfds
+    
+    classdoc = case mbDoc of
+      Nothing -> Html.emptyTable
+      Just d -> ndocBox (docToHtml d)
+
+    methodsBit
+      | null lsigs = Html.emptyTable
+      | otherwise  = 
+        s8 </> methHdr </>
+        tda [theclass "body"] << vanillaTable << (
+          abovesSep s8 [ ppSig summary links loc mbDoc sig
+                         | L _ sig@(TypeSig n _) <- lsigs, 
+                         let mbDoc = Map.lookup (orig n) docMap ]
+        )
+
+    instId = collapseId nm
+    instancesBit
+      | null instances = Html.emptyTable
+      | otherwise 
+        =  s8 </> instHdr instId </>
+           tda [theclass "body"] << 
+             collapsed thediv instId (
+             spacedTable1 << (
+               aboves (map (declBox . ppInstHead) instances)
+             ))
+
+ppInstHead :: InstHead DocName -> Html
+ppInstHead ([],   n, ts) = ppAsst n ts 
+ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAsst n ts 
+
+ppAsst n ts = ppDocName n <+> hsep (map ppParendType ts)
+
+-- -----------------------------------------------------------------------------
+-- Data & newtype declarations
+
+orig (L _ (NoLink name)) = name
+orig _ = error "orig"
+
+-- TODO: print contexts
+ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> 
+                   Maybe (HsDoc DocName) -> TyClDecl DocName -> Html
+ppShortDataDecl summary links loc mbDoc dataDecl 
+
+  | [lcon] <- cons, ResTyH98 <- resTy = 
+    ppDataHeader summary dataDecl 
+    <+> equals <+> ppShortConstr summary (unLoc lcon)
+
+  | [] <- cons = ppDataHeader summary dataDecl
+
+  | otherwise = vanillaTable << (
+      case resTy of 
+        ResTyH98 -> dataHeader </> 
+          tda [theclass "body"] << vanillaTable << (
+            aboves (zipWith doConstr ('=':repeat '|') cons)
+          )
+        ResTyGADT _ -> dataHeader </> 
+          tda [theclass "body"] << vanillaTable << (
+            aboves (map doGADTConstr cons)
+          )
+    )
+  
+  where
+    dataHeader = 
+      (if summary then declBox else topDeclBox links loc name)
+      ((ppDataHeader summary dataDecl) <+> 
+      case resTy of ResTyGADT _ -> keyword "where"; _ -> empty)
+
+    doConstr c con = declBox (toHtml [c] <+> ppShortConstr summary (unLoc con))
+    doGADTConstr con = declBox (ppShortConstr summary (unLoc con))
+
+    name      = orig (tcdLName dataDecl)
+    context   = unLoc (tcdCtxt dataDecl)
+    newOrData = tcdND dataDecl
+    tyVars    = tyvarNames (tcdTyVars dataDecl)
+    mbKSig    = tcdKindSig dataDecl
+    cons      = tcdCons dataDecl
+    resTy     = (con_res . unLoc . head) cons 
+
+ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> 
+              SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> HtmlTable
+ppDataDecl summary links instances x loc mbDoc dataDecl
+  
+  | summary = declWithDoc summary links loc name mbDoc 
+              (ppShortDataDecl summary links loc mbDoc dataDecl)
+  
+  | otherwise = dataHeader </> 
+    tda [theclass "body"] << vanillaTable << (
+      datadoc </> 
+      constrBit </>
+      instancesBit
+    )
+  
+  where
+    name      = orig (tcdLName dataDecl)
+    context   = unLoc (tcdCtxt dataDecl)
+    newOrData = tcdND dataDecl
+    tyVars    = tyvarNames (tcdTyVars dataDecl)
+    mbKSig    = tcdKindSig dataDecl
+    cons      = tcdCons dataDecl
+    resTy     = (con_res . unLoc . head) cons 
+      
+    dataHeader = 
+      (if summary then declBox else topDeclBox links loc name)
+      ((ppDataHeader summary dataDecl) <+> whereBit)
+
+    whereBit 
+      | null cons = empty 
+      | otherwise = case resTy of 
+        ResTyGADT _ -> keyword "where"
+        _ -> empty                         
+
+    constrTable
+      | any isRecCon cons = spacedTable5
+      | otherwise         = spacedTable1
+
+    datadoc = case mbDoc of
+      Just doc -> ndocBox (docToHtml doc)
+      Nothing -> Html.emptyTable
+
+    constrBit 
+      | null cons = Html.emptyTable
+      | otherwise = constrHdr </> ( 
+          tda [theclass "body"] << constrTable << 
+	  aboves (map ppSideBySideConstr cons)
+        )
+
+    instId = collapseId name
+
+    instancesBit
+      | null instances = Html.emptyTable
+      | otherwise 
+        = instHdr instId </>
+	  tda [theclass "body"] << 
+          collapsed thediv instId (
+            spacedTable1 << (
+              aboves (map (declBox . ppInstHead) instances)
+            )
+          )
+
+isRecCon lcon = case con_details (unLoc lcon) of 
+  RecCon _ -> True
+  _ -> False
+
+ppShortConstr :: Bool -> ConDecl DocName -> Html
+ppShortConstr summary con = case con_res con of 
+
+  ResTyH98 -> case con_details con of 
+    PrefixCon args -> header +++ hsep (ppBinder summary name : map ppLType args)
+    RecCon fields -> header +++ ppBinder summary name <+>
+      braces (vanillaTable << aboves (map (ppShortField summary) fields))
+    InfixCon arg1 arg2 -> header +++ 
+      hsep [ppLType arg1, ppBinder summary name, ppLType arg2]    
+
+  ResTyGADT resTy -> case con_details con of 
+    PrefixCon args -> doGADTCon args resTy
+    RecCon _ -> error "GADT records not suported"
+    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy 
+    
+  where
+    doGADTCon args resTy = ppBinder summary name <+> dcolon <+> hsep [
+                             ppForAll forall ltvs lcontext,
+                             ppLType (foldr mkFunTy resTy args) ]
+
+    header   = ppConstrHdr forall tyVars context
+    name     = orig (con_name con)
+    ltvs     = con_qvars con
+    tyVars   = tyvarNames ltvs 
+    lcontext = con_cxt con
+    context  = unLoc (con_cxt con)
+    forall   = con_explicit con
+    mkFunTy a b = noLoc (HsFunTy a b)
+
+ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Html
+ppConstrHdr forall tvs ctxt
+ = (if null tvs then noHtml else ppForall)
+   +++
+   (if null ctxt then noHtml else ppContext ctxt <+> toHtml "=> ")
+  where
+    ppForall = case forall of 
+      Explicit -> keyword "forall" <+> hsep (map ppName tvs) <+> toHtml ". "
+      Implicit -> empty
+
+ppSideBySideConstr :: LConDecl DocName -> HtmlTable
+ppSideBySideConstr (L _ con) = case con_res con of 
+ 
+  ResTyH98 -> case con_details con of 
+
+    PrefixCon args -> 
+      argBox (hsep ((header +++ ppBinder False name) : map ppLType args)) 
+      <-> maybeRDocBox mbLDoc  
+
+    RecCon fields -> 
+      argBox (header +++ ppBinder False name) <->
+      maybeRDocBox mbLDoc </>
+      (tda [theclass "body"] << spacedTable1 <<
+      aboves (map ppSideBySideField fields))
+
+    InfixCon arg1 arg2 -> 
+      argBox (hsep [header+++ppLType arg1, ppBinder False name, ppLType arg2])
+      <-> maybeRDocBox mbLDoc
+ 
+  ResTyGADT resTy -> case con_details con of
+    PrefixCon args -> doGADTCon args resTy
+    RecCon _ -> error "GADT records not supported"
+    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy 
+
+ where 
+    doGADTCon args resTy = argBox (ppBinder False name <+> dcolon <+> hsep [
+                               ppForAll forall ltvs (con_cxt con),
+                               ppLType (foldr mkFunTy resTy args) ]
+                            ) <-> maybeRDocBox mbLDoc
+
+
+    header  = ppConstrHdr forall tyVars context
+    name    = orig (con_name con)
+    ltvs    = con_qvars con
+    tyVars  = tyvarNames (con_qvars con)
+    context = unLoc (con_cxt con)
+    forall  = con_explicit con
+    mbLDoc  = con_doc con
+    mkFunTy a b = noLoc (HsFunTy a b)
+
+ppSideBySideField :: ConDeclField DocName -> HtmlTable
+ppSideBySideField (ConDeclField lname ltype mbLDoc) =
+  argBox (ppBinder False (orig lname)
+    <+> dcolon <+> ppLType ltype) <->
+  maybeRDocBox mbLDoc
+
+{-
+ppHsFullConstr :: HsConDecl -> Html
+ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) = 
+     declWithDoc False doc (
+	hsep ((ppHsConstrHdr tvs ctxt +++ 
+		ppHsBinder False nm) : map ppHsBangType typeList)
+      )
+ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) =
+   td << vanillaTable << (
+     case doc of
+       Nothing -> aboves [hdr, fields_html]
+       Just _  -> aboves [hdr, constr_doc, fields_html]
+   )
+
+  where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm)
+
+	constr_doc	
+	  | isJust doc = docBox (docToHtml (fromJust doc))
+	  | otherwise  = Html.emptyTable
+
+	fields_html = 
+	   td << 
+	      table ! [width "100%", cellpadding 0, cellspacing 8] << (
+		   aboves (map ppFullField (concat (map expandField fields)))
+		)
+-}
+
+ppShortField :: Bool -> ConDeclField DocName -> HtmlTable
+ppShortField summary (ConDeclField lname ltype _) 
+  = tda [theclass "recfield"] << (
+      ppBinder summary (orig lname)
+      <+> dcolon <+> ppLType ltype
+    )
+
+{-
+ppFullField :: HsFieldDecl -> Html
+ppFullField (HsFieldDecl [n] ty doc) 
+  = declWithDoc False doc (
+	ppHsBinder False n <+> dcolon <+> ppHsBangType ty
+    )
+ppFullField _ = error "ppFullField"
+
+expandField :: HsFieldDecl -> [HsFieldDecl]
+expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ]
+-}
+
+-- | Print the LHS of a data/newtype declaration.
+-- Currently doesn't handle 'data instance' decls or kind signatures
+ppDataHeader :: Bool -> TyClDecl DocName -> Html
+ppDataHeader summary decl 
+  | not (isDataDecl decl) = error "ppDataHeader: illegal argument"
+  | otherwise = 
+    -- newtype or data
+    (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+> 
+    -- context
+    ppLContext (tcdCtxt decl) <+>
+    -- T a b c ..., or a :+: b  
+    (if isConSym name 
+      then ppName (tyvars!!0) <+> ppBinder summary name <+> ppName (tyvars!!1)
+      else ppBinder summary name <+> hsep (map ppName tyvars))
+  where 
+    tyvars = tyvarNames $ tcdTyVars decl
+    name = orig $ tcdLName decl
+
+-- ----------------------------------------------------------------------------
+-- Types and contexts
+
+ppKind k = toHtml $ showSDoc (ppr k)
+
+{-
+ppForAll Implicit _ lctxt = ppCtxtPart lctxt
+ppForAll Explicit ltvs lctxt = 
+  hsep (keyword "forall" : ppTyVars ltvs ++ [dot]) <+> ppCtxtPart lctxt 
+-}
+
+ppBang HsStrict = toHtml "!"
+ppBang HsUnbox  = toHtml "!!"
+
+tupleParens Boxed   = parenList
+tupleParens Unboxed = ubxParenList 
+{-
+ppType :: HsType DocName -> Html
+ppType t = case t of
+  t@(HsForAllTy expl ltvs lcontext ltype) -> ppForAllTy t <+> ppLType ltype
+  HsTyVar n -> ppDocName n
+  HsBangTy HsStrict lt -> toHtml "!" <+> ppLType lt
+  HsBangTy HsUnbox lt -> toHtml "!!" <+> ppLType lt
+  HsAppTy a b -> ppLType a <+> ppLType b 
+  HsFunTy a b -> hsep [ppLType a, toHtml "->", ppLType b]
+  HsListTy t -> brackets $ ppLType t
+  HsPArrTy t -> toHtml "[:" +++ ppLType t +++ toHtml ":]"
+  HsTupleTy Boxed ts -> parenList $ map ppLType ts
+  HsTupleTy Unboxed ts -> ubxParenList $ map ppLType ts
+  HsOpTy a n b -> ppLType a <+> ppLDocName n <+> ppLType b
+  HsParTy t -> parens $ ppLType t
+  HsNumTy n -> toHtml (show n)
+  HsPredTy p -> ppPred p
+  HsKindSig t k -> hsep [ppLType t, dcolon, ppKind k]
+  HsSpliceTy _ -> error "ppType"
+  HsDocTy t _ -> ppLType t
+-}
+--------------------------------------------------------------------------------
+-- Rendering of HsType 
+--------------------------------------------------------------------------------
+
+pREC_TOP = (0 :: Int)   -- type in ParseIface.y in GHC
+pREC_FUN = (1 :: Int)   -- btype in ParseIface.y in GHC
+                        -- Used for LH arg of (->)
+pREC_OP  = (2 :: Int)   -- Used for arg of any infix operator
+                        -- (we don't keep their fixities around)
+pREC_CON = (3 :: Int)   -- Used for arg of type applicn:
+                        -- always parenthesise unless atomic
+
+maybeParen :: Int           -- Precedence of context
+           -> Int           -- Precedence of top-level operator
+           -> Html -> Html  -- Wrap in parens if (ctxt >= op)
+maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
+                               | otherwise            = p
+
+ppType ty       = ppr_mono_ty pREC_TOP (prepare ty)
+ppParendType ty = ppr_mono_ty pREC_CON ty
+
+-- Before printing a type
+-- (a) Remove outermost HsParTy parens
+-- (b) Drop top-level for-all type variables in user style
+--     since they are implicit in Haskell
+prepare (HsParTy ty) = prepare (unLoc ty)
+prepare ty           = ty
+
+ppForAll exp tvs cxt 
+  | show_forall = forall_part <+> ppLContext cxt
+  | otherwise   = ppLContext cxt
+  where
+    show_forall = not (null tvs) && is_explicit
+    is_explicit = case exp of {Explicit -> True; Implicit -> False}
+    forall_part = hsep (keyword "forall" : ppTyVars tvs) +++ dot 
+
+ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
+
+ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
+  = maybeParen ctxt_prec pREC_FUN $
+    hsep [ppForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
+
+-- gaw 2004
+ppr_mono_ty ctxt_prec (HsBangTy b ty)     = ppBang b +++ ppLType ty
+ppr_mono_ty ctxt_prec (HsTyVar name)      = ppDocName name
+ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
+ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (map ppLType tys)
+ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppKind kind)
+ppr_mono_ty ctxt_prec (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty ctxt_prec (HsPArrTy ty)       = pabrackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty ctxt_prec (HsPredTy pred)     = parens (ppPred pred)
+ppr_mono_ty ctxt_prec (HsNumTy n)         = toHtml (show n) -- generics only
+ppr_mono_ty ctxt_prec (HsSpliceTy s)      = error "ppr_mono_ty-haddock"
+
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
+  = maybeParen ctxt_prec pREC_CON $
+    hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
+
+ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
+  = maybeParen ctxt_prec pREC_OP $
+    ppr_mono_lty pREC_OP ty1 <+> ppLDocName op <+> ppr_mono_lty pREC_OP ty2
+
+ppr_mono_ty ctxt_prec (HsParTy ty)
+  = parens (ppr_mono_lty pREC_TOP ty)
+
+ppr_mono_ty ctxt_prec (HsDocTy ty doc)
+  = ppLType ty
+
+ppr_fun_ty ctxt_prec ty1 ty2
+  = let p1 = ppr_mono_lty pREC_FUN ty1
+        p2 = ppr_mono_lty pREC_TOP ty2
+    in
+    maybeParen ctxt_prec pREC_FUN $
+    hsep [p1, arrow <+> p2]
+
+-- ----------------------------------------------------------------------------
+-- Names
+
+ppOccName :: OccName -> Html
+ppOccName name = toHtml $ occNameString name
+
+ppRdrName :: RdrName -> Html
+ppRdrName = ppOccName . rdrNameOcc
+
+ppLDocName (L _ d) = ppDocName d
+
+ppDocName :: DocName -> Html
+ppDocName (Link name) = linkId (nameModule name) (Just name) << ppName name
+ppDocName (NoLink name) = toHtml (getOccString name)
+
+linkTarget :: Name -> Html
+linkTarget name = namedAnchor (anchorNameStr name) << toHtml "" 
+
+ppName :: Name -> Html
+ppName name = toHtml (getOccString name)
+
+ppBinder :: Bool -> Name -> Html
+-- The Bool indicates whether we are generating the summary, in which case
+-- the binder will be a link to the full definition.
+ppBinder True nm = linkedAnchor (anchorNameStr nm) << ppBinder' nm
+ppBinder False nm = linkTarget nm +++ bold << ppBinder' nm
+
+ppBinder' :: Name -> Html
+ppBinder' name 
+  | isVarSym name = parens $ toHtml (getOccString name)
+  | otherwise = toHtml (getOccString name)             
+
+linkId :: Module -> Maybe Name -> Html -> Html
+linkId mod mbName = anchor ! [href hr]
+  where 
+    hr = case mbName of
+      Nothing   -> moduleHtmlFile mod
+      Just name -> nameHtmlRef mod name
+
+ppModule :: Module -> String -> Html
+ppModule mod ref = anchor ! [href ((moduleHtmlFile mod) ++ ref)] 
+                   << toHtml (moduleString mod)
+
+-- -----------------------------------------------------------------------------
+-- * Doc Markup
+
+parHtmlMarkup :: (a -> Html) -> DocMarkup a Html
+parHtmlMarkup ppId = Markup {
+  markupParagraph     = paragraph,
+  markupEmpty	      = toHtml "",
+  markupString        = toHtml,
+  markupAppend        = (+++),
+  markupIdentifier    = tt . ppId . head,
+  markupModule        = \m -> ppModule (mkModuleNoPkg m) "",
+  markupEmphasis      = emphasize . toHtml,
+  markupMonospaced    = tt . toHtml,
+  markupUnorderedList = ulist . concatHtml . map (li <<),
+  markupOrderedList   = olist . concatHtml . map (li <<),
+  markupDefList       = dlist . concatHtml . map markupDef,
+  markupCodeBlock     = pre,
+  markupURL	      = \url -> anchor ! [href url] << toHtml url,
+  markupAName	      = \aname -> namedAnchor aname << toHtml ""
+  }
+
+markupDef (a,b) = dterm << a +++ ddef << b
+
+htmlMarkup = parHtmlMarkup ppDocName
+htmlOrigMarkup = parHtmlMarkup ppName
+htmlRdrMarkup = parHtmlMarkup ppRdrName
+
+-- If the doc is a single paragraph, don't surround it with <P> (this causes
+-- ugly extra whitespace with some browsers).
+docToHtml :: GHC.HsDoc DocName -> Html
+docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc))
+
+origDocToHtml :: GHC.HsDoc GHC.Name -> Html
+origDocToHtml doc = markup htmlOrigMarkup (unParagraph (markup htmlCleanup doc))
+
+rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc))
+
+-- If there is a single paragraph, then surrounding it with <P>..</P>
+-- can add too much whitespace in some browsers (eg. IE).  However if
+-- we have multiple paragraphs, then we want the extra whitespace to
+-- separate them.  So we catch the single paragraph case and transform it
+-- here.
+unParagraph (GHC.DocParagraph d) = d
+--NO: This eliminates line breaks in the code block:  (SDM, 6/5/2003)
+--unParagraph (DocCodeBlock d) = (DocMonospaced d)
+unParagraph doc              = doc
+
+htmlCleanup :: DocMarkup a (GHC.HsDoc a)
+htmlCleanup = idMarkup { 
+  markupUnorderedList = GHC.DocUnorderedList . map unParagraph,
+  markupOrderedList   = GHC.DocOrderedList   . map unParagraph
+  } 
+
+-- -----------------------------------------------------------------------------
+-- * Misc
+
+hsep :: [Html] -> Html
+hsep [] = noHtml
+hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
+
+infixr 8 <+>
+(<+>) :: Html -> Html -> Html
+a <+> b = Html (getHtmlElements (toHtml a) ++ HtmlString " ": getHtmlElements (toHtml b))
+
+keyword :: String -> Html
+keyword s = thespan ! [theclass "keyword"] << toHtml s
+
+equals, comma :: Html
+equals = char '='
+comma  = char ','
+
+char :: Char -> Html
+char c = toHtml [c]
+
+empty :: Html
+empty  = noHtml
+
+parens, brackets, braces :: Html -> Html
+parens h        = char '(' +++ h +++ char ')'
+brackets h      = char '[' +++ h +++ char ']'
+pabrackets h    = toHtml "[:" +++ h +++ toHtml ":]"
+braces h        = char '{' +++ h +++ char '}'
+
+punctuate :: Html -> [Html] -> [Html]
+punctuate _ []     = []
+punctuate h (d0:ds) = go d0 ds
+                   where
+                     go d [] = [d]
+                     go d (e:es) = (d +++ h) : go e es
+
+abovesSep :: HtmlTable -> [HtmlTable] -> HtmlTable
+abovesSep _ []      = Html.emptyTable
+abovesSep h (d0:ds) = go d0 ds
+                   where
+                     go d [] = d
+                     go d (e:es) = d </> h </> go e es
+
+parenList :: [Html] -> Html
+parenList = parens . hsep . punctuate comma
+
+ubxParenList :: [Html] -> Html
+ubxParenList = ubxparens . hsep . punctuate comma
+
+ubxparens :: Html -> Html
+ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
+
+{-
+text :: Html
+text   = strAttr "TEXT"
+-}
+
+-- a box for displaying code
+declBox :: Html -> HtmlTable
+declBox html = tda [theclass "decl"] << html
+
+-- a box for top level documented names
+-- it adds a source and wiki link at the right hand side of the box
+topDeclBox :: LinksInfo -> SrcSpan -> Name -> Html -> HtmlTable
+topDeclBox ((_,_,Nothing), (_,_,Nothing), _) _ _ html = declBox html
+topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), hmod)
+           loc name html =
+  tda [theclass "topdecl"] <<
+  (        table ! [theclass "declbar"] <<
+	    ((tda [theclass "declname"] << html)
+             <-> srcLink
+             <-> wikiLink)
+  )
+  where srcLink =
+          case maybe_source_url of
+            Nothing  -> Html.emptyTable
+            Just url -> tda [theclass "declbut"] <<
+                          let url' = spliceURL (Just fname) (Just mod)
+                                               (Just name) url
+                           in anchor ! [href url'] << toHtml "Source"
+        wikiLink =
+          case maybe_wiki_url of
+            Nothing  -> Html.emptyTable
+            Just url -> tda [theclass "declbut"] <<
+                          let url' = spliceURL (Just fname) (Just mod)
+                                               (Just name) url
+                           in anchor ! [href url'] << toHtml "Comments"
+  
+        mod = hmod_mod hmod
+        fname = unpackFS (srcSpanFile loc)
+
+-- a box for displaying an 'argument' (some code which has text to the
+-- right of it).  Wrapping is not allowed in these boxes, whereas it is
+-- in a declBox.
+argBox :: Html -> HtmlTable
+argBox html = tda [theclass "arg"] << html
+
+-- a box for displaying documentation, 
+-- indented and with a little padding at the top
+docBox :: Html -> HtmlTable
+docBox html = tda [theclass "doc"] << html
+
+-- a box for displaying documentation, not indented.
+ndocBox :: Html -> HtmlTable
+ndocBox html = tda [theclass "ndoc"] << html
+
+-- a box for displaying documentation, padded on the left a little
+rdocBox :: Html -> HtmlTable
+rdocBox html = tda [theclass "rdoc"] << html
+
+maybeRDocBox :: Maybe (GHC.LHsDoc DocName) -> HtmlTable
+maybeRDocBox Nothing = rdocBox (noHtml)
+maybeRDocBox (Just ldoc) = rdocBox (docToHtml (unLoc ldoc))
+
+-- a box for the buttons at the top of the page
+topButBox :: Html -> HtmlTable
+topButBox html = tda [theclass "topbut"] << html
+
+-- a vanilla table has width 100%, no border, no padding, no spacing
+-- a narrow table is the same but without width 100%.
+vanillaTable, narrowTable :: Html -> Html
+vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0]
+vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0]
+narrowTable  = table ! [theclass "narrow",  cellspacing 0, cellpadding 0]
+
+spacedTable1, spacedTable5 :: Html -> Html
+spacedTable1 = table ! [theclass "vanilla",  cellspacing 1, cellpadding 0]
+spacedTable5 = table ! [theclass "vanilla",  cellspacing 5, cellpadding 0]
+
+constrHdr, methHdr :: HtmlTable
+constrHdr  = tda [ theclass "section4" ] << toHtml "Constructors"
+methHdr    = tda [ theclass "section4" ] << toHtml "Methods"
+
+instHdr :: String -> HtmlTable
+instHdr id = 
+  tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances")
+
+dcolon, arrow, darrow :: Html
+dcolon = toHtml "::"
+arrow  = toHtml "->"
+darrow = toHtml "=>"
+dot    = toHtml "."
+
+s8, s15 :: HtmlTable
+s8  = tda [ theclass "s8" ]  << noHtml
+s15 = tda [ theclass "s15" ] << noHtml
+
+namedAnchor :: String -> Html -> Html
+namedAnchor n = anchor ! [name (escapeStr n)]
+
+--
+-- A section of HTML which is collapsible via a +/- button.
+--
+
+-- TODO: Currently the initial state is non-collapsed. Change the 'minusFile'
+-- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we
+-- use cookies from JavaScript to have a more persistent state.
+
+collapsebutton :: String -> Html
+collapsebutton id = 
+  image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id ++ "')"), alt "show/hide" ]
+
+collapsed :: (HTML a) => (Html -> Html) -> String -> a -> Html
+collapsed fn id html =
+  fn ! [identifier id, thestyle "display:block;"] << html
+
+-- A quote is a valid part of a Haskell identifier, but it would interfere with
+-- the ECMA script string delimiter used in collapsebutton above.
+collapseId :: Name -> String
+collapseId nm = "i:" ++ escapeStr (getOccString nm)
+
+linkedAnchor :: String -> Html -> Html
+linkedAnchor frag = anchor ! [href hr]
+   where hr | null frag = ""
+            | otherwise = '#': escapeStr frag
+
+documentCharacterEncoding :: Html
+documentCharacterEncoding =
+   meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"]
+
+styleSheet :: Html
+styleSheet =
+   thelink ! [href cssFile, rel "stylesheet", thetype "text/css"]
diff --git a/src/Haddock/DevHelp.hs b/src/Haddock/DevHelp.hs
deleted file mode 100644
index 3401a7b4..00000000
--- a/src/Haddock/DevHelp.hs
+++ /dev/null
@@ -1,81 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.DevHelp(ppDevHelpFile) where
-
-import Haddock.ModuleTree
-import Haddock.Types
-import Haddock.Utils
-
-import Module        ( moduleName, moduleNameString, Module, mkModule, mkModuleName )
-import PackageConfig ( stringToPackageId )
-import Name          ( Name, nameModule, getOccString )
-
-import Data.Maybe    ( fromMaybe )
-import qualified Data.Map as Map
-import Text.PrettyPrint
-
-ppDevHelpFile :: FilePath -> String -> Maybe String -> [HaddockModule] -> IO ()
-ppDevHelpFile odir doctitle maybe_package modules = do
-  let devHelpFile = package++".devhelp"
-      tree = mkModuleTree True [ (hmod_mod mod, toDescription mod) | mod <- modules ]
-      doc =
-        text "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$
-        (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>
-            text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$
-        text "<chapters>" $$
-        nest 4 (ppModuleTree [] tree) $+$
-        text "</chapters>" $$
-        text "<functions>" $$
-        nest 4 (ppList index) $+$
-        text "</functions>" $$
-        text "</book>"
-  writeFile (pathJoin [odir, devHelpFile]) (render doc)
-  where    
-    package = fromMaybe "pkg" maybe_package
-
-    ppModuleTree :: [String] -> [ModuleTree] -> Doc
-    ppModuleTree ss [x]    = ppNode ss x
-    ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs
-    ppModuleTree _  []     = error "HaddockHH.ppHHContents.fn: no module trees given"
-
-    ppNode :: [String] -> ModuleTree -> Doc
-    ppNode ss (Node s leaf _ _short ts) =
-        case ts of
-          [] -> text "<sub"<+>ppAttribs<>text "/>"
-          ts -> 
-            text "<sub"<+>ppAttribs<>text ">" $$
-            nest 4 (ppModuleTree (s:ss) ts) $+$
-            text "</sub>"
-        where
-          ppLink | leaf      = text (moduleHtmlFile (mkModule (stringToPackageId "") 
-                                                              (mkModuleName mdl)))
-                 | otherwise = empty
-
-          ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink
-
-          mdl = foldr (++) "" (s' : map ('.':) ss')
-          (s':ss') = reverse (s:ss)
-		-- reconstruct the module name
-
-    index :: [(Name, [Module])]
-    index = Map.toAscList (foldr getModuleIndex Map.empty modules)
-
-    getModuleIndex hmod fm =
-	Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mod]) | name <- hmod_exports hmod, nameModule name == mod]) fm
-	where mod = hmod_mod hmod
-
-    ppList :: [(Name, [Module])] -> Doc
-    ppList [] = empty
-    ppList ((name,refs):mdls)  =
-      ppReference name refs $$
-      ppList mdls
-
-    ppReference :: Name -> [Module] -> Doc
-    ppReference name [] = empty
-    ppReference name (mod:refs) =  
-      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mod name)<>text"\"/>" $$
-      ppReference name refs
diff --git a/src/Haddock/GHC/Typecheck.hs b/src/Haddock/GHC/Typecheck.hs
new file mode 100644
index 00000000..e8e291ad
--- /dev/null
+++ b/src/Haddock/GHC/Typecheck.hs
@@ -0,0 +1,106 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+
+module Haddock.GHC.Typecheck (
+  typecheckFiles  
+) where
+
+
+import Haddock.Exception
+import Haddock.Utils.GHC
+import Haddock.Types
+
+import Data.Maybe
+import Control.Monad
+import GHC
+import Digraph
+import BasicTypes
+import SrcLoc
+
+
+typecheckFiles :: Session -> [FilePath] -> IO [GhcModule]
+typecheckFiles session files = do
+  checkedMods <- sortAndCheckModules session files
+  return (map mkGhcModule checkedMods)
+
+
+-- | Get the sorted graph of all loaded modules and their dependencies
+getSortedModuleGraph :: Session -> IO [(Module, FilePath)]
+getSortedModuleGraph session = do
+  mbModGraph <- depanal session [] True
+  moduleGraph <- case mbModGraph of
+    Just mg -> return mg
+    Nothing -> throwE "Failed to load all modules"
+  let
+    getModFile    = fromJust . ml_hs_file . ms_location
+    sortedGraph   = topSortModuleGraph False moduleGraph Nothing
+    sortedModules = concatMap flattenSCC sortedGraph
+    modsAndFiles  = [ (ms_mod modsum, getModFile modsum) |
+                      modsum <- sortedModules ]
+  return modsAndFiles
+
+
+type CheckedMod = (Module, FilePath, FullyCheckedMod)
+
+
+type FullyCheckedMod = (ParsedSource, 
+                        RenamedSource, 
+                        TypecheckedSource, 
+                        ModuleInfo)
+
+
+-- TODO: make it handle cleanup
+sortAndCheckModules :: Session -> [FilePath] -> IO [CheckedMod]
+sortAndCheckModules session files = do 
+
+  -- load all argument files
+
+  targets <- mapM (\f -> guessTarget f Nothing) files
+  setTargets session targets 
+
+  -- compute the dependencies and load them as well
+
+  allMods <- getSortedModuleGraph session
+  targets' <- mapM (\(_, f) -> guessTarget f Nothing) allMods
+  setTargets session targets'
+
+  flag <- load session LoadAllTargets
+  when (failed flag) $ 
+    throwE "Failed to load all needed modules"
+
+  -- typecheck the argument modules
+
+  let argMods = filter ((`elem` files) . snd) allMods
+
+  checkedMods <- forM argMods $ \(mod, file) -> do
+    mbMod <- checkModule session (moduleName mod) False
+    case mbMod of
+      Just (CheckedModule a (Just b) (Just c) (Just d) _) 
+        -> return (mod, file, (a,b,c,d))
+      _ -> throwE ("Failed to check module: " ++ moduleString mod)
+
+  return checkedMods
+
+
+-- | Dig out what we want from the typechecker output
+mkGhcModule :: CheckedMod -> GhcModule 
+mkGhcModule (mod, file, checkedMod) = GhcModule {
+  ghcModule         = mod,
+  ghcFilename       = file,
+  ghcMbDocOpts      = mbOpts,
+  ghcHaddockModInfo = info,
+  ghcMbDoc          = mbDoc,
+  ghcGroup          = group,
+  ghcMbExports      = mbExports,
+  ghcExportedNames  = modInfoExports modInfo,
+  ghcNamesInScope   = fromJust $ modInfoTopLevelScope modInfo, 
+  ghcInstances      = modInfoInstances modInfo
+}
+  where
+    HsModule _ _ _ _ _ mbOpts _ _      = unLoc parsed
+    (group, _, mbExports, mbDoc, info) = renamed
+    (parsed, renamed, _, modInfo)      = checkedMod
diff --git a/src/Haddock/GHC/Utils.hs b/src/Haddock/GHC/Utils.hs
new file mode 100644
index 00000000..8e70057f
--- /dev/null
+++ b/src/Haddock/GHC/Utils.hs
@@ -0,0 +1,79 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+
+module Haddock.GHC.Utils where
+
+
+import Debug.Trace
+import Data.Char
+
+import GHC
+import HsSyn
+import SrcLoc
+import HscTypes
+import Outputable
+import Packages
+import UniqFM
+import Name
+
+
+-- names
+
+nameOccString = occNameString . nameOccName 
+
+
+nameSetMod n newMod = 
+  mkExternalName (nameUnique n) newMod (nameOccName n) (nameSrcSpan n)
+
+
+nameSetPkg pkgId n = 
+  mkExternalName (nameUnique n) (mkModule pkgId (moduleName mod)) 
+	               (nameOccName n) (nameSrcSpan n)
+  where mod = nameModule n
+
+
+-- modules
+
+
+moduleString :: Module -> String
+moduleString = moduleNameString . moduleName 
+
+
+mkModuleNoPkg :: String -> Module
+mkModuleNoPkg str = mkModule (stringToPackageId "") (mkModuleName str)
+
+
+modulePkgStr = packageIdString . modulePackageId
+
+
+-- misc
+
+
+-- there should be a better way to check this using the GHC API
+isConSym n = head (nameOccString n) == ':'
+isVarSym n = fstChar /= '_' && not (isConSym n) && (not . isLetter) fstChar
+  where fstChar = head (nameOccString n)
+
+
+getMainDeclBinder :: HsDecl name -> Maybe name
+getMainDeclBinder (TyClD d) = Just (tcdName d)
+getMainDeclBinder (ValD d)
+   = case collectAcc d [] of
+        []       -> Nothing 
+        (name:_) -> Just (unLoc name)
+getMainDeclBinder (SigD d) = sigNameNoLoc d
+getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name)
+getMainDeclBinder (ForD (ForeignExport name _ _)) = Nothing
+getMainDeclBinder _ = Nothing
+
+
+-- To keep if if minf_iface is re-introduced
+--modInfoName = moduleName . mi_module . minf_iface
+--modInfoMod  = mi_module . minf_iface 
+
+
+trace_ppr x y = trace (showSDoc (ppr x)) y
diff --git a/src/Haddock/HH.hs b/src/Haddock/HH.hs
deleted file mode 100644
index dc8f37e0..00000000
--- a/src/Haddock/HH.hs
+++ /dev/null
@@ -1,180 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.HH(ppHHContents, ppHHIndex, ppHHProject) where
-
-ppHHContents = error "not yet"
-ppHHIndex = error "not yet"
-ppHHProject = error "not yet"
-
-{-
-import HaddockModuleTree
-import HaddockTypes
-import HaddockUtil
-import HsSyn2 hiding(Doc)
-import qualified Map
-
-import Data.Char ( toUpper )
-import Data.Maybe ( fromMaybe )
-import Text.PrettyPrint
-
-ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
-ppHHContents odir doctitle maybe_package tree = do
-  let contentsHHFile = package++".hhc"
-
-      html =
-      	text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
-	text "<HTML>" $$
-	text "<HEAD>" $$
-	text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
-	text "<!-- Sitemap 1.0 -->" $$
-	text "</HEAD><BODY>" $$
-	ppModuleTree tree $$
-	text "</BODY><HTML>"
-  writeFile (pathJoin [odir, contentsHHFile]) (render html)
-  where
-	package = fromMaybe "pkg" maybe_package
-	
-	ppModuleTree :: [ModuleTree] -> Doc
-	ppModuleTree ts =
-		text "<OBJECT type=\"text/site properties\">" $$
-		text "<PARAM name=\"FrameName\" value=\"main\">" $$
-		text "</OBJECT>" $$
-		text "<UL>" $+$
-		nest 4 (text "<LI>" <> nest 4
-		                (text "<OBJECT type=\"text/sitemap\">" $$
-		                 nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$
-		                         text "<PARAM name=\"Local\" value=\"index.html\">") $$
-		                 text "</OBJECT>") $+$
-		        text "</LI>" $$
-		        text "<UL>" $+$
-		        nest 4 (fn [] ts) $+$
-		        text "</UL>") $+$
-		text "</UL>"
-
-	fn :: [String] -> [ModuleTree] -> Doc
-	fn ss [x]    = ppNode ss x
-	fn ss (x:xs) = ppNode ss x $$ fn ss xs
-        fn _  []     = error "HaddockHH.ppHHContents.fn: no module trees given"
-
-	ppNode :: [String] -> ModuleTree -> Doc
-	ppNode ss (Node s leaf _pkg _ []) =
-	  ppLeaf s ss leaf
-	ppNode ss (Node s leaf _pkg _ ts) =
-	  ppLeaf s ss leaf $$
-	  text "<UL>" $+$
-	  nest 4 (fn (s:ss) ts) $+$
-	  text "</UL>"
-
-	ppLeaf s ss isleaf  =
-		text "<LI>" <> nest 4
-			(text "<OBJECT type=\"text/sitemap\">" $$
-			 text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$
-			 (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile mdl) <> text "\">" else empty) $$
-			 text "</OBJECT>") $+$
-		text "</LI>"
-		where 
-			mdl = foldr (++) "" (s' : map ('.':) ss')
-			(s':ss') = reverse (s:ss)
-			-- reconstruct the module name
-		
--------------------------------
-ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO ()
-ppHHIndex odir maybe_package ifaces = do
-  let indexHHFile = package++".hhk"
-  
-      html = 
-      	text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
-	text "<HTML>" $$
-	text "<HEAD>" $$
-	text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
-	text "<!-- Sitemap 1.0 -->" $$
-	text "</HEAD><BODY>" $$
-	text "<UL>" $+$
-	nest 4 (ppList index) $+$
-	text "</UL>" $$
-	text "</BODY><HTML>"
-  writeFile (pathJoin [odir, indexHHFile]) (render html)
-  where
-	package = fromMaybe "pkg" maybe_package
-  	
-	index :: [(HsName, [Module])]
-	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
-
-	getIfaceIndex iface fm =
-		foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']
-		where mdl = iface_module iface
-	
-	ppList [] = empty
-	ppList ((name,refs):mdls)  =
-		text "<LI>" <> nest 4
-				(text "<OBJECT type=\"text/sitemap\">" $$
-				 text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$
-				 ppReference name refs $$
-				 text "</OBJECT>") $+$
-		text "</LI>" $$
-		ppList mdls
-
-	ppReference name [] = empty
-	ppReference name (Module mdl:refs) =
-		text "<PARAM name=\"Local\" value=\"" <> text (nameHtmlRef mdl name) <> text "\">" $$
-		ppReference name refs
-
-
-ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO ()
-ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
-  let projectHHFile = package++".hhp"
-      doc =
-        text "[OPTIONS]" $$
-        text "Compatibility=1.1 or later" $$
-        text "Compiled file=" <> text package <> text ".chm" $$
-        text "Contents file=" <> text package <> text ".hhc" $$
-        text "Default topic=" <> text contentsHtmlFile $$
-        text "Display compile progress=No" $$
-        text "Index file=" <> text package <> text ".hhk" $$
-        text "Title=" <> text doctitle $$
-	space $$
-        text "[FILES]" $$
-        ppMods ifaces $$
-        text contentsHtmlFile $$
-        text indexHtmlFile $$
-        ppIndexFiles chars $$
-        ppLibFiles ("":pkg_paths)
-  writeFile (pathJoin [odir, projectHHFile]) (render doc)
-  where
-    package = fromMaybe "pkg" maybe_package
-	
-    ppMods [] = empty
-    ppMods (iface:ifaces) =
-	let Module mdl = iface_module iface in
-        text (moduleHtmlFile mdl) $$
-        ppMods ifaces
-		
-    ppIndexFiles []     = empty
-    ppIndexFiles (c:cs) =
-        text (subIndexHtmlFile c) $$
-        ppIndexFiles cs
-        
-    ppLibFiles []           = empty
-    ppLibFiles (path:paths) =
-        ppLibFile cssFile   $$
-    	ppLibFile iconFile  $$
-    	ppLibFile jsFile    $$
-    	ppLibFile plusFile  $$
-        ppLibFile minusFile $$
-        ppLibFiles paths
-        where
-            toPath fname | null path = fname
-	                 | otherwise = pathJoin [path, fname]
-            ppLibFile fname = text (toPath fname)
-
-    chars :: [Char]
-    chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
-
-    getIfaceIndex iface fm =
-        Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
-	where mdl = iface_module iface
--}
diff --git a/src/Haddock/HH2.hs b/src/Haddock/HH2.hs
deleted file mode 100644
index 7f88ed51..00000000
--- a/src/Haddock/HH2.hs
+++ /dev/null
@@ -1,188 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.HH2(ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where
-
-ppHH2Contents = error "not yet"
-ppHH2Index = error "not yet"
-ppHH2Files = error "not yet"
-ppHH2Collection = error "not yet"
-
-{-
-import HaddockModuleTree
-import HaddockTypes
-import HaddockUtil
-import HsSyn2 hiding(Doc)
-import qualified Map
-
-import Data.Char ( toUpper )
-import Data.Maybe ( fromMaybe )
-import Text.PrettyPrint
-
-ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
-ppHH2Contents odir doctitle maybe_package tree = do
-  let 	
-	contentsHH2File = package++".HxT"
-
-	doc  =
-		text "<?xml version=\"1.0\"?>" $$
-		text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$
-		text "<HelpTOC DTDVersion=\"1.0\">" $$
-		nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$
-		        nest 4 (ppModuleTree [] tree) $+$
-		        text "</HelpTOCNode>") $$
-		text "</HelpTOC>"
-  writeFile (pathJoin [odir, contentsHH2File]) (render doc)
-  where
-	package = fromMaybe "pkg" maybe_package
-	
-	ppModuleTree :: [String] -> [ModuleTree] -> Doc
-	ppModuleTree ss [x]    = ppNode ss x
-	ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs
-	ppModuleTree _  []     = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given"
-
-	ppNode :: [String] -> ModuleTree -> Doc
-	ppNode ss (Node s leaf _pkg _short []) =
-	  text "<HelpTOCNode"  <+> ppAttributes leaf (s:ss) <> text "/>"
-	ppNode ss (Node s leaf _pkg _short ts) =
-	  text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$
-	  nest 4 (ppModuleTree (s:ss) ts) $+$
-	  text "</HelpTOCNode>"
-			
-	ppAttributes :: Bool -> [String] -> Doc
-	ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl]
-	  where
-	    mdl = foldr (++) "" (s' : map ('.':) ss')
-	    (s':ss') = reverse ss
-	                -- reconstruct the module name
-	    
-	    ppId = text "Id=" <> doubleQuotes (text mdl)
-	    
-	    ppTitle = text "Title=" <> doubleQuotes (text (head ss))
-	    
-	    ppUrl | isleaf    = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl))
-	          | otherwise = empty
-
------------------------------------------------------------------------------------
-
-ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO ()
-ppHH2Index odir maybe_package ifaces = do
-  let 
-	indexKHH2File     = package++"K.HxK"
-	indexNHH2File     = package++"N.HxK"
-	docK = 
-		text "<?xml version=\"1.0\"?>" $$
-		text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
-		text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$
-		nest 4 (ppList index) $+$
-		text "</HelpIndex>"  
-	docN = 
-		text "<?xml version=\"1.0\"?>" $$
-		text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
-		text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$
-		text "<Keyword Term=\"HomePage\">" $$
-		nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$
-		text "</Keyword>" $$
-		text "</HelpIndex>"
-  writeFile (pathJoin [odir, indexKHH2File]) (render docK)
-  writeFile (pathJoin [odir, indexNHH2File]) (render docN)
-  where
-	package = fromMaybe "pkg" maybe_package
-    
-	index :: [(HsName, [Module])]
-	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
-
-	getIfaceIndex iface fm =
-	    Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
-	    where mdl = iface_module iface
-	
-	ppList [] = empty
-	ppList ((name,mdls):vs)  =
-		text "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$
-		nest 4 (vcat (map (ppJump name) mdls)) $$
-		text "</Keyword>" $$
-		ppList vs
-
-	ppJump name (Module mdl) = text "<Jump Url=\"" <> text (nameHtmlRef mdl name) <> text "\"/>"
-
-
------------------------------------------------------------------------------------
-
-ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
-ppHH2Files odir maybe_package ifaces pkg_paths = do
-  let filesHH2File = package++".HxF"
-      doc =
-        text "<?xml version=\"1.0\"?>" $$
-        text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$
-        text "<HelpFileList DTDVersion=\"1.0\">" $$
-        nest 4 (ppMods ifaces $$
-                text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$
-                text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$
-                ppIndexFiles chars $$
-                ppLibFiles ("":pkg_paths)) $$
-        text "</HelpFileList>"
-  writeFile (pathJoin [odir, filesHH2File]) (render doc)
-  where
-    package = fromMaybe "pkg" maybe_package
-	
-    ppMods [] = empty
-    ppMods (iface:ifaces) =
-		text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$
-		ppMods ifaces
-		where Module mdl = iface_module iface
-		
-    ppIndexFiles []     = empty
-    ppIndexFiles (c:cs) =
-        text "<File Url=\""<>text (subIndexHtmlFile c)<>text "\"/>" $$
-        ppIndexFiles cs
-        
-    ppLibFiles []           = empty
-    ppLibFiles (path:paths) =        
-        ppLibFile cssFile   $$
-	ppLibFile iconFile  $$
-	ppLibFile jsFile    $$
-	ppLibFile plusFile  $$
-        ppLibFile minusFile $$
-        ppLibFiles paths
-        where
-            toPath fname | null path = fname
-                         | otherwise = pathJoin [path, fname]
-            ppLibFile fname = text "<File Url=\""<>text (toPath fname)<>text "\"/>"
-
-    chars :: [Char]
-    chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
-
-    getIfaceIndex iface fm =
-        Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
-	where mdl = iface_module iface
-
------------------------------------------------------------------------------------
-
-ppHH2Collection :: FilePath -> String -> Maybe String -> IO ()
-ppHH2Collection odir doctitle maybe_package = do
-  let 
-	package = fromMaybe "pkg" maybe_package
-	collectionHH2File = package++".HxC"
-	
-	doc =
-		text "<?xml version=\"1.0\"?>" $$
-		text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$
-		text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$
-		nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$
-		        nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$
-		        text "</CompilerOptions>" $$
-		        text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$
-		        text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$
-		        text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$
-		        text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$
-		        text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$
-		        text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$
-		        text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$
-		        text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$
-		        text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$
-		text "</HelpCollection>"
-  writeFile (pathJoin [odir, collectionHH2File]) (render doc)
--}
diff --git a/src/Haddock/HaddockDB.hs b/src/Haddock/HaddockDB.hs
deleted file mode 100644
index 6341c6c4..00000000
--- a/src/Haddock/HaddockDB.hs
+++ /dev/null
@@ -1,165 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.HaddockDB (ppDocBook) where
-
-{-
-import HaddockTypes
-import HaddockUtil
-import HsSyn2
-
-import Text.PrettyPrint
--}
-
------------------------------------------------------------------------------
--- Printing the results in DocBook format
-
-ppDocBook = error "not working"
-{-
-ppDocBook :: FilePath -> [(Module, Interface)] -> String
-ppDocBook odir mods = render (ppIfaces mods)
-
-ppIfaces mods
-  =  text "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["
-  $$ text "]>"
-  $$ text "<book>"
-  $$ text "<bookinfo>"
-  $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"
-  $$ text "</bookinfo>"
-  $$ text "<article>"
-  $$ vcat (map do_mod mods)
-  $$ text "</article></book>"
-  where
-     do_mod (Module mod, iface)
-        =  text "<sect1 id=\"sec-" <> text mod <> text "\">"
-        $$ text "<title><literal>" 
-	   <> text mod
-	   <> text "</literal></title>"
-	$$ text "<indexterm><primary><literal>"
-	   <> text mod
-	   <> text "</literal></primary></indexterm>"
-	$$ text "<variablelist>"
-	$$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))
-	$$ text "</variablelist>"
-	$$ text "</sect1>"
- 
-     do_export mod decl | (nm:_) <- declBinders decl
-	=  text "<varlistentry id=" <> ppLinkId mod nm <> char '>'
-	$$ text "<term><literal>" 
-		<> do_decl decl
-		<> text "</literal></term>"
-	$$ text "<listitem>"
-	$$ text "<para>"
-	$$ text "</para>"
-	$$ text "</listitem>"
-	$$ text "</varlistentry>"
-     do_export _ _ = empty
-
-     do_decl (HsTypeSig _ [nm] ty _) 
-	=  ppHsName nm <> text " :: " <> ppHsType ty
-     do_decl (HsTypeDecl _ nm args ty _)
-	=  hsep ([text "type", ppHsName nm ]
-		 ++ map ppHsName args 
-		 ++ [equals, ppHsType ty])
-     do_decl (HsNewTypeDecl loc ctx nm args con drv _)
-	= hsep ([text "data", ppHsName nm] -- data, not newtype
-		++ map ppHsName args
-		) <+> equals <+> ppHsConstr con -- ToDo: derivings
-     do_decl (HsDataDecl loc ctx nm args cons drv _)
-	= hsep ([text "data", {-ToDo: context-}ppHsName nm]
-	        ++ map ppHsName args)
-            <+> vcat (zipWith (<+>) (equals : repeat (char '|'))
-                                    (map ppHsConstr cons))
-     do_decl (HsClassDecl loc ty fds decl _)
-	= hsep [text "class", ppHsType ty]
-     do_decl decl
-	= empty
-
-ppHsConstr :: HsConDecl -> Doc
-ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) =
-	 ppHsName name
-	 <> (braces . hsep . punctuate comma . map ppField $ fieldList)
-ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = 
-	 hsep (ppHsName name : map ppHsBangType typeList)
-
-ppField (HsFieldDecl ns ty doc)
-   = hsep (punctuate comma (map ppHsName ns) ++
-	 	[text "::", ppHsBangType ty])
-
-ppHsBangType :: HsBangType -> Doc
-ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty
-ppHsBangType (HsUnBangedTy ty) = ppHsType ty
-
-ppHsContext :: HsContext -> Doc
-ppHsContext []      = empty
-ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> 
-					 hsep (map ppHsAType b)) context)
-
-ppHsType :: HsType -> Doc
-ppHsType (HsForAllType Nothing context htype) =
-     hsep [ ppHsContext context, text "=>", ppHsType htype]
-ppHsType (HsForAllType (Just tvs) [] htype) =
-     hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype])
-ppHsType (HsForAllType (Just tvs) context htype) =
-     hsep (text "forall" : map ppHsName tvs ++ text "." : 
-	   ppHsContext context : text "=>" : [ppHsType htype])
-ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "-&gt;", ppHsType b]
-ppHsType (HsTyIP n t)  = fsep [(char '?' <> ppHsName n), text "::", ppHsType t]
-ppHsType t = ppHsBType t
-
-ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
-  = brackets $ ppHsType b
-ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b]
-ppHsBType t = ppHsAType t
-
-ppHsAType :: HsType -> Doc
-ppHsAType (HsTyTuple True l)  = parenList . map ppHsType $ l
-ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l
--- special case
-ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
-  = brackets $ ppHsType b
-ppHsAType (HsTyVar name) = ppHsName name
-ppHsAType (HsTyCon name) = ppHsQName name
-ppHsAType t = parens $ ppHsType t
-
-ppHsQName :: HsQName -> Doc
-ppHsQName (UnQual str)			= ppHsName str
-ppHsQName n@(Qual (Module mod) str)
-	 | n == unit_con_name		= ppHsName str
-	 | isSpecial str 		= ppHsName str
-	 | otherwise 
-		=  text "<link linkend=" <> ppLinkId mod str <> char '>'
-		<> ppHsName str
-		<> text "</link>"
-
-isSpecial (HsTyClsName id) | HsSpecial _ <- id = True
-isSpecial (HsVarName id) | HsSpecial _ <- id = True
-isSpecial _ = False
-
-ppHsName :: HsName -> Doc
-ppHsName (HsTyClsName id) = ppHsIdentifier id
-ppHsName (HsVarName id) = ppHsIdentifier id
-
-ppHsIdentifier :: HsIdentifier -> Doc
-ppHsIdentifier (HsIdent str)	= text str
-ppHsIdentifier (HsSymbol str) = text str
-ppHsIdentifier (HsSpecial str) = text str
-
-ppLinkId :: String -> HsName -> Doc
-ppLinkId mod str
-  = hcat [char '\"', text mod, char '.', ppHsName str, char '\"']
-
--- -----------------------------------------------------------------------------
--- * Misc
-
-parenList :: [Doc] -> Doc
-parenList = parens . fsep . punctuate comma
-
-ubxParenList :: [Doc] -> Doc
-ubxParenList = ubxparens . fsep . punctuate comma
-
-ubxparens p = text "(#" <> p <> text "#)"
--}
diff --git a/src/Haddock/Hoogle.hs b/src/Haddock/Hoogle.hs
deleted file mode 100644
index 618d6eb3..00000000
--- a/src/Haddock/Hoogle.hs
+++ /dev/null
@@ -1,184 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
--- This file, (c) Neil Mitchell 2006
--- Write out Hoogle compatible documentation
--- http://www.haskell.org/hoogle/
-
-module Haddock.Hoogle ( 
-	ppHoogle
-  ) where
-
-ppHoogle = undefined
-
-{-
-import HaddockTypes
-import HaddockUtil
-import HsSyn2
-
-import Data.List ( intersperse )
-
-
-
-prefix = ["-- Hoogle documentation, generated by Haddock",
-          "-- See Hoogle, http://www.haskell.org/hoogle/"]
-
-ppHoogle :: Maybe String -> [Interface] -> FilePath -> IO ()
-ppHoogle maybe_package ifaces odir =
-    do
-        let
-            filename = case maybe_package of
-                        Just x -> x ++ ".txt"
-                        Nothing -> "hoogle.txt"
-
-            visible_ifaces = filter visible ifaces
-            visible i = OptHide `notElem` iface_options i
-
-            contents = prefix : map ppModule visible_ifaces
-
-        writeFile (pathJoin [odir, filename]) (unlines $ concat contents)
- 
-
-
--- ---------------------------------------------------------------------------
--- Generate the HTML page for a module
-
-
-ppDecl :: HsDecl -> [String]
-ppDecl (HsNewTypeDecl src context name args ctor unknown docs) =
-    ppData "newtype" context name args [ctor]
-
-ppDecl (HsDataDecl src context name args ctors unknown docs) =
-    ppData "data" context name args ctors
-
-ppDecl (HsTypeSig src names t doc) = map (`ppFunc` t) names
-
-ppDecl (HsForeignImport src _ _ _ name t doc) = ppDecl $ HsTypeSig src [name] t doc
-
-ppDecl (HsClassDecl src context name args fundeps members doc) =
-    ("class " ++ ppContext context ++ ppType typ) : concatMap f members
-    where
-        typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args)
-        newcontext = (UnQual name, map HsTyVar args)
-        f (HsTypeSig src names t doc) = ppDecl (HsTypeSig src names (addContext newcontext t) doc)
-        f (HsFunBind{}) = []
-        f (HsPatBind{}) = []
-        f x = ["-- ERR " ++ show x]
-
-ppDecl (HsTypeDecl src name args t doc) =
-    ["type " ++ show name ++ concatMap (\x -> ' ':show x) args ++ " = " ++ ppType t]
-
-ppDecl x = ["-- ERR " ++ show x]
-
-
-
-addContext :: HsAsst -> HsType -> HsType
-addContext ctx (HsForAllType Nothing context t) = HsForAllType Nothing (HsAssump ctx : context) t
-addContext ctx x = HsForAllType Nothing [HsAssump ctx] x
-
-
-
-ppFunc :: HsName -> HsType -> String
-ppFunc name typ = show name ++ " :: " ++ ppType typ
-
-
-ppData :: String -> HsContext -> HsName -> [HsName] -> [HsConDecl] -> [String]
-ppData mode context name args ctors = (mode ++ " " ++ ppType typ) : concatMap (ppCtor typ) ctors
-    where
-        typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args)
-        
-        
-deBang :: HsBangType -> HsType
-deBang (HsBangedTy   x) = x
-deBang (HsUnBangedTy x) = x
-
-
-ppCtor :: HsType -> HsConDecl -> [String]
-ppCtor result (HsConDecl src name types context typ doc) =
-    [show name ++ " :: " ++ ppContext context ++ ppTypesArr (map deBang typ ++ [result])]
-
-ppCtor result (HsRecDecl src name types context fields doc) =
-        ppCtor result (HsConDecl src name types context (map snd fields2) doc) ++
-        concatMap f fields2
-    where
-        fields2 = [(name, typ) | HsFieldDecl names typ _ <- fields, name <- names]
-        f (name, typ) = ppDecl $ HsTypeSig src [name] (HsTyFun result (deBang typ)) doc
-
-
-brack True  x = "(" ++ x ++ ")"
-brack False x = x
-
-ppContext :: HsContext -> String
-ppContext [] = ""
-ppContext xs = brack (length xs > 1) (concat $ intersperse ", " $ map ppContextItem xs) ++ " => "
-
-ppContextItem :: HsAsst -> String
-ppContextItem (name, types) = ppQName name ++ concatMap (\x -> ' ':ppType x) types
-
-ppContext2 :: HsIPContext -> String
-ppContext2 xs = ppContext [x | HsAssump x <- xs]
-
-
-ppType :: HsType -> String
-ppType x = f 0 x
-    where
-        f _ (HsTyTuple _ xs) = brack True $ concat $ intersperse ", " $ map (f 0) xs
-        f _ (HsTyCon x) = ppQName x
-        f _ (HsTyVar x) = show x
-
-        -- ignore ForAll types as Hoogle does not support them
-        f n (HsForAllType (Just items) context t) =
-            -- brack (n > 1) $
-            -- "forall" ++ concatMap (\x -> ' ':toStr x) items ++ " . " ++ f 0 t
-            f n t
-
-        f n (HsForAllType Nothing context t) = brack (n > 1) $
-            ppContext2 context ++ f 0 t
-
-        f n (HsTyFun a b) = brack g $ f (h 3) a ++ " -> " ++ f (h 2) b
-            where
-                g = n > 2
-                h x = if g then 0 else x
-        
-        f n (HsTyApp a b) | ppType a == "[]" = "[" ++ f 0 b ++ "]"
-        
-        f n (HsTyApp a b) = brack g $ f (h 3) a ++ " " ++ f (h 4) b
-            where
-                g = n > 3
-                h x = if g then 0 else x
-        
-        f n (HsTyDoc x _) = f n x
-
-        f n x = brack True $ show x
-
-
-ppQName :: HsQName -> String
-ppQName (Qual _ name) = show name
-ppQName (UnQual name) = show name
-
-
-
-ppTypesArr :: [HsType] -> String
-ppTypesArr xs = ppType $ foldr1 HsTyFun xs
-
-
-
-ppInst :: InstHead -> String
-ppInst (context, item) = "instance " ++ ppContext context ++ ppContextItem item
-
-
-
-ppModule :: Interface -> [String]
-ppModule iface = "" : ("module " ++ mdl) : concatMap ppExport (iface_exports iface)
-    where
-        Module mdl = iface_module iface
-
-
-ppExport :: ExportItem -> [String]
-ppExport (ExportDecl name decl insts) = ppDecl decl ++ map ppInst insts
-ppExport _ = []
-
-
--}
diff --git a/src/Haddock/Html.hs b/src/Haddock/Html.hs
deleted file mode 100644
index 74aa4e34..00000000
--- a/src/Haddock/Html.hs
+++ /dev/null
@@ -1,1508 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.Html ( 
-	ppHtml, copyHtmlBits, 
-	ppHtmlIndex, ppHtmlContents,
-	ppHtmlHelpFiles
-  ) where
-
-import Prelude hiding (div)
-
-import Haddock.DevHelp
-import Haddock.HH
-import Haddock.HH2
-import Haddock.ModuleTree
-import Haddock.Types
-import Haddock.Version
-import Haddock.Utils
-import Haddock.Utils.GHC
-import Haddock.Utils.Html
-import qualified Haddock.Utils.Html as Html
-
-import Control.Exception     ( bracket )
-import Control.Monad         ( when, unless )
-import Data.Char             ( isUpper, toUpper )
-import Data.List             ( sortBy )
-import Data.Maybe            ( fromJust, isJust, mapMaybe, fromMaybe )
-import Foreign.Marshal.Alloc ( allocaBytes )
-import System.IO             ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
-import Data.Map              ( Map )
-import qualified Data.Map as Map hiding ( Map )
-
-import GHC hiding ( NoLink )
-import Name
-import Module
-import PackageConfig         ( stringToPackageId )
-import RdrName hiding ( Qual )
-import SrcLoc   
-import FastString            ( unpackFS )
-import BasicTypes            ( IPName(..), Boxity(..) )
-import Type                  ( Kind )
-import Outputable            ( ppr, defaultUserStyle, showSDoc )
-
--- the base, module and entity URLs for the source code and wiki links.
-type SourceURLs = (Maybe String, Maybe String, Maybe String)
-type WikiURLs = (Maybe String, Maybe String, Maybe String)
-
--- -----------------------------------------------------------------------------
--- Generating HTML documentation
-
-ppHtml	:: String
-	-> Maybe String				-- package
-	-> [HaddockModule]
-	-> FilePath			-- destination directory
-	-> Maybe (GHC.HsDoc GHC.RdrName)    -- prologue text, maybe
-	-> Maybe String		        -- the Html Help format (--html-help)
-	-> SourceURLs			-- the source URL (--source)
-	-> WikiURLs			-- the wiki URL (--wiki)
-	-> Maybe String			-- the contents URL (--use-contents)
-	-> Maybe String			-- the index URL (--use-index)
-	-> IO ()
-
-ppHtml doctitle maybe_package hmods odir prologue maybe_html_help_format
-	maybe_source_url maybe_wiki_url
-	maybe_contents_url maybe_index_url =  do
-  let
-	visible_hmods = filter visible hmods
-	visible i = OptHide `notElem` hmod_options i
-
-  when (not (isJust maybe_contents_url)) $ 
-    ppHtmlContents odir doctitle maybe_package
-        maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url
-	visible_hmods
-	False -- we don't want to display the packages in a single-package contents
-	prologue
-
-  when (not (isJust maybe_index_url)) $ 
-    ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
-      maybe_contents_url maybe_source_url maybe_wiki_url visible_hmods
-    
-  when (not (isJust maybe_contents_url && isJust maybe_index_url)) $ 
-	ppHtmlHelpFiles doctitle maybe_package hmods odir maybe_html_help_format []
-
-  mapM_ (ppHtmlModule odir doctitle
-	   maybe_source_url maybe_wiki_url
-	   maybe_contents_url maybe_index_url) visible_hmods
-
-ppHtmlHelpFiles	
-    :: String                   -- doctitle
-    -> Maybe String				-- package
-	-> [HaddockModule]
-	-> FilePath                 -- destination directory
-	-> Maybe String             -- the Html Help format (--html-help)
-	-> [FilePath]               -- external packages paths
-	-> IO ()
-ppHtmlHelpFiles doctitle maybe_package hmods odir maybe_html_help_format pkg_paths =  do
-  let
-	visible_hmods = filter visible hmods
-	visible i = OptHide `notElem` hmod_options i
-
-  -- Generate index and contents page for Html Help if requested
-  case maybe_html_help_format of
-    Nothing        -> return ()
-    Just "mshelp"  -> ppHHProject odir doctitle maybe_package visible_hmods pkg_paths
-    Just "mshelp2" -> do
-		ppHH2Files      odir maybe_package visible_hmods pkg_paths
-		ppHH2Collection odir doctitle maybe_package
-    Just "devhelp" -> ppDevHelpFile odir doctitle maybe_package visible_hmods
-    Just format    -> fail ("The "++format++" format is not implemented")
-
-copyFile :: FilePath -> FilePath -> IO ()
-copyFile fromFPath toFPath =
-	(bracket (openFile fromFPath ReadMode) hClose $ \hFrom ->
-	 bracket (openFile toFPath WriteMode) hClose $ \hTo ->
-	 allocaBytes bufferSize $ \buffer ->
-		copyContents hFrom hTo buffer)
-	where
-		bufferSize = 1024
-		
-		copyContents hFrom hTo buffer = do
-			count <- hGetBuf hFrom buffer bufferSize
-			when (count > 0) $ do
-				hPutBuf hTo buffer count
-				copyContents hFrom hTo buffer
-
-
-copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO ()
-copyHtmlBits odir libdir maybe_css = do
-  let 
-	libhtmldir = pathJoin [libdir, "html"]
-	css_file = case maybe_css of
-			Nothing -> pathJoin [libhtmldir, cssFile]
-			Just f  -> f
-	css_destination = pathJoin [odir, cssFile]
-	copyLibFile f = do
-	   copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
-  copyFile css_file css_destination
-  mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ]
-
-footer :: HtmlTable
-footer = 
-  tda [theclass "botbar"] << 
-	( toHtml "Produced by" <+> 
-	  (anchor ! [href projectUrl] << toHtml projectName) <+>
-	  toHtml ("version " ++ projectVersion)
-	)
-   
-srcButton :: SourceURLs -> Maybe HaddockModule -> HtmlTable
-srcButton (Just src_base_url, _, _) Nothing =
-  topButBox (anchor ! [href src_base_url] << toHtml "Source code")
-
-srcButton (_, Just src_module_url, _) (Just hmod) =
-  let url = spliceURL (Just $ hmod_orig_filename hmod)
-                      (Just $ hmod_mod hmod) Nothing src_module_url
-   in topButBox (anchor ! [href url] << toHtml "Source code")
-
-srcButton _ _ =
-  Html.emptyTable
- 
-spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> String -> String
-spliceURL maybe_file maybe_mod maybe_name url = run url
- where
-  file = fromMaybe "" maybe_file
-  mod = case maybe_mod of
-          Nothing           -> ""
-          Just mod -> moduleString mod 
-  
-  (name, kind) =
-    case maybe_name of
-      Nothing             -> ("","")
-      Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v")
-             | otherwise -> (escapeStr (getOccString n), "t")
-
-  run "" = ""
-  run ('%':'M':rest) = mod ++ run rest
-  run ('%':'F':rest) = file ++ run rest
-  run ('%':'N':rest) = name ++ run rest
-  run ('%':'K':rest) = kind ++ run rest
-
-  run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest
-  run ('%':'{':'F':'I':'L':'E':'}':rest)         = file ++ run rest
-  run ('%':'{':'N':'A':'M':'E':'}':rest)         = name ++ run rest
-  run ('%':'{':'K':'I':'N':'D':'}':rest)         = kind ++ run rest
-
-  run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) =
-    map (\x -> if x == '.' then c else x) mod ++ run rest
-
-  run (c:rest) = c : run rest
-  
-wikiButton :: WikiURLs -> Maybe Module -> HtmlTable
-wikiButton (Just wiki_base_url, _, _) Nothing =
-  topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments")
-
-wikiButton (_, Just wiki_module_url, _) (Just mod) =
-  let url = spliceURL Nothing (Just mod) Nothing wiki_module_url
-   in topButBox (anchor ! [href url] << toHtml "User Comments")
-
-wikiButton _ _ =
-  Html.emptyTable
-
-contentsButton :: Maybe String -> HtmlTable
-contentsButton maybe_contents_url 
-  = topButBox (anchor ! [href url] << toHtml "Contents")
-  where url = case maybe_contents_url of
-			Nothing -> contentsHtmlFile
-			Just url -> url
-
-indexButton :: Maybe String -> HtmlTable
-indexButton maybe_index_url 
-  = topButBox (anchor ! [href url] << toHtml "Index")
-  where url = case maybe_index_url of
-			Nothing -> indexHtmlFile
-			Just url -> url
-
-simpleHeader :: String -> Maybe String -> Maybe String
-             -> SourceURLs -> WikiURLs -> HtmlTable
-simpleHeader doctitle maybe_contents_url maybe_index_url
-  maybe_source_url maybe_wiki_url = 
-  (tda [theclass "topbar"] << 
-     vanillaTable << (
-       (td << 
-  	image ! [src "haskell_icon.gif", width "16", height 16, alt " " ]
-       ) <->
-       (tda [theclass "title"] << toHtml doctitle) <->
-	srcButton maybe_source_url Nothing <->
-        wikiButton maybe_wiki_url Nothing <->
-	contentsButton maybe_contents_url <-> indexButton maybe_index_url
-   ))
-
-pageHeader :: String -> HaddockModule -> String
-    -> SourceURLs -> WikiURLs
-    -> Maybe String -> Maybe String -> HtmlTable
-pageHeader mdl hmod doctitle
-           maybe_source_url maybe_wiki_url
-           maybe_contents_url maybe_index_url =
-  (tda [theclass "topbar"] << 
-    vanillaTable << (
-       (td << 
-  	image ! [src "haskell_icon.gif", width "16", height 16, alt " "]
-       ) <->
-       (tda [theclass "title"] << toHtml doctitle) <->
-	srcButton maybe_source_url (Just hmod) <->
-	wikiButton maybe_wiki_url (Just $ hmod_mod hmod) <->
-	contentsButton maybe_contents_url <->
-	indexButton maybe_index_url
-    )
-   ) </>
-   tda [theclass "modulebar"] <<
-	(vanillaTable << (
-	  (td << font ! [size "6"] << toHtml mdl) <->
-	  moduleInfo hmod
-	)
-    )
-
-moduleInfo :: HaddockModule -> HtmlTable
-moduleInfo hmod = 
-   let
-      info = hmod_info hmod
-
-      doOneEntry :: (String, (GHC.HaddockModInfo GHC.Name) -> Maybe String) -> Maybe HtmlTable
-      doOneEntry (fieldName,field) = case field info of
-         Nothing -> Nothing
-         Just fieldValue -> 
-            Just ((tda [theclass "infohead"] << toHtml fieldName)
-               <-> (tda [theclass "infoval"]) << toHtml fieldValue)
-     
-      entries :: [HtmlTable]
-      entries = mapMaybe doOneEntry [
-         ("Portability",GHC.hmi_portability),
-         ("Stability",GHC.hmi_stability),
-         ("Maintainer",GHC.hmi_maintainer)
-         ]
-   in
-      case entries of
-         [] -> Html.emptyTable
-         _ -> tda [align "right"] << narrowTable << (foldl1 (</>) entries)
-
--- ---------------------------------------------------------------------------
--- Generate the module contents
-
-ppHtmlContents
-   :: FilePath
-   -> String
-   -> Maybe String
-   -> Maybe String
-   -> Maybe String
-   -> SourceURLs
-   -> WikiURLs
-   -> [HaddockModule] -> Bool -> Maybe (GHC.HsDoc GHC.RdrName)
-   -> IO ()
-ppHtmlContents odir doctitle
-  maybe_package maybe_html_help_format maybe_index_url
-  maybe_source_url maybe_wiki_url modules showPkgs prologue = do
-  let tree = mkModuleTree showPkgs
-         [(hmod_mod mod, toDescription mod) | mod <- modules]
-      html = 
-	header 
-		(documentCharacterEncoding +++
-		 thetitle (toHtml doctitle) +++
-		 styleSheet +++
-		 (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
-        body << vanillaTable << (
-   	    simpleHeader doctitle Nothing maybe_index_url
-                         maybe_source_url maybe_wiki_url </>
-	    ppPrologue doctitle prologue </>
-	    ppModuleTree doctitle tree </>
-	    s15 </>
-	    footer
-	  )
-  writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html)
-  
-  -- Generate contents page for Html Help if requested
-  case maybe_html_help_format of
-    Nothing        -> return ()
-    Just "mshelp"  -> ppHHContents  odir doctitle maybe_package tree
-    Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree
-    Just "devhelp" -> return ()
-    Just format    -> fail ("The "++format++" format is not implemented")
-
-ppPrologue :: String -> Maybe (GHC.HsDoc GHC.RdrName) -> HtmlTable
-ppPrologue title Nothing = Html.emptyTable
-ppPrologue title (Just doc) = 
-  (tda [theclass "section1"] << toHtml title) </>
-  docBox (rdrDocToHtml doc)
-
-ppModuleTree :: String -> [ModuleTree] -> HtmlTable
-ppModuleTree _ ts = 
-  tda [theclass "section1"] << toHtml "Modules" </>
-  td << vanillaTable2 << htmlTable
-  where
-    genTable htmlTable id []     = (htmlTable,id)
-    genTable htmlTable id (x:xs) = genTable (htmlTable </> u) id' xs      
-      where
-        (u,id') = mkNode [] x 0 id
-
-    (htmlTable,_) = genTable emptyTable 0 ts
-
-mkNode :: [String] -> ModuleTree -> Int -> Int -> (HtmlTable,Int)
-mkNode ss (Node s leaf pkg short ts) depth id = htmlNode
-  where
-    htmlNode = case ts of
-      [] -> (td_pad_w 1.25 depth << htmlModule  <-> shortDescr <-> htmlPkg,id)
-      _  -> (td_w depth << (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg </> 
-                (td_subtree << sub_tree), id')
-
-    mod_width = 50::Int {-em-}
-
-    td_pad_w pad depth = 
-	tda [thestyle ("padding-left: " ++ show pad ++ "em;" ++
-		       "width: " ++ show (mod_width - depth*2) ++ "em")]
-
-    td_w depth = 
-	tda [thestyle ("width: " ++ show (mod_width - depth*2) ++ "em")]
-
-    td_subtree =
-	tda [thestyle ("padding: 0; padding-left: 2em")]
-
-    shortDescr :: HtmlTable
-    shortDescr = case short of
-	Nothing -> td empty
-	Just doc -> tda [theclass "rdoc"] (origDocToHtml doc)
-
-    htmlModule 
-      | leaf      = ppModule (mkModule (stringToPackageId pkgName) 
-                                       (mkModuleName mdl)) ""
-      | otherwise = toHtml s
-
-    -- ehm.. TODO: change the ModuleTree type
-    (htmlPkg, pkgName) = case pkg of
-      Nothing -> (td << empty, "")
-      Just p  -> (td << toHtml p, p)
-
-    mdl = foldr (++) "" (s' : map ('.':) ss')
-    (s':ss') = reverse (s:ss)
-	 -- reconstruct the module name
-    
-    id_s = "n:" ++ show id
-    
-    (sub_tree,id') = genSubTree emptyTable (id+1) ts
-    
-    genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int)
-    genSubTree htmlTable id [] = (sub_tree,id)
-      where
-        sub_tree = collapsed vanillaTable2 id_s htmlTable
-    genSubTree htmlTable id (x:xs) = genSubTree (htmlTable </> u) id' xs      
-      where
-        (u,id') = mkNode (s:ss) x (depth+1) id
-
--- The URL for source and wiki links, and the current module
-type LinksInfo = (SourceURLs, WikiURLs, HaddockModule)
-
-
--- ---------------------------------------------------------------------------
--- Generate the index
-
-ppHtmlIndex :: FilePath
-            -> String 
-            -> Maybe String
-            -> Maybe String
-            -> Maybe String
-            -> SourceURLs
-            -> WikiURLs
-            -> [HaddockModule] 
-            -> IO ()
-ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
-  maybe_contents_url maybe_source_url maybe_wiki_url modules = do
-  let html = 
-	header (documentCharacterEncoding +++
-		thetitle (toHtml (doctitle ++ " (Index)")) +++
-		styleSheet) +++
-        body << vanillaTable << (
-	    simpleHeader doctitle maybe_contents_url Nothing
-                         maybe_source_url maybe_wiki_url </>
-	    index_html
-	   )
-
-  when split_indices $
-    mapM_ (do_sub_index index) initialChars
-
-  writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html)
-  
-    -- Generate index and contents page for Html Help if requested
-  case maybe_html_help_format of
-    Nothing        -> return ()
-    Just "mshelp"  -> ppHHIndex  odir maybe_package modules
-    Just "mshelp2" -> ppHH2Index odir maybe_package modules
-    Just "devhelp" -> return ()
-    Just format    -> fail ("The "++format++" format is not implemented")
- where
-  split_indices = length index > 50
-
-  index_html
-    | split_indices = 
-	tda [theclass "section1"] << 
-	      	toHtml ("Index") </>
-	indexInitialLetterLinks
-   | otherwise =
-	td << table ! [cellpadding 0, cellspacing 5] <<
-	  aboves (map indexElt index) 
- 	
-  indexInitialLetterLinks = 
-	td << table ! [cellpadding 0, cellspacing 5] <<
-	    besides [ td << anchor ! [href (subIndexHtmlFile c)] <<
-			 toHtml [c]
-		    | c <- initialChars
-                    , any ((==c) . toUpper . head . fst) index ]
-
-  do_sub_index this_ix c
-    = unless (null index_part) $
-        writeFile (pathJoin [odir, subIndexHtmlFile c]) (renderHtml html)
-    where 
-      html = header (documentCharacterEncoding +++
-		thetitle (toHtml (doctitle ++ " (Index)")) +++
-		styleSheet) +++
-             body << vanillaTable << (
-	        simpleHeader doctitle maybe_contents_url Nothing
-                             maybe_source_url maybe_wiki_url </>
-		indexInitialLetterLinks </>
-	        tda [theclass "section1"] << 
-	      	toHtml ("Index (" ++ c:")") </>
-	        td << table ! [cellpadding 0, cellspacing 5] <<
-	      	  aboves (map indexElt index_part) 
-	       )
-
-      index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c]
-
-  index :: [(String, Map GHC.Name [(Module,Bool)])]
-  index = sortBy cmp (Map.toAscList full_index)
-    where cmp (n1,_) (n2,_) = n1 `compare` n2
-
-  -- for each name (a plain string), we have a number of original HsNames that
-  -- it can refer to, and for each of those we have a list of modules
-  -- that export that entity.  Each of the modules exports the entity
-  -- in a visible or invisible way (hence the Bool).
-  full_index :: Map String (Map GHC.Name [(Module,Bool)])
-  full_index = Map.fromListWith (flip (Map.unionWith (++)))
-		(concat (map getHModIndex modules))
-
-  getHModIndex hmod = 
-    [ (getOccString name, 
-	Map.fromList [(name, [(mdl, name `elem` hmod_visible_exports hmod)])])
-    | name <- hmod_exports hmod ]
-    where mdl = hmod_mod hmod
-
-  indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable
-  indexElt (str, entities) = 
-     case Map.toAscList entities of
-	[(nm,entries)] ->  
-	    tda [ theclass "indexentry" ] << toHtml str <-> 
-			indexLinks nm entries
-	many_entities ->
-	    tda [ theclass "indexentry" ] << toHtml str </> 
-		aboves (map doAnnotatedEntity (zip [1..] many_entities))
-
-  doAnnotatedEntity (j,(nm,entries))
-	= tda [ theclass "indexannot" ] << 
-		toHtml (show j) <+> parens (ppAnnot (nameOccName nm)) <->
-		 indexLinks nm entries
-
-  ppAnnot n | not (isValOcc n) = toHtml "Type/Class"
-            | isDataOcc n      = toHtml "Data Constructor"
-            | otherwise        = toHtml "Function"
-
-  indexLinks nm entries = 
-     tda [ theclass "indexlinks" ] << 
-	hsep (punctuate comma 
-	[ if visible then
-	     linkId mod (Just nm) << toHtml (moduleString mod)
-	  else
-	     toHtml (moduleString mod)
-	| (mod, visible) <- entries ])
-
-  initialChars = [ 'A'..'Z' ] ++ ":!#$%&*+./<=>?@\\^|-~"
-
--- ---------------------------------------------------------------------------
--- Generate the HTML page for a module
-
-ppHtmlModule
-	:: FilePath -> String
-	-> SourceURLs -> WikiURLs
-	-> Maybe String -> Maybe String
-	-> HaddockModule -> IO ()
-ppHtmlModule odir doctitle
-  maybe_source_url maybe_wiki_url
-  maybe_contents_url maybe_index_url hmod = do
-  let 
-      mod = hmod_mod hmod
-      mdl = moduleString mod
-      html = 
-	header (documentCharacterEncoding +++
-		thetitle (toHtml mdl) +++
-		styleSheet +++
-		(script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
-        body << vanillaTable << (
-	    pageHeader mdl hmod doctitle
-		maybe_source_url maybe_wiki_url
-		maybe_contents_url maybe_index_url </> s15 </>
-	    hmodToHtml maybe_source_url maybe_wiki_url hmod </> s15 </>
-	    footer
-         )
-  writeFile (pathJoin [odir, moduleHtmlFile mod]) (renderHtml html)
-
-hmodToHtml :: SourceURLs -> WikiURLs -> HaddockModule -> HtmlTable
-hmodToHtml maybe_source_url maybe_wiki_url hmod
-  = abovesSep s15 (contents: description: synopsis: maybe_doc_hdr: bdy)
-  where
-        docMap = hmod_rn_doc_map hmod
- 
-	exports = numberSectionHeadings (hmod_rn_export_items hmod)
-
-	has_doc (ExportDecl _ _ doc _) = isJust doc
-	has_doc (ExportNoDecl _ _ _) = False
-	has_doc (ExportModule _) = False
-	has_doc _ = True
-
-	no_doc_at_all = not (any has_doc exports)
-
- 	contents = td << vanillaTable << ppModuleContents exports
-
-	description
-          = case hmod_rn_doc hmod of
-              Nothing -> Html.emptyTable
-              Just doc -> (tda [theclass "section1"] << toHtml "Description") </>
-                          docBox (docToHtml doc)
-
-	-- omit the synopsis if there are no documentation annotations at all
-	synopsis
-	  | no_doc_at_all = Html.emptyTable
-	  | otherwise
-	  = (tda [theclass "section1"] << toHtml "Synopsis") </>
-	    s15 </>
-            (tda [theclass "body"] << vanillaTable <<
-  	        abovesSep s8 (map (processExport True linksInfo docMap)
-			(filter forSummary exports))
-	    )
-
-	-- if the documentation doesn't begin with a section header, then
-	-- add one ("Documentation").
-	maybe_doc_hdr
-	    = case exports of		   
-		   [] -> Html.emptyTable
-		   ExportGroup _ _ _ : _ -> Html.emptyTable
-		   _ -> tda [ theclass "section1" ] << toHtml "Documentation"
-
-	bdy  = map (processExport False linksInfo docMap) exports
-	linksInfo = (maybe_source_url, maybe_wiki_url, hmod)
-
-ppModuleContents :: [ExportItem DocName] -> HtmlTable
-ppModuleContents exports
-  | length sections == 0 = Html.emptyTable
-  | otherwise            = tda [theclass "section4"] << bold << toHtml "Contents"
-  		           </> td << dlist << concatHtml sections
- where
-  (sections, _leftovers{-should be []-}) = process 0 exports
-
-  process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName])
-  process _ [] = ([], [])
-  process n items@(ExportGroup lev id0 doc : rest) 
-    | lev <= n  = ( [], items )
-    | otherwise = ( html:secs, rest2 )
-    where
-	html = (dterm << linkedAnchor id0 << docToHtml doc)
-		 +++ mk_subsections ssecs
-	(ssecs, rest1) = process lev rest
-	(secs,  rest2) = process n   rest1
-  process n (_ : rest) = process n rest
-
-  mk_subsections [] = noHtml
-  mk_subsections ss = ddef << dlist << concatHtml ss
-
--- we need to assign a unique id to each section heading so we can hyperlink
--- them from the contents:
-numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName]
-numberSectionHeadings exports = go 1 exports
-  where go :: Int -> [ExportItem DocName] -> [ExportItem DocName]
-        go _ [] = []
-	go n (ExportGroup lev _ doc : es) 
-	  = ExportGroup lev (show n) doc : go (n+1) es
-	go n (other:es)
-	  = other : go n es
-
-processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable
-processExport _ _ _ (ExportGroup lev id0 doc)
-  = ppDocGroup lev (namedAnchor id0 << docToHtml doc)
-processExport summary links docMap (ExportDecl x decl doc insts)
-  = doDecl summary links x decl doc insts docMap
-processExport summmary _ _ (ExportNoDecl _ y [])
-  = declBox (ppDocName y)
-processExport summmary _ _ (ExportNoDecl _ y subs)
-  = declBox (ppDocName y <+> parenList (map ppDocName subs))
-processExport _ _ _ (ExportDoc doc)
-  = docBox (docToHtml doc)
-processExport _ _ _ (ExportModule mod)
-  = declBox (toHtml "module" <+> ppModule mod "")
-
-forSummary :: (ExportItem DocName) -> Bool
-forSummary (ExportGroup _ _ _) = False
-forSummary (ExportDoc _)       = False
-forSummary _                    = True
-
-ppDocGroup :: Int -> Html -> HtmlTable
-ppDocGroup lev doc
-  | lev == 1  = tda [ theclass "section1" ] << doc
-  | lev == 2  = tda [ theclass "section2" ] << doc
-  | lev == 3  = tda [ theclass "section3" ] << doc
-  | otherwise = tda [ theclass "section4" ] << doc
-
-declWithDoc :: Bool -> LinksInfo -> SrcSpan -> Name -> Maybe (HsDoc DocName) -> Html -> HtmlTable
-declWithDoc True  _     _   _  _          html_decl = declBox html_decl
-declWithDoc False links loc nm Nothing    html_decl = topDeclBox links loc nm html_decl
-declWithDoc False links loc nm (Just doc) html_decl = 
-		topDeclBox links loc nm html_decl </> docBox (docToHtml doc)
-
-doDecl :: Bool -> LinksInfo -> Name -> LHsDecl DocName -> 
-          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable
-doDecl summary links x (L loc d) mbDoc instances docMap = doDecl d
-  where
-    doDecl (TyClD d) = doTyClD d 
-    doDecl (SigD s) = ppSig summary links loc mbDoc s
-    doDecl (ForD d) = ppFor summary links loc mbDoc d
-
-    doTyClD d0@(TyData {}) = ppDataDecl summary links instances x loc mbDoc d0
-    doTyClD d0@(TySynonym {}) = ppTySyn summary links loc mbDoc d0
-    doTyClD d0@(ClassDecl {}) = ppClassDecl summary links instances x loc mbDoc docMap d0
-
-ppSig :: Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) -> Sig DocName -> HtmlTable
-ppSig summary links loc mbDoc (TypeSig lname ltype) 
-  | summary || noArgDocs t = 
-    declWithDoc summary links loc n mbDoc (ppTypeSig summary n t)
-  | otherwise = topDeclBox links loc n (ppBinder False n) </>
-    (tda [theclass "body"] << vanillaTable <<  (
-      do_args dcolon t </>
-        (case mbDoc of 
-          Just doc -> ndocBox (docToHtml doc)
-          Nothing -> Html.emptyTable)
-	))
-
-  where 
-  t = unLoc ltype
-  NoLink n = unLoc lname
-
-  noLArgDocs (L _ t) = noArgDocs t
-  noArgDocs (HsForAllTy _ _ _ t) = noLArgDocs t
-  noArgDocs (HsFunTy (L _ (HsDocTy _ _)) _) = False 
-  noArgDocs (HsFunTy _ r) = noLArgDocs r
-  noArgDocs (HsDocTy _ _) = False
-  noArgDocs _ = True
-
-  do_largs leader (L _ t) = do_args leader t  
-  do_args :: Html -> (HsType DocName) -> HtmlTable
-  do_args leader (HsForAllTy Explicit tvs lctxt ltype)
-    = (argBox (
-        leader <+> 
-        hsep (keyword "forall" : ppTyVars tvs ++ [dot]) <+>
-        ppLContextNoArrow lctxt)
-          <-> rdocBox noHtml) </> 
-          do_largs darrow ltype
-  do_args leader (HsForAllTy Implicit _ lctxt ltype)
-    = (argBox (leader <+> ppLContextNoArrow lctxt)
-        <-> rdocBox noHtml) </> 
-        do_largs darrow ltype
-  do_args leader (HsFunTy (L _ (HsDocTy lt ldoc)) r)
-    = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc)))
-        </> do_largs arrow r
-  do_args leader (HsFunTy lt r)
-    = (argBox (leader <+> ppLType lt) <-> rdocBox noHtml) </> do_largs arrow r
-  do_args leader (HsDocTy lt ldoc)
-    = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc)))
-  do_args leader t
-    = argBox (leader <+> ppType t) <-> rdocBox (noHtml)
-
-ppTyVars tvs = map ppName (tyvarNames tvs)
-
-tyvarNames = map f 
-  where f x = let NoLink n = hsTyVarName (unLoc x) in n
-  
-ppFor summary links loc mbDoc (ForeignImport lname ltype _)
-  = ppSig summary links loc mbDoc (TypeSig lname ltype)
-ppFor _ _ _ _ _ = error "ppFor"
-
--- we skip type patterns for now
-ppTySyn summary links loc mbDoc (TySynonym lname ltyvars _ ltype) 
-  = declWithDoc summary links loc n mbDoc (
-    hsep ([keyword "type", ppBinder summary n]
-    ++ ppTyVars ltyvars) <+> equals <+> ppLType ltype)
-  where NoLink n = unLoc lname
-
-ppLType (L _ t) = ppType t
-
-ppTypeSig :: Bool -> Name -> (HsType DocName) -> Html
-ppTypeSig summary nm ty = ppBinder summary nm <+> dcolon <+> ppType ty
-
---------------------------------------------------------------------------------
--- Contexts 
---------------------------------------------------------------------------------
-
-ppLContext        = ppContext        . unLoc
-ppLContextNoArrow = ppContextNoArrow . unLoc
-
-ppContextNoArrow :: HsContext DocName -> Html
-ppContextNoArrow []  = empty
-ppContextNoArrow cxt = pp_hs_context (map unLoc cxt) 
-
-ppContextNoLocs :: [HsPred DocName] -> Html
-ppContextNoLocs []  = empty
-ppContextNoLocs cxt = pp_hs_context cxt <+> darrow  
-
-ppContext :: HsContext DocName -> Html
-ppContext cxt = ppContextNoLocs (map unLoc cxt)
-
-pp_hs_context []  = empty
-pp_hs_context [p] = ppPred p
-pp_hs_context cxt = parenList (map ppPred cxt) 
-
-ppLPred = ppPred . unLoc
-
-ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts)
--- TODO: find out what happened to the Dupable/Linear distinction
-ppPred (HsIParam (IPName n) t) 
-  = toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t
-
--- -----------------------------------------------------------------------------
--- Class declarations
-
-ppClassHdr summ (L _ []) n tvs fds = 
-  keyword "class"
-	<+> ppBinder summ n <+> hsep (ppTyVars tvs)
-	<+> ppFds fds
-ppClassHdr summ lctxt n tvs fds = 
-  keyword "class" <+> ppLContext lctxt
-	<+> ppBinder summ n <+> hsep (ppTyVars tvs)
-	<+> ppFds fds
-
-ppFds fds =
-  if null fds then noHtml else 
-	char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
-  where
-	fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
-			       hsep (map ppDocName vars2)
-
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap = 
-  if null sigs && null ats
-    then (if summary then declBox else topDeclBox links loc nm) hdr
-    else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
-	    </> 
-           (tda [theclass "body"] << 
-	     vanillaTable << 
-         aboves ([ ppAT summary at | L _ at <- ats ] ++
-	        [ ppSig summary links loc mbDoc sig  
-		      | L _ sig@(TypeSig (L _ (NoLink n)) ty) <- sigs, let mbDoc = Map.lookup n docMap ])
-          )
-  where
-    hdr = ppClassHdr summary lctxt nm tvs fds
-    NoLink nm = unLoc lname
-    
-    ppAT summary at = case at of
-      TyData {} -> topDeclBox links loc nm (ppDataHeader summary at)
-      _ -> error "associated type synonyms or type families not supported yet"
-
--- we skip ATs for now
-ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan ->
-                          Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> 
-                          HtmlTable
-ppClassDecl summary links instances orig_c loc mbDoc docMap
-	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ _ _)
-  | summary = ppShortClassDecl summary links decl loc docMap
-  | otherwise
-    = classheader </>
-      tda [theclass "body"] << vanillaTable << (
-        classdoc </> methodsBit </> instancesBit
-      )
-  where 
-    classheader
-      | null lsigs = topDeclBox links loc nm hdr
-      | otherwise  = topDeclBox links loc nm (hdr <+> keyword "where")
-
-    NoLink nm = unLoc lname
-    ctxt = unLoc lctxt
-
-    hdr = ppClassHdr summary lctxt nm ltyvars lfds
-    
-    classdoc = case mbDoc of
-      Nothing -> Html.emptyTable
-      Just d -> ndocBox (docToHtml d)
-
-    methodsBit
-      | null lsigs = Html.emptyTable
-      | otherwise  = 
-        s8 </> methHdr </>
-        tda [theclass "body"] << vanillaTable << (
-          abovesSep s8 [ ppSig summary links loc mbDoc sig
-                         | L _ sig@(TypeSig n _) <- lsigs, 
-                         let mbDoc = Map.lookup (orig n) docMap ]
-        )
-
-    instId = collapseId nm
-    instancesBit
-      | null instances = Html.emptyTable
-      | otherwise 
-        =  s8 </> instHdr instId </>
-           tda [theclass "body"] << 
-             collapsed thediv instId (
-             spacedTable1 << (
-               aboves (map (declBox . ppInstHead) instances)
-             ))
-
-ppInstHead :: InstHead DocName -> Html
-ppInstHead ([],   n, ts) = ppAsst n ts 
-ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAsst n ts 
-
-ppAsst n ts = ppDocName n <+> hsep (map ppParendType ts)
-
--- -----------------------------------------------------------------------------
--- Data & newtype declarations
-
-orig (L _ (NoLink name)) = name
-orig _ = error "orig"
-
--- TODO: print contexts
-ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> 
-                   Maybe (HsDoc DocName) -> TyClDecl DocName -> Html
-ppShortDataDecl summary links loc mbDoc dataDecl 
-
-  | [lcon] <- cons, ResTyH98 <- resTy = 
-    ppDataHeader summary dataDecl 
-    <+> equals <+> ppShortConstr summary (unLoc lcon)
-
-  | [] <- cons = ppDataHeader summary dataDecl
-
-  | otherwise = vanillaTable << (
-      case resTy of 
-        ResTyH98 -> dataHeader </> 
-          tda [theclass "body"] << vanillaTable << (
-            aboves (zipWith doConstr ('=':repeat '|') cons)
-          )
-        ResTyGADT _ -> dataHeader </> 
-          tda [theclass "body"] << vanillaTable << (
-            aboves (map doGADTConstr cons)
-          )
-    )
-  
-  where
-    dataHeader = 
-      (if summary then declBox else topDeclBox links loc name)
-      ((ppDataHeader summary dataDecl) <+> 
-      case resTy of ResTyGADT _ -> keyword "where"; _ -> empty)
-
-    doConstr c con = declBox (toHtml [c] <+> ppShortConstr summary (unLoc con))
-    doGADTConstr con = declBox (ppShortConstr summary (unLoc con))
-
-    name      = orig (tcdLName dataDecl)
-    context   = unLoc (tcdCtxt dataDecl)
-    newOrData = tcdND dataDecl
-    tyVars    = tyvarNames (tcdTyVars dataDecl)
-    mbKSig    = tcdKindSig dataDecl
-    cons      = tcdCons dataDecl
-    resTy     = (con_res . unLoc . head) cons 
-
-ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> 
-              SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> HtmlTable
-ppDataDecl summary links instances x loc mbDoc dataDecl
-  
-  | summary = declWithDoc summary links loc name mbDoc 
-              (ppShortDataDecl summary links loc mbDoc dataDecl)
-  
-  | otherwise = dataHeader </> 
-    tda [theclass "body"] << vanillaTable << (
-      datadoc </> 
-      constrBit </>
-      instancesBit
-    )
-  
-  where
-    name      = orig (tcdLName dataDecl)
-    context   = unLoc (tcdCtxt dataDecl)
-    newOrData = tcdND dataDecl
-    tyVars    = tyvarNames (tcdTyVars dataDecl)
-    mbKSig    = tcdKindSig dataDecl
-    cons      = tcdCons dataDecl
-    resTy     = (con_res . unLoc . head) cons 
-      
-    dataHeader = 
-      (if summary then declBox else topDeclBox links loc name)
-      ((ppDataHeader summary dataDecl) <+> whereBit)
-
-    whereBit 
-      | null cons = empty 
-      | otherwise = case resTy of 
-        ResTyGADT _ -> keyword "where"
-        _ -> empty                         
-
-    constrTable
-      | any isRecCon cons = spacedTable5
-      | otherwise         = spacedTable1
-
-    datadoc = case mbDoc of
-      Just doc -> ndocBox (docToHtml doc)
-      Nothing -> Html.emptyTable
-
-    constrBit 
-      | null cons = Html.emptyTable
-      | otherwise = constrHdr </> ( 
-          tda [theclass "body"] << constrTable << 
-	  aboves (map ppSideBySideConstr cons)
-        )
-
-    instId = collapseId name
-
-    instancesBit
-      | null instances = Html.emptyTable
-      | otherwise 
-        = instHdr instId </>
-	  tda [theclass "body"] << 
-          collapsed thediv instId (
-            spacedTable1 << (
-              aboves (map (declBox . ppInstHead) instances)
-            )
-          )
-
-isRecCon lcon = case con_details (unLoc lcon) of 
-  RecCon _ -> True
-  _ -> False
-
-ppShortConstr :: Bool -> ConDecl DocName -> Html
-ppShortConstr summary con = case con_res con of 
-
-  ResTyH98 -> case con_details con of 
-    PrefixCon args -> header +++ hsep (ppBinder summary name : map ppLType args)
-    RecCon fields -> header +++ ppBinder summary name <+>
-      braces (vanillaTable << aboves (map (ppShortField summary) fields))
-    InfixCon arg1 arg2 -> header +++ 
-      hsep [ppLType arg1, ppBinder summary name, ppLType arg2]    
-
-  ResTyGADT resTy -> case con_details con of 
-    PrefixCon args -> doGADTCon args resTy
-    RecCon _ -> error "GADT records not suported"
-    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy 
-    
-  where
-    doGADTCon args resTy = ppBinder summary name <+> dcolon <+> hsep [
-                             ppForAll forall ltvs lcontext,
-                             ppLType (foldr mkFunTy resTy args) ]
-
-    header   = ppConstrHdr forall tyVars context
-    name     = orig (con_name con)
-    ltvs     = con_qvars con
-    tyVars   = tyvarNames ltvs 
-    lcontext = con_cxt con
-    context  = unLoc (con_cxt con)
-    forall   = con_explicit con
-    mkFunTy a b = noLoc (HsFunTy a b)
-
-ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Html
-ppConstrHdr forall tvs ctxt
- = (if null tvs then noHtml else ppForall)
-   +++
-   (if null ctxt then noHtml else ppContext ctxt <+> toHtml "=> ")
-  where
-    ppForall = case forall of 
-      Explicit -> keyword "forall" <+> hsep (map ppName tvs) <+> toHtml ". "
-      Implicit -> empty
-
-ppSideBySideConstr :: LConDecl DocName -> HtmlTable
-ppSideBySideConstr (L _ con) = case con_res con of 
- 
-  ResTyH98 -> case con_details con of 
-
-    PrefixCon args -> 
-      argBox (hsep ((header +++ ppBinder False name) : map ppLType args)) 
-      <-> maybeRDocBox mbLDoc  
-
-    RecCon fields -> 
-      argBox (header +++ ppBinder False name) <->
-      maybeRDocBox mbLDoc </>
-      (tda [theclass "body"] << spacedTable1 <<
-      aboves (map ppSideBySideField fields))
-
-    InfixCon arg1 arg2 -> 
-      argBox (hsep [header+++ppLType arg1, ppBinder False name, ppLType arg2])
-      <-> maybeRDocBox mbLDoc
- 
-  ResTyGADT resTy -> case con_details con of
-    PrefixCon args -> doGADTCon args resTy
-    RecCon _ -> error "GADT records not supported"
-    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy 
-
- where 
-    doGADTCon args resTy = argBox (ppBinder False name <+> dcolon <+> hsep [
-                               ppForAll forall ltvs (con_cxt con),
-                               ppLType (foldr mkFunTy resTy args) ]
-                            ) <-> maybeRDocBox mbLDoc
-
-
-    header  = ppConstrHdr forall tyVars context
-    name    = orig (con_name con)
-    ltvs    = con_qvars con
-    tyVars  = tyvarNames (con_qvars con)
-    context = unLoc (con_cxt con)
-    forall  = con_explicit con
-    mbLDoc  = con_doc con
-    mkFunTy a b = noLoc (HsFunTy a b)
-
-ppSideBySideField :: ConDeclField DocName -> HtmlTable
-ppSideBySideField (ConDeclField lname ltype mbLDoc) =
-  argBox (ppBinder False (orig lname)
-    <+> dcolon <+> ppLType ltype) <->
-  maybeRDocBox mbLDoc
-
-{-
-ppHsFullConstr :: HsConDecl -> Html
-ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) = 
-     declWithDoc False doc (
-	hsep ((ppHsConstrHdr tvs ctxt +++ 
-		ppHsBinder False nm) : map ppHsBangType typeList)
-      )
-ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) =
-   td << vanillaTable << (
-     case doc of
-       Nothing -> aboves [hdr, fields_html]
-       Just _  -> aboves [hdr, constr_doc, fields_html]
-   )
-
-  where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm)
-
-	constr_doc	
-	  | isJust doc = docBox (docToHtml (fromJust doc))
-	  | otherwise  = Html.emptyTable
-
-	fields_html = 
-	   td << 
-	      table ! [width "100%", cellpadding 0, cellspacing 8] << (
-		   aboves (map ppFullField (concat (map expandField fields)))
-		)
--}
-
-ppShortField :: Bool -> ConDeclField DocName -> HtmlTable
-ppShortField summary (ConDeclField lname ltype _) 
-  = tda [theclass "recfield"] << (
-      ppBinder summary (orig lname)
-      <+> dcolon <+> ppLType ltype
-    )
-
-{-
-ppFullField :: HsFieldDecl -> Html
-ppFullField (HsFieldDecl [n] ty doc) 
-  = declWithDoc False doc (
-	ppHsBinder False n <+> dcolon <+> ppHsBangType ty
-    )
-ppFullField _ = error "ppFullField"
-
-expandField :: HsFieldDecl -> [HsFieldDecl]
-expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ]
--}
-
--- | Print the LHS of a data/newtype declaration.
--- Currently doesn't handle 'data instance' decls or kind signatures
-ppDataHeader :: Bool -> TyClDecl DocName -> Html
-ppDataHeader summary decl 
-  | not (isDataDecl decl) = error "ppDataHeader: illegal argument"
-  | otherwise = 
-    -- newtype or data
-    (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+> 
-    -- context
-    ppLContext (tcdCtxt decl) <+>
-    -- T a b c ..., or a :+: b  
-    (if isConSym name 
-      then ppName (tyvars!!0) <+> ppBinder summary name <+> ppName (tyvars!!1)
-      else ppBinder summary name <+> hsep (map ppName tyvars))
-  where 
-    tyvars = tyvarNames $ tcdTyVars decl
-    name = orig $ tcdLName decl
-
--- ----------------------------------------------------------------------------
--- Types and contexts
-
-ppKind k = toHtml $ showSDoc (ppr k)
-
-{-
-ppForAll Implicit _ lctxt = ppCtxtPart lctxt
-ppForAll Explicit ltvs lctxt = 
-  hsep (keyword "forall" : ppTyVars ltvs ++ [dot]) <+> ppCtxtPart lctxt 
--}
-
-ppBang HsStrict = toHtml "!"
-ppBang HsUnbox  = toHtml "!!"
-
-tupleParens Boxed   = parenList
-tupleParens Unboxed = ubxParenList 
-{-
-ppType :: HsType DocName -> Html
-ppType t = case t of
-  t@(HsForAllTy expl ltvs lcontext ltype) -> ppForAllTy t <+> ppLType ltype
-  HsTyVar n -> ppDocName n
-  HsBangTy HsStrict lt -> toHtml "!" <+> ppLType lt
-  HsBangTy HsUnbox lt -> toHtml "!!" <+> ppLType lt
-  HsAppTy a b -> ppLType a <+> ppLType b 
-  HsFunTy a b -> hsep [ppLType a, toHtml "->", ppLType b]
-  HsListTy t -> brackets $ ppLType t
-  HsPArrTy t -> toHtml "[:" +++ ppLType t +++ toHtml ":]"
-  HsTupleTy Boxed ts -> parenList $ map ppLType ts
-  HsTupleTy Unboxed ts -> ubxParenList $ map ppLType ts
-  HsOpTy a n b -> ppLType a <+> ppLDocName n <+> ppLType b
-  HsParTy t -> parens $ ppLType t
-  HsNumTy n -> toHtml (show n)
-  HsPredTy p -> ppPred p
-  HsKindSig t k -> hsep [ppLType t, dcolon, ppKind k]
-  HsSpliceTy _ -> error "ppType"
-  HsDocTy t _ -> ppLType t
--}
---------------------------------------------------------------------------------
--- Rendering of HsType 
---------------------------------------------------------------------------------
-
-pREC_TOP = (0 :: Int)   -- type in ParseIface.y in GHC
-pREC_FUN = (1 :: Int)   -- btype in ParseIface.y in GHC
-                        -- Used for LH arg of (->)
-pREC_OP  = (2 :: Int)   -- Used for arg of any infix operator
-                        -- (we don't keep their fixities around)
-pREC_CON = (3 :: Int)   -- Used for arg of type applicn:
-                        -- always parenthesise unless atomic
-
-maybeParen :: Int           -- Precedence of context
-           -> Int           -- Precedence of top-level operator
-           -> Html -> Html  -- Wrap in parens if (ctxt >= op)
-maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
-                               | otherwise            = p
-
-ppType ty       = ppr_mono_ty pREC_TOP (prepare ty)
-ppParendType ty = ppr_mono_ty pREC_CON ty
-
--- Before printing a type
--- (a) Remove outermost HsParTy parens
--- (b) Drop top-level for-all type variables in user style
---     since they are implicit in Haskell
-prepare (HsParTy ty) = prepare (unLoc ty)
-prepare ty           = ty
-
-ppForAll exp tvs cxt 
-  | show_forall = forall_part <+> ppLContext cxt
-  | otherwise   = ppLContext cxt
-  where
-    show_forall = not (null tvs) && is_explicit
-    is_explicit = case exp of {Explicit -> True; Implicit -> False}
-    forall_part = hsep (keyword "forall" : ppTyVars tvs) +++ dot 
-
-ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
-
-ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
-  = maybeParen ctxt_prec pREC_FUN $
-    hsep [ppForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
-
--- gaw 2004
-ppr_mono_ty ctxt_prec (HsBangTy b ty)     = ppBang b +++ ppLType ty
-ppr_mono_ty ctxt_prec (HsTyVar name)      = ppDocName name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
-ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (map ppLType tys)
-ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppKind kind)
-ppr_mono_ty ctxt_prec (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty ctxt_prec (HsPArrTy ty)       = pabrackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty ctxt_prec (HsPredTy pred)     = parens (ppPred pred)
-ppr_mono_ty ctxt_prec (HsNumTy n)         = toHtml (show n) -- generics only
-ppr_mono_ty ctxt_prec (HsSpliceTy s)      = error "ppr_mono_ty-haddock"
-
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
-  = maybeParen ctxt_prec pREC_CON $
-    hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
-
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
-  = maybeParen ctxt_prec pREC_OP $
-    ppr_mono_lty pREC_OP ty1 <+> ppLDocName op <+> ppr_mono_lty pREC_OP ty2
-
-ppr_mono_ty ctxt_prec (HsParTy ty)
-  = parens (ppr_mono_lty pREC_TOP ty)
-
-ppr_mono_ty ctxt_prec (HsDocTy ty doc)
-  = ppLType ty
-
-ppr_fun_ty ctxt_prec ty1 ty2
-  = let p1 = ppr_mono_lty pREC_FUN ty1
-        p2 = ppr_mono_lty pREC_TOP ty2
-    in
-    maybeParen ctxt_prec pREC_FUN $
-    hsep [p1, arrow <+> p2]
-
--- ----------------------------------------------------------------------------
--- Names
-
-ppOccName :: OccName -> Html
-ppOccName name = toHtml $ occNameString name
-
-ppRdrName :: RdrName -> Html
-ppRdrName = ppOccName . rdrNameOcc
-
-ppLDocName (L _ d) = ppDocName d
-
-ppDocName :: DocName -> Html
-ppDocName (Link name) = linkId (nameModule name) (Just name) << ppName name
-ppDocName (NoLink name) = toHtml (getOccString name)
-
-linkTarget :: Name -> Html
-linkTarget name = namedAnchor (anchorNameStr name) << toHtml "" 
-
-ppName :: Name -> Html
-ppName name = toHtml (getOccString name)
-
-ppBinder :: Bool -> Name -> Html
--- The Bool indicates whether we are generating the summary, in which case
--- the binder will be a link to the full definition.
-ppBinder True nm = linkedAnchor (anchorNameStr nm) << ppBinder' nm
-ppBinder False nm = linkTarget nm +++ bold << ppBinder' nm
-
-ppBinder' :: Name -> Html
-ppBinder' name 
-  | isVarSym name = parens $ toHtml (getOccString name)
-  | otherwise = toHtml (getOccString name)             
-
-linkId :: Module -> Maybe Name -> Html -> Html
-linkId mod mbName = anchor ! [href hr]
-  where 
-    hr = case mbName of
-      Nothing   -> moduleHtmlFile mod
-      Just name -> nameHtmlRef mod name
-
-ppModule :: Module -> String -> Html
-ppModule mod ref = anchor ! [href ((moduleHtmlFile mod) ++ ref)] 
-                   << toHtml (moduleString mod)
-
--- -----------------------------------------------------------------------------
--- * Doc Markup
-
-parHtmlMarkup :: (a -> Html) -> DocMarkup a Html
-parHtmlMarkup ppId = Markup {
-  markupParagraph     = paragraph,
-  markupEmpty	      = toHtml "",
-  markupString        = toHtml,
-  markupAppend        = (+++),
-  markupIdentifier    = tt . ppId . head,
-  markupModule        = \m -> ppModule (mkModuleNoPkg m) "",
-  markupEmphasis      = emphasize . toHtml,
-  markupMonospaced    = tt . toHtml,
-  markupUnorderedList = ulist . concatHtml . map (li <<),
-  markupOrderedList   = olist . concatHtml . map (li <<),
-  markupDefList       = dlist . concatHtml . map markupDef,
-  markupCodeBlock     = pre,
-  markupURL	      = \url -> anchor ! [href url] << toHtml url,
-  markupAName	      = \aname -> namedAnchor aname << toHtml ""
-  }
-
-markupDef (a,b) = dterm << a +++ ddef << b
-
-htmlMarkup = parHtmlMarkup ppDocName
-htmlOrigMarkup = parHtmlMarkup ppName
-htmlRdrMarkup = parHtmlMarkup ppRdrName
-
--- If the doc is a single paragraph, don't surround it with <P> (this causes
--- ugly extra whitespace with some browsers).
-docToHtml :: GHC.HsDoc DocName -> Html
-docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc))
-
-origDocToHtml :: GHC.HsDoc GHC.Name -> Html
-origDocToHtml doc = markup htmlOrigMarkup (unParagraph (markup htmlCleanup doc))
-
-rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc))
-
--- If there is a single paragraph, then surrounding it with <P>..</P>
--- can add too much whitespace in some browsers (eg. IE).  However if
--- we have multiple paragraphs, then we want the extra whitespace to
--- separate them.  So we catch the single paragraph case and transform it
--- here.
-unParagraph (GHC.DocParagraph d) = d
---NO: This eliminates line breaks in the code block:  (SDM, 6/5/2003)
---unParagraph (DocCodeBlock d) = (DocMonospaced d)
-unParagraph doc              = doc
-
-htmlCleanup :: DocMarkup a (GHC.HsDoc a)
-htmlCleanup = idMarkup { 
-  markupUnorderedList = GHC.DocUnorderedList . map unParagraph,
-  markupOrderedList   = GHC.DocOrderedList   . map unParagraph
-  } 
-
--- -----------------------------------------------------------------------------
--- * Misc
-
-hsep :: [Html] -> Html
-hsep [] = noHtml
-hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
-
-infixr 8 <+>
-(<+>) :: Html -> Html -> Html
-a <+> b = Html (getHtmlElements (toHtml a) ++ HtmlString " ": getHtmlElements (toHtml b))
-
-keyword :: String -> Html
-keyword s = thespan ! [theclass "keyword"] << toHtml s
-
-equals, comma :: Html
-equals = char '='
-comma  = char ','
-
-char :: Char -> Html
-char c = toHtml [c]
-
-empty :: Html
-empty  = noHtml
-
-parens, brackets, braces :: Html -> Html
-parens h        = char '(' +++ h +++ char ')'
-brackets h      = char '[' +++ h +++ char ']'
-pabrackets h    = toHtml "[:" +++ h +++ toHtml ":]"
-braces h        = char '{' +++ h +++ char '}'
-
-punctuate :: Html -> [Html] -> [Html]
-punctuate _ []     = []
-punctuate h (d0:ds) = go d0 ds
-                   where
-                     go d [] = [d]
-                     go d (e:es) = (d +++ h) : go e es
-
-abovesSep :: HtmlTable -> [HtmlTable] -> HtmlTable
-abovesSep _ []      = Html.emptyTable
-abovesSep h (d0:ds) = go d0 ds
-                   where
-                     go d [] = d
-                     go d (e:es) = d </> h </> go e es
-
-parenList :: [Html] -> Html
-parenList = parens . hsep . punctuate comma
-
-ubxParenList :: [Html] -> Html
-ubxParenList = ubxparens . hsep . punctuate comma
-
-ubxparens :: Html -> Html
-ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
-
-{-
-text :: Html
-text   = strAttr "TEXT"
--}
-
--- a box for displaying code
-declBox :: Html -> HtmlTable
-declBox html = tda [theclass "decl"] << html
-
--- a box for top level documented names
--- it adds a source and wiki link at the right hand side of the box
-topDeclBox :: LinksInfo -> SrcSpan -> Name -> Html -> HtmlTable
-topDeclBox ((_,_,Nothing), (_,_,Nothing), _) _ _ html = declBox html
-topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), hmod)
-           loc name html =
-  tda [theclass "topdecl"] <<
-  (        table ! [theclass "declbar"] <<
-	    ((tda [theclass "declname"] << html)
-             <-> srcLink
-             <-> wikiLink)
-  )
-  where srcLink =
-          case maybe_source_url of
-            Nothing  -> Html.emptyTable
-            Just url -> tda [theclass "declbut"] <<
-                          let url' = spliceURL (Just fname) (Just mod)
-                                               (Just name) url
-                           in anchor ! [href url'] << toHtml "Source"
-        wikiLink =
-          case maybe_wiki_url of
-            Nothing  -> Html.emptyTable
-            Just url -> tda [theclass "declbut"] <<
-                          let url' = spliceURL (Just fname) (Just mod)
-                                               (Just name) url
-                           in anchor ! [href url'] << toHtml "Comments"
-  
-        mod = hmod_mod hmod
-        fname = unpackFS (srcSpanFile loc)
-
--- a box for displaying an 'argument' (some code which has text to the
--- right of it).  Wrapping is not allowed in these boxes, whereas it is
--- in a declBox.
-argBox :: Html -> HtmlTable
-argBox html = tda [theclass "arg"] << html
-
--- a box for displaying documentation, 
--- indented and with a little padding at the top
-docBox :: Html -> HtmlTable
-docBox html = tda [theclass "doc"] << html
-
--- a box for displaying documentation, not indented.
-ndocBox :: Html -> HtmlTable
-ndocBox html = tda [theclass "ndoc"] << html
-
--- a box for displaying documentation, padded on the left a little
-rdocBox :: Html -> HtmlTable
-rdocBox html = tda [theclass "rdoc"] << html
-
-maybeRDocBox :: Maybe (GHC.LHsDoc DocName) -> HtmlTable
-maybeRDocBox Nothing = rdocBox (noHtml)
-maybeRDocBox (Just ldoc) = rdocBox (docToHtml (unLoc ldoc))
-
--- a box for the buttons at the top of the page
-topButBox :: Html -> HtmlTable
-topButBox html = tda [theclass "topbut"] << html
-
--- a vanilla table has width 100%, no border, no padding, no spacing
--- a narrow table is the same but without width 100%.
-vanillaTable, narrowTable :: Html -> Html
-vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0]
-vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0]
-narrowTable  = table ! [theclass "narrow",  cellspacing 0, cellpadding 0]
-
-spacedTable1, spacedTable5 :: Html -> Html
-spacedTable1 = table ! [theclass "vanilla",  cellspacing 1, cellpadding 0]
-spacedTable5 = table ! [theclass "vanilla",  cellspacing 5, cellpadding 0]
-
-constrHdr, methHdr :: HtmlTable
-constrHdr  = tda [ theclass "section4" ] << toHtml "Constructors"
-methHdr    = tda [ theclass "section4" ] << toHtml "Methods"
-
-instHdr :: String -> HtmlTable
-instHdr id = 
-  tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances")
-
-dcolon, arrow, darrow :: Html
-dcolon = toHtml "::"
-arrow  = toHtml "->"
-darrow = toHtml "=>"
-dot    = toHtml "."
-
-s8, s15 :: HtmlTable
-s8  = tda [ theclass "s8" ]  << noHtml
-s15 = tda [ theclass "s15" ] << noHtml
-
-namedAnchor :: String -> Html -> Html
-namedAnchor n = anchor ! [name (escapeStr n)]
-
---
--- A section of HTML which is collapsible via a +/- button.
---
-
--- TODO: Currently the initial state is non-collapsed. Change the 'minusFile'
--- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we
--- use cookies from JavaScript to have a more persistent state.
-
-collapsebutton :: String -> Html
-collapsebutton id = 
-  image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id ++ "')"), alt "show/hide" ]
-
-collapsed :: (HTML a) => (Html -> Html) -> String -> a -> Html
-collapsed fn id html =
-  fn ! [identifier id, thestyle "display:block;"] << html
-
--- A quote is a valid part of a Haskell identifier, but it would interfere with
--- the ECMA script string delimiter used in collapsebutton above.
-collapseId :: Name -> String
-collapseId nm = "i:" ++ escapeStr (getOccString nm)
-
-linkedAnchor :: String -> Html -> Html
-linkedAnchor frag = anchor ! [href hr]
-   where hr | null frag = ""
-            | otherwise = '#': escapeStr frag
-
-documentCharacterEncoding :: Html
-documentCharacterEncoding =
-   meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"]
-
-styleSheet :: Html
-styleSheet =
-   thelink ! [href cssFile, rel "stylesheet", thetype "text/css"]
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
new file mode 100644
index 00000000..aed4af34
--- /dev/null
+++ b/src/Haddock/Interface.hs
@@ -0,0 +1,91 @@
+-------------------------------------------------------------------------------
+-- Haddock.Interface
+--
+-- Here we build the actual module interfaces. By interface we mean the 
+-- information which is used to render a Haddock page for a module. Parts of 
+-- this information is also stored in the interface files.
+--
+-- The HaddockModule structure holds the interface data as well as 
+-- intermediate information needed during its creation.
+-------------------------------------------------------------------------------
+
+
+module Haddock.Interface (
+  createInterfaces
+) where
+
+
+import Haddock.Interface.Create
+import Haddock.Interface.AttachInstances
+import Haddock.Interface.Rename
+import Haddock.Types
+import Haddock.Options
+import Haddock.GHC.Utils
+
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.List
+import Control.Monad.Writer
+import Control.Monad
+
+import Name
+
+
+-- | Turn a topologically sorted list of GhcModules into interfaces. Also
+-- return the home link environment created in the process, and any error
+-- messages.
+createInterfaces :: [GhcModule] -> LinkEnv -> [Flag] -> 
+                    ([HaddockModule], LinkEnv, [ErrMsg])
+createInterfaces modules extLinks flags = (interfaces, homeLinks, messages)
+  where 
+    ((interfaces, homeLinks), messages) = runWriter $ do
+      -- part 1, create the interfaces
+      interfaces <- createInterfaces' modules flags
+      -- part 2, attach the instances
+      let interfaces' = attachInstances interfaces
+      -- part 3, rename the interfaces
+      renameInterfaces interfaces' extLinks
+
+
+createInterfaces' :: [GhcModule] -> [Flag] -> ErrMsgM [HaddockModule]
+createInterfaces' modules flags = do
+  resultMap <- foldM addInterface Map.empty modules
+  return (Map.elems resultMap)
+  where
+    addInterface :: ModuleMap -> GhcModule -> ErrMsgM ModuleMap
+    addInterface map mod = do
+      interface <- createInterface mod flags map
+      return $ Map.insert (hmod_mod interface) interface map
+
+ 
+renameInterfaces :: [HaddockModule] -> LinkEnv -> 
+                    ErrMsgM ([HaddockModule], LinkEnv)
+renameInterfaces interfaces externalLinks = do
+  let homeLinks = buildHomeLinks interfaces
+  let links = homeLinks `Map.union` externalLinks
+  interfaces' <- mapM (renameInterface links) interfaces
+  return (interfaces', homeLinks)
+
+-- | Build a mapping which for each original name, points to the "best"
+-- place to link to in the documentation.  For the definition of
+-- "best", we use "the module nearest the bottom of the dependency
+-- graph which exports this name", not including hidden modules.  When
+-- there are multiple choices, we pick a random one.
+-- 
+-- The interfaces are passed in in topologically sorted order, but we start
+-- by reversing the list so we can do a foldl.
+buildHomeLinks :: [HaddockModule] -> LinkEnv
+buildHomeLinks modules = foldl upd Map.empty (reverse modules)
+  where
+    upd old_env mod
+      | OptHide    `elem` hmod_options mod = old_env
+      | OptNotHome `elem` hmod_options mod =
+        foldl' keep_old old_env exported_names
+      | otherwise = foldl' keep_new old_env exported_names
+      where
+        exported_names = hmod_visible_exports mod
+        modName = hmod_mod mod
+
+        keep_old env n = Map.insertWith (\new old -> old) n
+                         (nameSetMod n modName) env
+        keep_new env n = Map.insert n (nameSetMod n modName) env
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 246c6dba..228efa71 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -45,7 +45,7 @@ data InterfaceMod = InterfaceMod {
 }
 
 data InterfaceFile = InterfaceFile {
-  ifDocEnv  :: DocEnv
+  ifLinkEnv  :: LinkEnv
 --  ifModules :: [InterfaceMod]  
 } 
 
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 2b459f8d..c330f35e 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -132,6 +132,5 @@ options backwardsCompat =
     Option [] ["use-package"] (ReqArg Flag_UsePackage "PACKAGE")
 	"the modules being processed depend on PACKAGE",
     Option ['g'] [] (ReqArg Flag_GhcFlag "FLAGS + ARGS")
- 	("send a flag to the Glasgow Haskell Compiler (use quotation to "
-  ++ "pass arguments to the flag)")      
+ 	("send a flag to GHC")
    ]
diff --git a/src/Haddock/Packages.hs b/src/Haddock/Packages.hs
index 18383c4c..c2de11b4 100644
--- a/src/Haddock/Packages.hs
+++ b/src/Haddock/Packages.hs
@@ -7,8 +7,8 @@
 
 module Haddock.Packages (
   HaddockPackage(..),
-  initAndReadPackages,
-  combineDocEnvs
+  getHaddockPackages,
+  combineLinkEnvs
 ) where
 
 
@@ -33,68 +33,22 @@ import Packages
 -- to the html files and the list of modules in the package
 data HaddockPackage = HaddockPackage {
   pdModules  :: [Module],
-  pdDocEnv   :: DocEnv,
+  pdLinkEnv  :: LinkEnv,
   pdHtmlPath :: FilePath
 }
 
 
--- | Expose the list of packages to GHC. Then initialize GHC's package state
--- and get the name of the actually loaded packages matching the supplied 
--- list of packages. The matching packages might be newer versions of the 
--- supplied ones. For each matching package, try to read its installed Haddock
--- information.
---
--- It would be better to try to get the "in scope" packages from GHC instead.
--- This would make the -use-package flag unnecessary. But currently it 
--- seems all you can get from the GHC api is all packages that are linked in 
--- (i.e the closure of the "in scope" packages).
-initAndReadPackages :: Session -> [String] -> IO [HaddockPackage] 
-initAndReadPackages session pkgStrs = do
-
-  -- expose the packages 
-
-  dfs <- getSessionDynFlags session
-  let dfs' = dfs { packageFlags = packageFlags dfs ++ map ExposePackage pkgStrs }
-  setSessionDynFlags session dfs'
-
-  -- try to parse the packages and get their names, without versions
-  pkgNames <- mapM (handleParse . unpackPackageId . stringToPackageId) pkgStrs
-
-  -- init GHC's package state
-  (_, depPackages) <- initPackages dfs'
-
-  -- compute the pkgIds of the loaded packages matching the 
-  -- supplied ones
-  
-  let depPkgs = map (fromJust . unpackPackageId) depPackages      
-      matchingPackages = [ mkPackageId pkg | pkg <- depPkgs, 
-                           pkgName pkg `elem` pkgNames ]
-
-  -- read the Haddock information for the matching packages
-  getPackages session matchingPackages
-  where
-    handleParse (Just pkg) = return (pkgName pkg)
-    handleParse Nothing = throwE "Could not parse package identifier"
-
-
--- | Try to create a HaddockPackage for each package.
--- Print a warning on stdout if a HaddockPackage could not be created.
-getPackages :: Session -> [PackageId] -> IO [HaddockPackage]
-getPackages session packages = do
-
-  -- get InstalledPackageInfos for each package
-  dynflags <- getSessionDynFlags session
-  let pkgInfos = map (getPackageDetails (pkgState dynflags)) packages
-
-  -- try to read the installed haddock information (.haddock interface file and
-  -- html path) for the packages
-  liftM catMaybes $ mapM tryGetPackage pkgInfos
+-- | Try to read the installed Haddock information for the given packages, 
+-- if it exists. Print a warning on stdout if it couldn't be found for a 
+-- package.
+getHaddockPackages :: [InstalledPackageInfo] -> IO [HaddockPackage]
+getHaddockPackages pkgInfos = liftM catMaybes $ mapM tryGetPackage pkgInfos
   where
     -- try to get a HaddockPackage, warn if we can't
     tryGetPackage pkgInfo = 
-        (getPackage session pkgInfo >>= return . Just)
+        (getPackage pkgInfo >>= return . Just)
       `catchDyn`
-        (\(e::HaddockException) -> do 
+        (\(e::HaddockException) -> do
           let pkgName = showPackageId (package pkgInfo)
           putStrLn ("Warning: Cannot use package " ++ pkgName ++ ":")
           putStrLn ("   " ++ show e)
@@ -102,20 +56,17 @@ getPackages session packages = do
         )
 
 
--- | Try to create a HaddockPackage structure for a package
-getPackage :: Session -> InstalledPackageInfo -> IO HaddockPackage
-getPackage session pkgInfo = do
+-- | Try to read a HaddockPackage structure for a package
+getPackage :: InstalledPackageInfo -> IO HaddockPackage
+getPackage pkgInfo = do
 
-  html <- getHtml pkgInfo
+  html      <- getHtml pkgInfo
   ifacePath <- getIface pkgInfo
-  iface <- readInterfaceFile ifacePath
+  iface     <- readInterfaceFile ifacePath
   
-  let docEnv  = ifDocEnv iface
-      modules = packageModules pkgInfo
-
   return $ HaddockPackage {
-    pdModules  = modules,
-    pdDocEnv   = docEnv,
+    pdModules  = packageModules pkgInfo,
+    pdLinkEnv  = ifLinkEnv iface,
     pdHtmlPath = html
   } 
 
@@ -148,8 +99,8 @@ getIface pkgInfo = case haddockInterfaces pkgInfo of
   _ -> throwE "No Haddock interface installed."
 
 
--- | Build one big doc env out of a list of packages. If multiple packages 
+-- | Build one big link env out of a list of packages. If multiple packages 
 -- export the same (original) name, we just pick one of the packages as the 
 -- documentation site.
-combineDocEnvs :: [HaddockPackage] -> DocEnv
-combineDocEnvs packages = Map.unions (map pdDocEnv packages)
+combineLinkEnvs :: [HaddockPackage] -> LinkEnv
+combineLinkEnvs packages = Map.unions (map pdLinkEnv packages)
diff --git a/src/Haddock/Rename.hs b/src/Haddock/Rename.hs
deleted file mode 100644
index 5ac711cb..00000000
--- a/src/Haddock/Rename.hs
+++ /dev/null
@@ -1,330 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-module Haddock.Rename (
-  runRnFM, -- the monad (instance of Monad)
-  renameDoc, renameMaybeDoc, renameExportItems,
-) where
-
-import Haddock.Types
-
-import GHC hiding ( NoLink )
-import Name
-import BasicTypes
-import SrcLoc 
-import Bag ( emptyBag )
-
-import Data.Map ( Map )
-import qualified Data.Map as Map hiding ( Map )
-import Prelude hiding ( mapM )
-import Data.Traversable ( mapM )
-import Control.Arrow
-
--- -----------------------------------------------------------------------------
--- 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 -> (Bool, DocName))	-- name lookup function
-             -> (a,[n])
-      }
-
-type RnM a = GenRnM Name a
-
-instance Monad (GenRnM n) where
-  (>>=) = thenRn
-  return = returnRn   
-
-returnRn :: a -> GenRnM n a
-returnRn a   = RnM (\_ -> (a,[]))
-thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b
-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 (Name -> (Bool, DocName))
-getLookupRn = RnM (\lkp -> (lkp,[]))
-outRn :: Name -> RnM ()
-outRn name = RnM (\_ -> ((),[name]))
-
-lookupRn :: (DocName -> a) -> Name -> RnM a
-lookupRn and_then name = do
-  lkp <- getLookupRn
-  case lkp name of
-	(False,maps_to) -> do outRn name; return (and_then maps_to)
-	(True, maps_to) -> return (and_then maps_to)
-
-newtype OrdName = MkOrdName Name
-
-instance Eq OrdName where
-  (MkOrdName a) == (MkOrdName b) = a == b
-
-instance Ord OrdName where
-  (MkOrdName a) `compare` (MkOrdName b) = nameOccName a `compare` nameOccName b
-
-runRnFM :: Map Name Name -> RnM a -> (a,[Name])
-runRnFM env rn = unRn rn lkp 
-  where 
-    lkp n = case Map.lookup (MkOrdName n) ordEnv of
-      Nothing -> (False, NoLink n) 
-      Just (MkOrdName q)  -> (True, Link q)
-
-    ordEnv = Map.fromList . map (MkOrdName *** MkOrdName) . Map.toList $ env
-
--- -----------------------------------------------------------------------------
--- Renaming 
-
-keep n = NoLink n
-keepL (L loc n) = L loc (NoLink n)
-
-rename = lookupRn id 
-renameL (L loc name) = return . L loc =<< rename name
-
-renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]
-renameExportItems items = mapM renameExportItem items
-
-renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName))
-renameMaybeDoc mbDoc = mapM renameDoc mbDoc
-
-renameLDoc (L loc doc) = return . L loc =<< renameDoc doc
-
-renameDoc :: HsDoc Name -> RnM (HsDoc DocName)
-renameDoc doc = case doc of
-  DocEmpty -> return DocEmpty
-  DocAppend a b -> do
-    a' <- renameDoc a
-    b' <- renameDoc b
-    return (DocAppend a' b')
-  DocString str -> return (DocString str)
-  DocParagraph doc -> do
-    doc' <- renameDoc doc
-    return (DocParagraph doc')
-  DocIdentifier ids -> do
-    lkp <- getLookupRn
-    case [ n | (True, n) <- map lkp ids ] of
-      ids'@(_:_) -> return (DocIdentifier ids')
-      [] -> return (DocIdentifier (map NoLink ids))
-  DocModule str -> return (DocModule str)
-  DocEmphasis doc -> do
-    doc' <- renameDoc doc
-    return (DocEmphasis doc')
-  DocMonospaced doc -> do
-    doc' <- renameDoc doc
-    return (DocMonospaced doc')
-  DocUnorderedList docs -> do
-    docs' <- mapM renameDoc docs
-    return (DocUnorderedList docs')
-  DocOrderedList docs -> do
-    docs' <- mapM renameDoc docs
-    return (DocOrderedList docs')
-  DocDefList docs -> do
-    docs' <- mapM (\(a,b) -> do
-      a' <- renameDoc a
-      b' <- renameDoc b
-      return (a',b')) docs
-    return (DocDefList docs')  
-  DocCodeBlock doc -> do
-    doc' <- renameDoc doc
-    return (DocCodeBlock doc')
-  DocURL str -> return (DocURL str) 
-  DocAName str -> return (DocAName str)
-
-renameLPred (L loc p) = return . L loc =<< renamePred p
-
-renamePred :: HsPred Name -> RnM (HsPred DocName)
-renamePred (HsClassP name types) = do
-  name' <- rename name 
-  types' <- mapM renameLType types
-  return (HsClassP name' types')
-renamePred (HsIParam (IPName name) t) = do
-  name' <- rename name
-  t' <- renameLType t
-  return (HsIParam (IPName name') t')
-
-renameLType (L loc t) = return . L loc =<< renameType t
-
-renameType t = case t of 
-  HsForAllTy expl tyvars lcontext ltype -> do
-    tyvars' <- mapM renameLTyVarBndr tyvars
-    lcontext' <- renameLContext lcontext 
-    ltype' <- renameLType ltype
-    return (HsForAllTy expl tyvars' lcontext' ltype')
-
-  HsTyVar n -> return . HsTyVar =<< rename n
-  HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
-  
-  HsAppTy a b -> do
-    a' <- renameLType a
-    b' <- renameLType b
-    return (HsAppTy a' b')
-
-  HsFunTy a b -> do     
-    a' <- renameLType a
-    b' <- renameLType b
-    return (HsFunTy a' b')
-
-  HsListTy t -> return . HsListTy =<< renameLType t
-  HsPArrTy t -> return . HsPArrTy =<< renameLType t
-
-  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
-
-  HsOpTy a (L loc op) b -> do
-    op' <- rename op
-    a' <- renameLType a
-    b' <- renameLType b
-    return (HsOpTy a' (L loc op') b')
-
-  HsParTy t -> return . HsParTy =<< renameLType t
-
-  HsNumTy n -> return (HsNumTy n)
-
-  HsPredTy p -> return . HsPredTy =<< renamePred p
-
-  HsKindSig t k -> do
-    t' <- renameLType t
-    return (HsKindSig t' k)
-
-  HsDocTy t doc -> do
-    t' <- renameLType t
-    doc' <- renameLDoc doc
-    return (HsDocTy t' doc')
-
-  _ -> error "renameType"
-
-renameLTyVarBndr (L loc tv) = do
-  name' <- rename (hsTyVarName tv)
-  return $ L loc (replaceTyVarName tv name')
-    
-renameLContext (L loc context) = do
-  context' <- mapM renameLPred context
-  return (L loc context')
-
-renameInstHead :: InstHead Name -> RnM (InstHead DocName)
-renameInstHead (preds, className, types) = do
-  preds' <- mapM renamePred preds
-  className' <- rename className
-  types' <- mapM renameType types
-  return (preds', className', types')
-
-renameLDecl (L loc d) = return . L loc =<< renameDecl d
-
-renameDecl d = case d of
-  TyClD d -> do
-    d' <- renameTyClD d
-    return (TyClD d')
-  SigD s -> do
-    s' <- renameSig s
-    return (SigD s')
-  ForD d -> do
-    d' <- renameForD d
-    return (ForD d')
-  _ -> error "renameDecl"
-
-renameTyClD d = case d of
-  ForeignType _ _ _ -> error "renameTyClD" -- I'm guessing these can't be exported
- -- ForeignType name a b -> do
- --   name' <- renameL name
- --   return (ForeignType name' a b)
-
-  TyData x lcontext lname ltyvars _ k cons _ -> do
-    lcontext' <- renameLContext lcontext
-    ltyvars' <- mapM renameLTyVarBndr ltyvars
-    cons' <- mapM renameLCon cons
-    -- I don't think we need the derivings, so we return Nothing
-    -- We skip the type patterns too. TODO: find out what they are :-)
-    return (TyData x lcontext' (keepL lname) ltyvars' Nothing k cons' Nothing) 
- 
-  TySynonym lname ltyvars typat ltype -> do
-    ltyvars' <- mapM renameLTyVarBndr ltyvars
-    ltype' <- renameLType ltype
-    -- We skip type patterns here as well.
-    return (TySynonym (keepL lname) ltyvars' Nothing ltype')
-
-  ClassDecl lcontext lname ltyvars lfundeps lsigs _ _ _ -> do
-    lcontext' <- renameLContext lcontext
-    ltyvars' <- mapM renameLTyVarBndr ltyvars
-    lfundeps' <- mapM renameLFunDep lfundeps 
-    lsigs' <- mapM renameLSig lsigs
-    -- we don't need the default methods or the already collected doc entities
-    -- we skip the ATs for now.
-    return (ClassDecl lcontext' (keepL lname) ltyvars' lfundeps' lsigs' emptyBag [] [])
- 
-  where
-    renameLCon (L loc con) = return . L loc =<< renameCon con
-    renameCon (ConDecl lname expl ltyvars lcontext details restype mbldoc) = do
-      ltyvars' <- mapM renameLTyVarBndr ltyvars
-      lcontext' <- renameLContext lcontext
-      details' <- renameDetails details
-      restype' <- renameResType restype
-      mbldoc' <- mapM renameLDoc mbldoc
-      return (ConDecl (keepL lname) expl ltyvars' lcontext' details' restype' mbldoc') 
-
-    renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
-    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
-    renameDetails (InfixCon a b) = do
-      a' <- renameLType a
-      b' <- renameLType b
-      return (InfixCon a' b')
-
-    renameField (ConDeclField name t doc) = do
-      t'   <- renameLType t
-      doc' <- mapM renameLDoc doc
-      return (ConDeclField (keepL name) t' doc')
-
-    renameResType (ResTyH98) = return ResTyH98
-    renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
-
-    renameLFunDep (L loc (xs, ys)) = return (L loc (map keep xs, map keep ys))
-   
-    renameLSig (L loc sig) = return . L loc =<< renameSig sig
-      
-renameSig sig = case sig of 
-  TypeSig (L loc name) ltype -> do 
-    ltype' <- renameLType ltype
-    return (TypeSig (L loc (keep name)) ltype')
-{-  SpecSig lname ltype x -> do
-    lname' <- renameL lname
-    ltype' <- renameLType ltype
-    return (SpecSig lname' ltype' x)
-  InlineSig lname x -> do
-    lname' <- renameL lname
-    return (InlineSig lname' x)   
-  SpecInstSig t -> return . SpecInstSig =<< renameLType t
-  FixSig fsig -> return . FixSig =<< renameFixitySig fsig
-  where
-    renameFixitySig (FixitySig lname x) = do
-      lname' <- renameL lname
-      return (FixitySig lname' x)
--}
-
-renameForD (ForeignImport lname ltype x) = do
-  ltype' <- renameLType ltype
-  return (ForeignImport (keepL lname) ltype' x)
-renameForD (ForeignExport lname ltype x) = do
-  ltype' <- renameLType ltype
-  return (ForeignExport (keepL lname) ltype' x)
-
-renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
-renameExportItem item = case item of 
-  ExportModule mod -> return (ExportModule mod)
-  ExportGroup lev id doc -> do
-    doc' <- renameDoc doc
-    return (ExportGroup lev id doc')
-  ExportDecl x decl doc instances -> do
-    decl' <- renameLDecl decl
-    doc' <- mapM renameDoc doc
-    instances' <- mapM renameInstHead instances
-    return (ExportDecl x decl' doc' instances')
-  ExportNoDecl x y subs -> do
-    y' <- lookupRn id y
-    subs' <- mapM (lookupRn id) subs
-    return (ExportNoDecl x y' subs')
-  ExportDoc doc -> do
-    doc' <- renameDoc doc
-    return (ExportDoc doc')
diff --git a/src/Haddock/Syntax/Rename.hs b/src/Haddock/Syntax/Rename.hs
new file mode 100644
index 00000000..81dfb1cc
--- /dev/null
+++ b/src/Haddock/Syntax/Rename.hs
@@ -0,0 +1,333 @@
+--
+-- Haddock - A Haskell Documentation Tool
+--
+-- (c) Simon Marlow 2003
+--
+
+
+module Haddock.Syntax.Rename (
+  runRnFM, -- the monad (instance of Monad)
+  renameDoc, renameMaybeDoc, renameExportItems,
+) where
+
+
+import Haddock.Types
+
+import GHC hiding ( NoLink )
+import Name
+import BasicTypes
+import SrcLoc 
+import Bag ( emptyBag )
+
+import Data.Map ( Map )
+import qualified Data.Map as Map hiding ( Map )
+import Prelude hiding ( mapM )
+import Data.Traversable ( mapM )
+import Control.Arrow
+
+
+-- -----------------------------------------------------------------------------
+-- 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 -> (Bool, DocName))	-- name lookup function
+             -> (a,[n])
+      }
+
+type RnM a = GenRnM Name a
+
+instance Monad (GenRnM n) where
+  (>>=) = thenRn
+  return = returnRn   
+
+returnRn :: a -> GenRnM n a
+returnRn a   = RnM (\_ -> (a,[]))
+thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b
+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 (Name -> (Bool, DocName))
+getLookupRn = RnM (\lkp -> (lkp,[]))
+outRn :: Name -> RnM ()
+outRn name = RnM (\_ -> ((),[name]))
+
+lookupRn :: (DocName -> a) -> Name -> RnM a
+lookupRn and_then name = do
+  lkp <- getLookupRn
+  case lkp name of
+	(False,maps_to) -> do outRn name; return (and_then maps_to)
+	(True, maps_to) -> return (and_then maps_to)
+
+newtype OrdName = MkOrdName Name
+
+instance Eq OrdName where
+  (MkOrdName a) == (MkOrdName b) = a == b
+
+instance Ord OrdName where
+  (MkOrdName a) `compare` (MkOrdName b) = nameOccName a `compare` nameOccName b
+
+runRnFM :: Map Name Name -> RnM a -> (a,[Name])
+runRnFM env rn = unRn rn lkp 
+  where 
+    lkp n = case Map.lookup (MkOrdName n) ordEnv of
+      Nothing -> (False, NoLink n) 
+      Just (MkOrdName q)  -> (True, Link q)
+
+    ordEnv = Map.fromList . map (MkOrdName *** MkOrdName) . Map.toList $ env
+
+-- -----------------------------------------------------------------------------
+-- Renaming 
+
+keep n = NoLink n
+keepL (L loc n) = L loc (NoLink n)
+
+rename = lookupRn id 
+renameL (L loc name) = return . L loc =<< rename name
+
+renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]
+renameExportItems items = mapM renameExportItem items
+
+renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName))
+renameMaybeDoc mbDoc = mapM renameDoc mbDoc
+
+renameLDoc (L loc doc) = return . L loc =<< renameDoc doc
+
+renameDoc :: HsDoc Name -> RnM (HsDoc DocName)
+renameDoc doc = case doc of
+  DocEmpty -> return DocEmpty
+  DocAppend a b -> do
+    a' <- renameDoc a
+    b' <- renameDoc b
+    return (DocAppend a' b')
+  DocString str -> return (DocString str)
+  DocParagraph doc -> do
+    doc' <- renameDoc doc
+    return (DocParagraph doc')
+  DocIdentifier ids -> do
+    lkp <- getLookupRn
+    case [ n | (True, n) <- map lkp ids ] of
+      ids'@(_:_) -> return (DocIdentifier ids')
+      [] -> return (DocIdentifier (map NoLink ids))
+  DocModule str -> return (DocModule str)
+  DocEmphasis doc -> do
+    doc' <- renameDoc doc
+    return (DocEmphasis doc')
+  DocMonospaced doc -> do
+    doc' <- renameDoc doc
+    return (DocMonospaced doc')
+  DocUnorderedList docs -> do
+    docs' <- mapM renameDoc docs
+    return (DocUnorderedList docs')
+  DocOrderedList docs -> do
+    docs' <- mapM renameDoc docs
+    return (DocOrderedList docs')
+  DocDefList docs -> do
+    docs' <- mapM (\(a,b) -> do
+      a' <- renameDoc a
+      b' <- renameDoc b
+      return (a',b')) docs
+    return (DocDefList docs')  
+  DocCodeBlock doc -> do
+    doc' <- renameDoc doc
+    return (DocCodeBlock doc')
+  DocURL str -> return (DocURL str) 
+  DocAName str -> return (DocAName str)
+
+renameLPred (L loc p) = return . L loc =<< renamePred p
+
+renamePred :: HsPred Name -> RnM (HsPred DocName)
+renamePred (HsClassP name types) = do
+  name' <- rename name 
+  types' <- mapM renameLType types
+  return (HsClassP name' types')
+renamePred (HsIParam (IPName name) t) = do
+  name' <- rename name
+  t' <- renameLType t
+  return (HsIParam (IPName name') t')
+
+renameLType (L loc t) = return . L loc =<< renameType t
+
+renameType t = case t of 
+  HsForAllTy expl tyvars lcontext ltype -> do
+    tyvars' <- mapM renameLTyVarBndr tyvars
+    lcontext' <- renameLContext lcontext 
+    ltype' <- renameLType ltype
+    return (HsForAllTy expl tyvars' lcontext' ltype')
+
+  HsTyVar n -> return . HsTyVar =<< rename n
+  HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
+  
+  HsAppTy a b -> do
+    a' <- renameLType a
+    b' <- renameLType b
+    return (HsAppTy a' b')
+
+  HsFunTy a b -> do     
+    a' <- renameLType a
+    b' <- renameLType b
+    return (HsFunTy a' b')
+
+  HsListTy t -> return . HsListTy =<< renameLType t
+  HsPArrTy t -> return . HsPArrTy =<< renameLType t
+
+  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
+
+  HsOpTy a (L loc op) b -> do
+    op' <- rename op
+    a' <- renameLType a
+    b' <- renameLType b
+    return (HsOpTy a' (L loc op') b')
+
+  HsParTy t -> return . HsParTy =<< renameLType t
+
+  HsNumTy n -> return (HsNumTy n)
+
+  HsPredTy p -> return . HsPredTy =<< renamePred p
+
+  HsKindSig t k -> do
+    t' <- renameLType t
+    return (HsKindSig t' k)
+
+  HsDocTy t doc -> do
+    t' <- renameLType t
+    doc' <- renameLDoc doc
+    return (HsDocTy t' doc')
+
+  _ -> error "renameType"
+
+renameLTyVarBndr (L loc tv) = do
+  name' <- rename (hsTyVarName tv)
+  return $ L loc (replaceTyVarName tv name')
+    
+renameLContext (L loc context) = do
+  context' <- mapM renameLPred context
+  return (L loc context')
+
+renameInstHead :: InstHead Name -> RnM (InstHead DocName)
+renameInstHead (preds, className, types) = do
+  preds' <- mapM renamePred preds
+  className' <- rename className
+  types' <- mapM renameType types
+  return (preds', className', types')
+
+renameLDecl (L loc d) = return . L loc =<< renameDecl d
+
+renameDecl d = case d of
+  TyClD d -> do
+    d' <- renameTyClD d
+    return (TyClD d')
+  SigD s -> do
+    s' <- renameSig s
+    return (SigD s')
+  ForD d -> do
+    d' <- renameForD d
+    return (ForD d')
+  _ -> error "renameDecl"
+
+renameTyClD d = case d of
+  ForeignType _ _ _ -> error "renameTyClD" -- I'm guessing these can't be exported
+ -- ForeignType name a b -> do
+ --   name' <- renameL name
+ --   return (ForeignType name' a b)
+
+  TyData x lcontext lname ltyvars _ k cons _ -> do
+    lcontext' <- renameLContext lcontext
+    ltyvars' <- mapM renameLTyVarBndr ltyvars
+    cons' <- mapM renameLCon cons
+    -- I don't think we need the derivings, so we return Nothing
+    -- We skip the type patterns too. TODO: find out what they are :-)
+    return (TyData x lcontext' (keepL lname) ltyvars' Nothing k cons' Nothing) 
+ 
+  TySynonym lname ltyvars typat ltype -> do
+    ltyvars' <- mapM renameLTyVarBndr ltyvars
+    ltype' <- renameLType ltype
+    -- We skip type patterns here as well.
+    return (TySynonym (keepL lname) ltyvars' Nothing ltype')
+
+  ClassDecl lcontext lname ltyvars lfundeps lsigs _ _ _ -> do
+    lcontext' <- renameLContext lcontext
+    ltyvars' <- mapM renameLTyVarBndr ltyvars
+    lfundeps' <- mapM renameLFunDep lfundeps 
+    lsigs' <- mapM renameLSig lsigs
+    -- we don't need the default methods or the already collected doc entities
+    -- we skip the ATs for now.
+    return (ClassDecl lcontext' (keepL lname) ltyvars' lfundeps' lsigs' emptyBag [] [])
+ 
+  where
+    renameLCon (L loc con) = return . L loc =<< renameCon con
+    renameCon (ConDecl lname expl ltyvars lcontext details restype mbldoc) = do
+      ltyvars' <- mapM renameLTyVarBndr ltyvars
+      lcontext' <- renameLContext lcontext
+      details' <- renameDetails details
+      restype' <- renameResType restype
+      mbldoc' <- mapM renameLDoc mbldoc
+      return (ConDecl (keepL lname) expl ltyvars' lcontext' details' restype' mbldoc') 
+
+    renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
+    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+    renameDetails (InfixCon a b) = do
+      a' <- renameLType a
+      b' <- renameLType b
+      return (InfixCon a' b')
+
+    renameField (ConDeclField name t doc) = do
+      t'   <- renameLType t
+      doc' <- mapM renameLDoc doc
+      return (ConDeclField (keepL name) t' doc')
+
+    renameResType (ResTyH98) = return ResTyH98
+    renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
+
+    renameLFunDep (L loc (xs, ys)) = return (L loc (map keep xs, map keep ys))
+   
+    renameLSig (L loc sig) = return . L loc =<< renameSig sig
+      
+renameSig sig = case sig of 
+  TypeSig (L loc name) ltype -> do 
+    ltype' <- renameLType ltype
+    return (TypeSig (L loc (keep name)) ltype')
+{-  SpecSig lname ltype x -> do
+    lname' <- renameL lname
+    ltype' <- renameLType ltype
+    return (SpecSig lname' ltype' x)
+  InlineSig lname x -> do
+    lname' <- renameL lname
+    return (InlineSig lname' x)   
+  SpecInstSig t -> return . SpecInstSig =<< renameLType t
+  FixSig fsig -> return . FixSig =<< renameFixitySig fsig
+  where
+    renameFixitySig (FixitySig lname x) = do
+      lname' <- renameL lname
+      return (FixitySig lname' x)
+-}
+
+renameForD (ForeignImport lname ltype x) = do
+  ltype' <- renameLType ltype
+  return (ForeignImport (keepL lname) ltype' x)
+renameForD (ForeignExport lname ltype x) = do
+  ltype' <- renameLType ltype
+  return (ForeignExport (keepL lname) ltype' x)
+
+renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
+renameExportItem item = case item of 
+  ExportModule mod -> return (ExportModule mod)
+  ExportGroup lev id doc -> do
+    doc' <- renameDoc doc
+    return (ExportGroup lev id doc')
+  ExportDecl x decl doc instances -> do
+    decl' <- renameLDecl decl
+    doc' <- mapM renameDoc doc
+    instances' <- mapM renameInstHead instances
+    return (ExportDecl x decl' doc' instances')
+  ExportNoDecl x y subs -> do
+    y' <- lookupRn id y
+    subs' <- mapM (lookupRn id) subs
+    return (ExportNoDecl x y' subs')
+  ExportDoc doc -> do
+    doc' <- renameDoc doc
+    return (ExportDoc doc')
diff --git a/src/Haddock/Typecheck.hs b/src/Haddock/Typecheck.hs
deleted file mode 100644
index 088ee8a1..00000000
--- a/src/Haddock/Typecheck.hs
+++ /dev/null
@@ -1,123 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-
-module Haddock.Typecheck (
-  GhcModule(..),
-  typecheckFiles  
-) where
-
-
-import Haddock.Exception
-import Haddock.Utils.GHC
-
-
-import Data.Maybe
-import Control.Monad
-import GHC
-import Digraph
-import BasicTypes
-import SrcLoc
-
-
--- | This data structure collects all the information we want about a home 
--- package module that we can get from GHC's typechecker
-data GhcModule = GhcModule {
-   ghcModule         :: Module,
-   ghcFilename       :: FilePath,
-   ghcMbDocOpts      :: Maybe String,
-   ghcHaddockModInfo :: HaddockModInfo Name,
-   ghcMbDoc          :: Maybe (HsDoc Name),
-   ghcGroup          :: HsGroup Name,
-   ghcMbExports      :: Maybe [LIE Name],
-   ghcExportedNames  :: [Name],
-   ghcNamesInScope   :: [Name],
-   ghcInstances      :: [Instance]
-}
-
-
-typecheckFiles :: Session -> [FilePath] -> IO [GhcModule]
-typecheckFiles session files = do
-  checkedMods <- sortAndCheckModules session files
-  return (map mkGhcModule checkedMods)
-
-
--- | Get the sorted graph of all loaded modules and their dependencies
-getSortedModuleGraph :: Session -> IO [(Module, FilePath)]
-getSortedModuleGraph session = do
-  mbModGraph <- depanal session [] True
-  moduleGraph <- case mbModGraph of
-    Just mg -> return mg
-    Nothing -> throwE "Failed to load all modules"
-  let
-    getModFile    = fromJust . ml_hs_file . ms_location
-    sortedGraph   = topSortModuleGraph False moduleGraph Nothing
-    sortedModules = concatMap flattenSCC sortedGraph
-    modsAndFiles  = [ (ms_mod modsum, getModFile modsum) |
-                      modsum <- sortedModules ]
-  return modsAndFiles
-
-
-type CheckedMod = (Module, FilePath, FullyCheckedMod)
-
-
-type FullyCheckedMod = (ParsedSource, 
-                        RenamedSource, 
-                        TypecheckedSource, 
-                        ModuleInfo)
-
-
--- TODO: make it handle cleanup
-sortAndCheckModules :: Session -> [FilePath] -> IO [CheckedMod]
-sortAndCheckModules session files = do 
-
-  -- load all argument files
-
-  targets <- mapM (\f -> guessTarget f Nothing) files
-  setTargets session targets 
-
-  -- compute the dependencies and load them as well
-
-  allMods <- getSortedModuleGraph session
-  targets' <- mapM (\(_, f) -> guessTarget f Nothing) allMods
-  setTargets session targets'
-
-  flag <- load session LoadAllTargets
-  when (failed flag) $ 
-    throwE "Failed to load all needed modules"
-
-  -- typecheck the argument modules
-
-  let argMods = filter ((`elem` files) . snd) allMods
-
-  checkedMods <- forM argMods $ \(mod, file) -> do
-    mbMod <- checkModule session (moduleName mod) False
-    case mbMod of
-      Just (CheckedModule a (Just b) (Just c) (Just d) _) 
-        -> return (mod, file, (a,b,c,d))
-      _ -> throwE ("Failed to check module: " ++ moduleString mod)
-
-  return checkedMods
-
-
--- | Dig out what we want from the typechecker output
-mkGhcModule :: CheckedMod -> GhcModule 
-mkGhcModule (mod, file, checkedMod) = GhcModule {
-  ghcModule         = mod,
-  ghcFilename       = file,
-  ghcMbDocOpts      = mbOpts,
-  ghcHaddockModInfo = info,
-  ghcMbDoc          = mbDoc,
-  ghcGroup          = group,
-  ghcMbExports      = mbExports,
-  ghcExportedNames  = modInfoExports modInfo,
-  ghcNamesInScope   = fromJust $ modInfoTopLevelScope modInfo, 
-  ghcInstances      = modInfoInstances modInfo
-}
-  where
-    HsModule _ _ _ _ _ mbOpts _ _      = unLoc parsed
-    (group, _, mbExports, mbDoc, info) = renamed
-    (parsed, renamed, _, modInfo)      = checkedMod
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index b1ce11f1..44e8d7fd 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -8,9 +8,11 @@
 module Haddock.Types where
 
 
+import Data.Map
+import Control.Monad.Writer
+
 import GHC hiding (NoLink)
 import Outputable
-import Data.Map
 
 
 data DocOption
@@ -75,7 +77,7 @@ data ExportItem name
 type InstHead name = ([HsPred name], name, [HsType name])
 type ModuleMap     = Map Module HaddockModule
 type DocMap        = Map Name (HsDoc DocName)
-type DocEnv        = Map Name Name
+type LinkEnv       = Map Name Name
 
 
 data DocName = Link Name | NoLink Name
@@ -86,6 +88,26 @@ instance Outputable DocName where
   ppr (NoLink n) = ppr n
 
 
+-- | Information about a home package module that we get from GHC's typechecker
+data GhcModule = GhcModule {
+   ghcModule         :: Module,
+   ghcFilename       :: FilePath,
+   ghcMbDocOpts      :: Maybe String,
+   ghcHaddockModInfo :: HaddockModInfo Name,
+   ghcMbDoc          :: Maybe (HsDoc Name),
+   ghcGroup          :: HsGroup Name,
+   ghcMbExports      :: Maybe [LIE Name],
+   ghcExportedNames  :: [Name],
+   ghcNamesInScope   :: [Name],
+   ghcInstances      :: [Instance]
+}
+
+
+-- | This is the data used to render a Haddock page for a module - it is the 
+-- "interface" of the module. The core of Haddock lies in creating this 
+-- structure (see Haddock.Interface).
+--
+-- The structure also holds intermediate data needed during its creation.
 data HaddockModule = HM {
 
   -- | A value to identify the module
@@ -151,3 +173,9 @@ data DocMarkup id a = Markup {
   markupURL           :: String -> a,
   markupAName         :: String -> a
 }
+
+
+-- A monad which collects error messages
+
+type ErrMsg = String
+type ErrMsgM a = Writer [ErrMsg] a
diff --git a/src/Haddock/Utils/GHC.hs b/src/Haddock/Utils/GHC.hs
deleted file mode 100644
index 3ac90d77..00000000
--- a/src/Haddock/Utils/GHC.hs
+++ /dev/null
@@ -1,76 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-
-module Haddock.Utils.GHC where
-
-
-import Debug.Trace
-import Data.Char
-
-import GHC
-import HsSyn
-import SrcLoc
-import HscTypes
-import Outputable
-import Packages
-import UniqFM
-import Name
-
-
--- names
-
-nameOccString = occNameString . nameOccName 
-
-
-nameSetMod n newMod = 
-  mkExternalName (nameUnique n) newMod (nameOccName n) (nameSrcSpan n)
-
-
-nameSetPkg pkgId n = 
-  mkExternalName (nameUnique n) (mkModule pkgId (moduleName mod)) 
-	               (nameOccName n) (nameSrcSpan n)
-  where mod = nameModule n
-
-
--- modules
-
-
-moduleString :: Module -> String
-moduleString = moduleNameString . moduleName 
-
-
-mkModuleNoPkg :: String -> Module
-mkModuleNoPkg str = mkModule (stringToPackageId "") (mkModuleName str)
-
-
--- misc
-
-
--- there should be a better way to check this using the GHC API
-isConSym n = head (nameOccString n) == ':'
-isVarSym n = fstChar /= '_' && not (isConSym n) && (not . isLetter) fstChar
-  where fstChar = head (nameOccString n)
-
-
-getMainDeclBinder :: HsDecl name -> Maybe name
-getMainDeclBinder (TyClD d) = Just (tcdName d)
-getMainDeclBinder (ValD d)
-   = case collectAcc d [] of
-        []       -> Nothing 
-        (name:_) -> Just (unLoc name)
-getMainDeclBinder (SigD d) = sigNameNoLoc d
-getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name)
-getMainDeclBinder (ForD (ForeignExport name _ _)) = Nothing
-getMainDeclBinder _ = Nothing
-
-
--- To keep if if minf_iface is re-introduced
---modInfoName = moduleName . mi_module . minf_iface
---modInfoMod  = mi_module . minf_iface 
-
-
-trace_ppr x y = trace (showSDoc (ppr x)) y
-- 
cgit v1.2.3