Move sources under haddock-api/src

27 files changed, 9267 insertions, 0 deletions

diff --git a/haddock-api/src/Haddock/Backends/HaddockDB.hs b/haddock-api/src/Haddock/Backends/HaddockDB.hs
new file mode 100644
index 00000000..1c248bfb
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/HaddockDB.hs
@@ -0,0 +1,170 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.HaddockDB
+-- Copyright   :  (c) Simon Marlow 2003
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.HaddockDB (ppDocBook) where
+
+{-
+import HaddockTypes
+import HaddockUtil
+import HsSyn2
+
+import Text.PrettyPrint
+-}
+
+-----------------------------------------------------------------------------
+-- Printing the results in DocBook format
+
+ppDocBook :: a
+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/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
new file mode 100644
index 00000000..628e1cd0
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -0,0 +1,331 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Hoogle
+-- Copyright   :  (c) Neil Mitchell 2006-2008
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Write out Hoogle compatible documentation
+-- http://www.haskell.org/hoogle/
+-----------------------------------------------------------------------------
+module Haddock.Backends.Hoogle (
+    ppHoogle
+  ) where
+
+
+import Haddock.GhcUtils
+import Haddock.Types
+import Haddock.Utils hiding (out)
+import GHC
+import Outputable
+
+import Data.Char
+import Data.List
+import Data.Maybe
+import System.FilePath
+import System.IO
+
+prefix :: [String]
+prefix = ["-- Hoogle documentation, generated by Haddock"
+         ,"-- See Hoogle, http://www.haskell.org/hoogle/"
+         ,""]
+
+
+ppHoogle :: DynFlags -> String -> String -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()
+ppHoogle dflags package version synopsis prologue ifaces odir = do
+    let filename = package ++ ".txt"
+        contents = prefix ++
+                   docWith dflags (drop 2 $ dropWhile (/= ':') synopsis) prologue ++
+                   ["@package " ++ package] ++
+                   ["@version " ++ version | version /= ""] ++
+                   concat [ppModule dflags i | i <- ifaces, OptHide `notElem` ifaceOptions i]
+    h <- openFile (odir </> filename) WriteMode
+    hSetEncoding h utf8
+    hPutStr h (unlines contents)
+    hClose h
+
+ppModule :: DynFlags -> Interface -> [String]
+ppModule dflags iface =
+  "" : ppDocumentation dflags (ifaceDoc iface) ++
+  ["module " ++ moduleString (ifaceMod iface)] ++
+  concatMap (ppExport dflags) (ifaceExportItems iface) ++
+  concatMap (ppInstance dflags) (ifaceInstances iface)
+
+
+---------------------------------------------------------------------
+-- Utility functions
+
+dropHsDocTy :: HsType a -> HsType a
+dropHsDocTy = f
+    where
+        g (L src x) = L src (f x)
+        f (HsForAllTy a b c d) = HsForAllTy a b c (g d)
+        f (HsBangTy a b) = HsBangTy a (g b)
+        f (HsAppTy a b) = HsAppTy (g a) (g b)
+        f (HsFunTy a b) = HsFunTy (g a) (g b)
+        f (HsListTy a) = HsListTy (g a)
+        f (HsPArrTy a) = HsPArrTy (g a)
+        f (HsTupleTy a b) = HsTupleTy a (map g b)
+        f (HsOpTy a b c) = HsOpTy (g a) b (g c)
+        f (HsParTy a) = HsParTy (g a)
+        f (HsKindSig a b) = HsKindSig (g a) b
+        f (HsDocTy a _) = f $ unL a
+        f x = x
+
+outHsType :: OutputableBndr a => DynFlags -> HsType a -> String
+outHsType dflags = out dflags . dropHsDocTy
+
+
+makeExplicit :: HsType a -> HsType a
+makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c
+makeExplicit x = x
+
+makeExplicitL :: LHsType a -> LHsType a
+makeExplicitL (L src x) = L src (makeExplicit x)
+
+
+dropComment :: String -> String
+dropComment (' ':'-':'-':' ':_) = []
+dropComment (x:xs) = x : dropComment xs
+dropComment [] = []
+
+
+out :: Outputable a => DynFlags -> a -> String
+out dflags = f . unwords . map (dropWhile isSpace) . lines . showSDocUnqual dflags . ppr
+    where
+        f xs | " <document comment>" `isPrefixOf` xs = f $ drop 19 xs
+        f (x:xs) = x : f xs
+        f [] = []
+
+
+operator :: String -> String
+operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")"
+operator x = x
+
+
+---------------------------------------------------------------------
+-- How to print each export
+
+ppExport :: DynFlags -> ExportItem Name -> [String]
+ppExport dflags ExportDecl { expItemDecl    = L _ decl
+                           , expItemMbDoc   = (dc, _)
+                           , expItemSubDocs = subdocs
+                           } = ppDocumentation dflags dc ++ f decl
+    where
+        f (TyClD d@DataDecl{})  = ppData dflags d subdocs
+        f (TyClD d@SynDecl{})   = ppSynonym dflags d
+        f (TyClD d@ClassDecl{}) = ppClass dflags d
+        f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
+        f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
+        f (SigD sig) = ppSig dflags sig
+        f _ = []
+ppExport _ _ = []
+
+
+ppSig :: DynFlags -> Sig Name -> [String]
+ppSig dflags (TypeSig names sig)
+    = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
+    where
+        prettyNames = intercalate ", " $ map (out dflags) names
+        typ = case unL sig of
+                   HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
+                   x -> x
+ppSig _ _ = []
+
+
+-- note: does not yet output documentation for class methods
+ppClass :: DynFlags -> TyClDecl Name -> [String]
+ppClass dflags x = out dflags x{tcdSigs=[]} :
+            concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
+    where
+        addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
+        addContext (MinimalSig sig) = MinimalSig sig
+        addContext _ = error "expected TypeSig"
+
+        f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
+        f t = HsForAllTy Implicit emptyHsQTvs (reL [context]) (reL t)
+
+        context = nlHsTyConApp (tcdName x)
+            (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
+
+
+ppInstance :: DynFlags -> ClsInst -> [String]
+ppInstance dflags x = [dropComment $ out dflags x]
+
+
+ppSynonym :: DynFlags -> TyClDecl Name -> [String]
+ppSynonym dflags x = [out dflags x]
+
+ppData :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
+ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
+    = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=Nothing }} :
+      concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
+    where
+
+        -- GHC gives out "data Bar =", we want to delete the equals
+        -- also writes data : a b, when we want data (:) a b
+        showData d = unwords $ map f $ if last xs == "=" then init xs else xs
+            where
+                xs = words $ out dflags d
+                nam = out dflags $ tyClDeclLName d
+                f w = if w == nam then operator nam else w
+ppData _ _ _ = panic "ppData"
+
+-- | for constructors, and named-fields...
+lookupCon :: DynFlags -> [(Name, DocForDecl Name)] -> Located Name -> [String]
+lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
+  Just (d, _) -> ppDocumentation dflags d
+  _ -> []
+
+ppCtor :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String]
+ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)
+                         ++ f (con_details con)
+    where
+        f (PrefixCon args) = [typeSig name $ args ++ [resType]]
+        f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
+        f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat
+                          [lookupCon dflags subdocs (cd_fld_name r) ++
+                           [out dflags (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
+                          | r <- recs]
+
+        funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y))
+        apps = foldl1 (\x y -> reL $ HsAppTy x y)
+
+        typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (makeExplicit $ unL $ funs flds)
+        name = out dflags $ unL $ con_name con
+
+        resType = case con_res con of
+            ResTyH98 -> apps $ map (reL . HsTyVar) $
+                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
+            ResTyGADT x -> x
+
+
+---------------------------------------------------------------------
+-- DOCUMENTATION
+
+ppDocumentation :: Outputable o => DynFlags -> Documentation o -> [String]
+ppDocumentation dflags (Documentation d w) = doc dflags d ++ doc dflags w
+
+
+doc :: Outputable o => DynFlags -> Maybe (Doc o) -> [String]
+doc dflags = docWith dflags ""
+
+
+docWith :: Outputable o => DynFlags -> String -> Maybe (Doc o) -> [String]
+docWith _ [] Nothing = []
+docWith dflags header d
+  = ("":) $ zipWith (++) ("-- | " : repeat "--   ") $
+    [header | header /= ""] ++ ["" | header /= "" && isJust d] ++
+    maybe [] (showTags . markup (markupTag dflags)) d
+
+
+data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String
+           deriving Show
+
+type Tags = [Tag]
+
+box :: (a -> b) -> a -> [b]
+box f x = [f x]
+
+str :: String -> [Tag]
+str a = [Str a]
+
+-- want things like paragraph, pre etc to be handled by blank lines in the source document
+-- and things like \n and \t converted away
+-- much like blogger in HTML mode
+-- everything else wants to be included as tags, neatly nested for some (ul,li,ol)
+-- or inlne for others (a,i,tt)
+-- entities (&,>,<) should always be appropriately escaped
+
+markupTag :: Outputable o => DynFlags -> DocMarkup o [Tag]
+markupTag dflags = Markup {
+  markupParagraph            = box TagP,
+  markupEmpty                = str "",
+  markupString               = str,
+  markupAppend               = (++),
+  markupIdentifier           = box (TagInline "a") . str . out dflags,
+  markupIdentifierUnchecked  = box (TagInline "a") . str . out dflags . snd,
+  markupModule               = box (TagInline "a") . str,
+  markupWarning              = box (TagInline "i"),
+  markupEmphasis             = box (TagInline "i"),
+  markupBold                 = box (TagInline "b"),
+  markupMonospaced           = box (TagInline "tt"),
+  markupPic                  = const $ str " ",
+  markupUnorderedList        = box (TagL 'u'),
+  markupOrderedList          = box (TagL 'o'),
+  markupDefList              = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
+  markupCodeBlock            = box TagPre,
+  markupHyperlink            = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
+  markupAName                = const $ str "",
+  markupProperty             = box TagPre . str,
+  markupExample              = box TagPre . str . unlines . map exampleToString,
+  markupHeader               = \(Header l h) -> box (TagInline $ "h" ++ show l) h
+  }
+
+
+showTags :: [Tag] -> [String]
+showTags = intercalate [""] . map showBlock
+
+
+showBlock :: Tag -> [String]
+showBlock (TagP xs) = showInline xs
+showBlock (TagL t xs) = ['<':t:"l>"] ++ mid ++ ['<':'/':t:"l>"]
+    where mid = concatMap (showInline . box (TagInline "li")) xs
+showBlock (TagPre xs) = ["<pre>"] ++ showPre xs ++ ["</pre>"]
+showBlock x = showInline [x]
+
+
+asInline :: Tag -> Tags
+asInline (TagP xs) = xs
+asInline (TagPre xs) = [TagInline "pre" xs]
+asInline (TagL t xs) = [TagInline (t:"l") $ map (TagInline "li") xs]
+asInline x = [x]
+
+
+showInline :: [Tag] -> [String]
+showInline = unwordsWrap 70 . words . concatMap f
+    where
+        fs = concatMap f
+        f (Str x) = escape x
+        f (TagInline s xs) = "<"++s++">" ++ (if s == "li" then trim else id) (fs xs) ++ "</"++s++">"
+        f x = fs $ asInline x
+
+        trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+
+
+showPre :: [Tag] -> [String]
+showPre = trimFront . trimLines . lines . concatMap f
+    where
+        trimLines = dropWhile null . reverse . dropWhile null . reverse
+        trimFront xs = map (drop i) xs
+            where
+                ns = [length a | x <- xs, let (a,b) = span isSpace x, b /= ""]
+                i = if null ns then 0 else minimum ns
+
+        fs = concatMap f
+        f (Str x) = escape x
+        f (TagInline s xs) = "<"++s++">" ++ fs xs ++ "</"++s++">"
+        f x = fs $ asInline x
+
+
+unwordsWrap :: Int -> [String] -> [String]
+unwordsWrap n = f n []
+    where
+        f _ s [] = [g s | s /= []]
+        f i s (x:xs) | nx > i = g s : f (n - nx - 1) [x] xs
+                     | otherwise = f (i - nx - 1) (x:s) xs
+            where nx = length x
+
+        g = unwords . reverse
+
+
+escape :: String -> String
+escape = concatMap f
+    where
+        f '<' = "&lt;"
+        f '>' = "&gt;"
+        f '&' = "&amp;"
+        f x = [x]
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
new file mode 100644
index 00000000..7b72c030
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -0,0 +1,1221 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.LaTeX
+-- Copyright   :  (c) Simon Marlow      2010,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.LaTeX (
+  ppLaTeX
+) where
+
+
+import Haddock.Types
+import Haddock.Utils
+import Haddock.GhcUtils
+import Pretty hiding (Doc, quote)
+import qualified Pretty
+
+import GHC
+import OccName
+import Name                 ( nameOccName )
+import RdrName              ( rdrNameOcc )
+import FastString           ( unpackFS, unpackLitString, zString )
+
+import qualified Data.Map as Map
+import System.Directory
+import System.FilePath
+import Data.Char
+import Control.Monad
+import Data.Maybe
+import Data.List
+
+import Haddock.Doc (combineDocumentation)
+
+-- import Debug.Trace
+
+{- SAMPLE OUTPUT
+
+\haddockmoduleheading{\texttt{Data.List}}
+\hrulefill
+{\haddockverb\begin{verbatim}
+module Data.List (
+    (++),  head,  last,  tail,  init,  null,  length,  map,  reverse,
+  ) where\end{verbatim}}
+\hrulefill
+
+\section{Basic functions}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+head\ ::\ {\char 91}a{\char 93}\ ->\ a
+\end{tabular}]\haddockbegindoc
+Extract the first element of a list, which must be non-empty.
+\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+last\ ::\ {\char 91}a{\char 93}\ ->\ a
+\end{tabular}]\haddockbegindoc
+Extract the last element of a list, which must be finite and non-empty.
+\par
+
+\end{haddockdesc}
+-}
+
+
+{- TODO
+ * don't forget fixity!!
+-}
+
+ppLaTeX :: String                       -- Title
+        -> Maybe String                 -- Package name
+        -> [Interface]
+        -> FilePath                     -- destination directory
+        -> Maybe (Doc GHC.RdrName)      -- prologue text, maybe
+        -> Maybe String                 -- style file
+        -> FilePath
+        -> IO ()
+
+ppLaTeX title packageStr visible_ifaces odir prologue maybe_style libdir
+ = do
+   createDirectoryIfMissing True odir
+   when (isNothing maybe_style) $
+     copyFile (libdir </> "latex" </> haddockSty) (odir </> haddockSty)
+   ppLaTeXTop title packageStr odir prologue maybe_style visible_ifaces
+   mapM_ (ppLaTeXModule title odir) visible_ifaces
+
+
+haddockSty :: FilePath
+haddockSty = "haddock.sty"
+
+
+type LaTeX = Pretty.Doc
+
+
+ppLaTeXTop
+   :: String
+   -> Maybe String
+   -> FilePath
+   -> Maybe (Doc GHC.RdrName)
+   -> Maybe String
+   -> [Interface]
+   -> IO ()
+
+ppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do
+
+  let tex = vcat [
+        text "\\documentclass{book}",
+        text "\\usepackage" <> braces (maybe (text "haddock") text maybe_style),
+        text "\\begin{document}",
+        text "\\begin{titlepage}",
+        text "\\begin{haddocktitle}",
+        text doctitle,
+        text "\\end{haddocktitle}",
+        case prologue of
+           Nothing -> empty
+           Just d  -> vcat [text "\\begin{haddockprologue}",
+                            rdrDocToLaTeX d,
+                            text "\\end{haddockprologue}"],
+        text "\\end{titlepage}",
+        text "\\tableofcontents",
+        vcat [ text "\\input" <> braces (text mdl) | mdl <- mods ],
+        text "\\end{document}"
+        ]
+
+      mods = sort (map (moduleBasename.ifaceMod) ifaces)
+
+      filename = odir </> (fromMaybe "haddock" packageStr <.> "tex")
+
+  writeFile filename (show tex)
+
+
+ppLaTeXModule :: String -> FilePath -> Interface -> IO ()
+ppLaTeXModule _title odir iface = do
+  createDirectoryIfMissing True odir
+  let
+      mdl = ifaceMod iface
+      mdl_str = moduleString mdl
+
+      exports = ifaceRnExportItems iface
+
+      tex = vcat [
+        text "\\haddockmoduleheading" <> braces (text mdl_str),
+        text "\\label{module:" <> text mdl_str <> char '}',
+        text "\\haddockbeginheader",
+        verb $ vcat [
+           text "module" <+> text mdl_str <+> lparen,
+           text "    " <> fsep (punctuate (text ", ") $
+                               map exportListItem $
+                               filter forSummary exports),
+           text "  ) where"
+         ],
+        text "\\haddockendheader" $$ text "",
+        description,
+        body
+       ]
+
+      description
+          = (fromMaybe empty . documentationToLaTeX . ifaceRnDoc) iface
+
+      body = processExports exports
+  --
+  writeFile (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 string_txt "" tex)
+
+
+string_txt :: TextDetails -> String -> String
+string_txt (Chr c)   s  = c:s
+string_txt (Str s1)  s2 = s1 ++ s2
+string_txt (PStr s1) s2 = unpackFS s1 ++ s2
+string_txt (ZStr s1) s2 = zString s1 ++ s2
+string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
+
+
+exportListItem :: ExportItem DocName -> LaTeX
+exportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs }
+  = sep (punctuate comma . map ppDocBinder $ declNames decl) <>
+     case subdocs of
+       [] -> empty
+       _  -> parens (sep (punctuate comma (map (ppDocBinder . fst) subdocs)))
+exportListItem (ExportNoDecl y [])
+  = ppDocBinder y
+exportListItem (ExportNoDecl y subs)
+  = ppDocBinder y <> parens (sep (punctuate comma (map ppDocBinder subs)))
+exportListItem (ExportModule mdl)
+  = text "module" <+> text (moduleString mdl)
+exportListItem _
+  = error "exportListItem"
+
+
+-- Deal with a group of undocumented exports together, to avoid lots
+-- of blank vertical space between them.
+processExports :: [ExportItem DocName] -> LaTeX
+processExports [] = empty
+processExports (decl : es)
+  | Just sig <- isSimpleSig decl
+  = multiDecl [ ppTypeSig (map getName names) typ False
+              | (names,typ) <- sig:sigs ] $$
+    processExports es'
+  where (sigs, es') = spanWith isSimpleSig es
+processExports (ExportModule mdl : es)
+  = declWithDoc (vcat [ text "module" <+> text (moduleString m) | m <- mdl:mdls ]) Nothing $$
+    processExports es'
+  where (mdls, es') = spanWith isExportModule es
+processExports (e : es) =
+  processExport e $$ processExports es
+
+
+isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t)))
+                       , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
+  | Map.null argDocs = Just (map unLoc lnames, t)
+isSimpleSig _ = Nothing
+
+
+isExportModule :: ExportItem DocName -> Maybe Module
+isExportModule (ExportModule m) = Just m
+isExportModule _ = Nothing
+
+
+processExport :: ExportItem DocName -> LaTeX
+processExport (ExportGroup lev _id0 doc)
+  = ppDocGroup lev (docToLaTeX doc)
+processExport (ExportDecl decl doc subdocs insts fixities _splice)
+  = ppDecl decl doc insts subdocs fixities
+processExport (ExportNoDecl y [])
+  = ppDocName y
+processExport (ExportNoDecl y subs)
+  = ppDocName y <> parens (sep (punctuate comma (map ppDocName subs)))
+processExport (ExportModule mdl)
+  = declWithDoc (text "module" <+> text (moduleString mdl)) Nothing
+processExport (ExportDoc doc)
+  = docToLaTeX doc
+
+
+ppDocGroup :: Int -> LaTeX -> LaTeX
+ppDocGroup lev doc = sec lev <> braces doc
+  where sec 1 = text "\\section"
+        sec 2 = text "\\subsection"
+        sec 3 = text "\\subsubsection"
+        sec _ = text "\\paragraph"
+
+
+declNames :: LHsDecl DocName -> [DocName]
+declNames (L _ decl) = case decl of
+  TyClD d  -> [tcdName d]
+  SigD (TypeSig lnames _) -> map unLoc lnames
+  SigD (PatSynSig lname _ _ _ _) -> [unLoc lname]
+  ForD (ForeignImport (L _ n) _ _ _) -> [n]
+  ForD (ForeignExport (L _ n) _ _ _) -> [n]
+  _ -> error "declaration not supported by declNames"
+
+
+forSummary :: (ExportItem DocName) -> Bool
+forSummary (ExportGroup _ _ _) = False
+forSummary (ExportDoc _)       = False
+forSummary _                    = True
+
+
+moduleLaTeXFile :: Module -> FilePath
+moduleLaTeXFile mdl = moduleBasename mdl ++ ".tex"
+
+
+moduleBasename :: Module -> FilePath
+moduleBasename mdl = map (\c -> if c == '.' then '-' else c)
+                         (moduleNameString (moduleName mdl))
+
+
+-------------------------------------------------------------------------------
+-- * Decls
+-------------------------------------------------------------------------------
+
+
+ppDecl :: LHsDecl DocName
+       -> DocForDecl DocName
+       -> [DocInstance DocName]
+       -> [(DocName, DocForDecl DocName)]
+       -> [(DocName, Fixity)]
+       -> LaTeX
+
+ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
+  TyClD d@(FamDecl {})          -> ppTyFam False loc doc d unicode
+  TyClD d@(DataDecl {})
+                                -> ppDataDecl instances subdocs loc (Just doc) d unicode
+  TyClD d@(SynDecl {})          -> ppTySyn loc (doc, fnArgsDoc) d unicode
+-- Family instances happen via FamInst now
+--  TyClD d@(TySynonym {})
+--    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
+-- Family instances happen via FamInst now
+  TyClD d@(ClassDecl {})         -> ppClassDecl instances loc doc subdocs d unicode
+  SigD (TypeSig lnames (L _ t))  -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode
+  SigD (PatSynSig lname args ty prov req) ->
+      ppLPatSig loc (doc, fnArgsDoc) lname args ty prov req unicode
+  ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
+  InstD _                        -> empty
+  _                              -> error "declaration not supported by ppDecl"
+  where
+    unicode = False
+
+
+ppTyFam :: Bool -> SrcSpan -> Documentation DocName ->
+              TyClDecl DocName -> Bool -> LaTeX
+ppTyFam _ _ _ _ _ =
+  error "type family declarations are currently not supported by --latex"
+
+
+ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX
+ppFor loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode =
+  ppFunSig loc doc [name] typ unicode
+ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
+--  error "foreign declarations are currently not supported by --latex"
+
+
+-------------------------------------------------------------------------------
+-- * Type Synonyms
+-------------------------------------------------------------------------------
+
+
+-- we skip type patterns for now
+ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX
+
+ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                         , tcdRhs = ltype }) unicode
+  = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
+  where
+    hdr  = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars)
+    full = hdr <+> char '=' <+> ppLType unicode ltype
+
+ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
+
+
+-------------------------------------------------------------------------------
+-- * Function signatures
+-------------------------------------------------------------------------------
+
+
+ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> HsType DocName
+         -> Bool -> LaTeX
+ppFunSig loc doc docnames typ unicode =
+  ppTypeOrFunSig loc docnames typ doc
+    ( ppTypeSig names typ False
+    , hsep . punctuate comma $ map ppSymName names
+    , dcolon unicode)
+    unicode
+ where
+   names = map getName docnames
+
+ppLPatSig :: SrcSpan -> DocForDecl DocName -> Located DocName
+          -> HsPatSynDetails (LHsType DocName) -> LHsType DocName
+          -> LHsContext DocName -> LHsContext DocName
+          -> Bool -> LaTeX
+ppLPatSig loc doc docname args typ prov req unicode =
+    ppPatSig loc doc (unLoc docname) (fmap unLoc args) (unLoc typ) (unLoc prov) (unLoc req) unicode
+
+ppPatSig :: SrcSpan -> DocForDecl DocName -> DocName
+          -> HsPatSynDetails (HsType DocName) -> HsType DocName
+          -> HsContext DocName -> HsContext DocName
+          -> Bool -> LaTeX
+ppPatSig _loc (doc, _argDocs) docname args typ prov req unicode = declWithDoc pref1 (documentationToLaTeX doc)
+  where
+    pref1 = hsep [ keyword "pattern"
+                 , pp_ctx prov
+                 , pp_head
+                 , dcolon unicode
+                 , pp_ctx req
+                 , ppType unicode typ
+                 ]
+
+    pp_head = case args of
+        PrefixPatSyn typs -> hsep $ ppDocBinder docname : map pp_type typs
+        InfixPatSyn left right -> hsep [pp_type left, ppDocBinderInfix docname, pp_type right]
+
+    pp_type = ppParendType unicode
+    pp_ctx ctx = ppContext ctx unicode
+
+ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
+               -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)
+               -> Bool -> LaTeX
+ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
+               unicode
+  | Map.null argDocs =
+      declWithDoc pref1 (documentationToLaTeX doc)
+  | otherwise        =
+      declWithDoc pref2 $ Just $
+        text "\\haddockbeginargs" $$
+        do_args 0 sep0 typ $$
+        text "\\end{tabulary}\\par" $$
+        fromMaybe empty (documentationToLaTeX doc)
+  where
+     do_largs n leader (L _ t) = do_args n leader t
+
+     arg_doc n = rDoc (Map.lookup n argDocs)
+
+     do_args :: Int -> LaTeX -> (HsType DocName) -> LaTeX
+     do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
+       = decltt leader <->
+             decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
+                ppLContextNoArrow lctxt unicode) <+> nl $$
+         do_largs n (darrow unicode) ltype
+
+     do_args n leader (HsForAllTy Implicit _ lctxt ltype)
+       | not (null (unLoc lctxt))
+       = decltt leader <-> decltt (ppLContextNoArrow lctxt unicode) <+> nl $$
+         do_largs n (darrow unicode) ltype
+         -- if we're not showing any 'forall' or class constraints or
+         -- anything, skip having an empty line for the context.
+       | otherwise
+       = do_largs n leader ltype
+     do_args n leader (HsFunTy lt r)
+       = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$
+         do_largs (n+1) (arrow unicode) r
+     do_args n leader t
+       = decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl
+
+
+ppTypeSig :: [Name] -> HsType DocName  -> Bool -> LaTeX
+ppTypeSig nms ty unicode =
+  hsep (punctuate comma $ map ppSymName nms)
+    <+> dcolon unicode
+    <+> ppType unicode ty
+
+
+ppTyVars :: LHsTyVarBndrs DocName -> [LaTeX]
+ppTyVars tvs = map ppSymName (tyvarNames tvs)
+
+
+tyvarNames :: LHsTyVarBndrs DocName -> [Name]
+tyvarNames = map getName . hsLTyVarNames
+
+
+declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
+declWithDoc decl doc =
+   text "\\begin{haddockdesc}" $$
+   text "\\item[\\begin{tabular}{@{}l}" $$
+   text (latexMonoFilter (show decl)) $$
+   text "\\end{tabular}]" <>
+       (if isNothing doc then empty else text "\\haddockbegindoc") $$
+   maybe empty id doc $$
+   text "\\end{haddockdesc}"
+
+
+-- in a group of decls, we don't put them all in the same tabular,
+-- because that would prevent the group being broken over a page
+-- boundary (breaks Foreign.C.Error for example).
+multiDecl :: [LaTeX] -> LaTeX
+multiDecl decls =
+   text "\\begin{haddockdesc}" $$
+   vcat [
+      text "\\item[" $$
+      text (latexMonoFilter (show decl)) $$
+      text "]"
+      | decl <- decls ] $$
+   text "\\end{haddockdesc}"
+
+
+-------------------------------------------------------------------------------
+-- * Rendering Doc
+-------------------------------------------------------------------------------
+
+
+maybeDoc :: Maybe (Doc DocName) -> LaTeX
+maybeDoc = maybe empty docToLaTeX
+
+
+-- for table cells, we strip paragraphs out to avoid extra vertical space
+-- and don't add a quote environment.
+rDoc  :: Maybe (Doc DocName) -> LaTeX
+rDoc = maybeDoc . fmap latexStripTrailingWhitespace
+
+
+-------------------------------------------------------------------------------
+-- * Class declarations
+-------------------------------------------------------------------------------
+
+
+ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
+           -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+           -> Bool -> LaTeX
+ppClassHdr summ lctxt n tvs fds unicode =
+  keyword "class"
+  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else empty)
+  <+> ppAppDocNameNames summ n (tyvarNames $ tvs)
+  <+> ppFds fds unicode
+
+
+ppFds :: [Located ([DocName], [DocName])] -> Bool -> LaTeX
+ppFds fds unicode =
+  if null fds then empty else
+    char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
+  where
+    fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> arrow unicode <+>
+                           hsep (map ppDocName vars2)
+
+
+ppClassDecl :: [DocInstance DocName] -> SrcSpan
+            -> Documentation DocName -> [(DocName, DocForDecl DocName)]
+            -> TyClDecl DocName -> Bool -> LaTeX
+ppClassDecl instances loc doc subdocs
+  (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars, tcdFDs = lfds
+             , tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs }) unicode
+  = declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$
+    instancesBit
+  where
+    classheader
+      | null lsigs = hdr unicode
+      | otherwise  = hdr unicode <+> keyword "where"
+
+    hdr = ppClassHdr False lctxt (unLoc lname) ltyvars lfds
+
+    body = catMaybes [documentationToLaTeX doc, body_]
+
+    body_
+      | null lsigs, null ats, null at_defs = Nothing
+      | null ats, null at_defs = Just methodTable
+---     | otherwise = atTable $$ methodTable
+      | otherwise = error "LaTeX.ppClassDecl"
+
+    methodTable =
+      text "\\haddockpremethods{}\\textbf{Methods}" $$
+      vcat  [ ppFunSig loc doc names typ unicode
+            | L _ (TypeSig lnames (L _ typ)) <- lsigs
+            , let doc = lookupAnySubdoc (head names) subdocs
+                  names = map unLoc lnames ]
+              -- FIXME: is taking just the first name ok? Is it possible that
+              -- there are different subdocs for different names in a single
+              -- type signature?
+
+    instancesBit = ppDocInstances unicode instances
+
+ppClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+
+ppDocInstances :: Bool -> [DocInstance DocName] -> LaTeX
+ppDocInstances _unicode [] = empty
+ppDocInstances unicode (i : rest)
+  | Just ihead <- isUndocdInstance i
+  = declWithDoc (vcat (map (ppInstDecl unicode) (ihead:is))) Nothing $$
+    ppDocInstances unicode rest'
+  | otherwise
+  = ppDocInstance unicode i $$ ppDocInstances unicode rest
+  where
+    (is, rest') = spanWith isUndocdInstance rest
+
+isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
+isUndocdInstance (i,Nothing) = Just i
+isUndocdInstance _ = Nothing
+
+-- | Print a possibly commented instance. The instance header is printed inside
+-- an 'argBox'. The comment is printed to the right of the box in normal comment
+-- style.
+ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
+ppDocInstance unicode (instHead, doc) =
+  declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX doc)
+
+
+ppInstDecl :: Bool -> InstHead DocName -> LaTeX
+ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
+
+
+ppInstHead :: Bool -> InstHead DocName -> LaTeX
+ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
+ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
+  <+> ppAppNameTypes n ks ts unicode
+  <+> maybe empty (\t -> equals <+> ppType unicode t) rhs
+ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
+  error "data instances not supported by --latex yet"
+
+lookupAnySubdoc :: (Eq name1) =>
+                   name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
+lookupAnySubdoc n subdocs = case lookup n subdocs of
+  Nothing -> noDocForDecl
+  Just docs -> docs
+
+
+-------------------------------------------------------------------------------
+-- * Data & newtype declarations
+-------------------------------------------------------------------------------
+
+
+ppDataDecl :: [DocInstance DocName] ->
+              [(DocName, DocForDecl DocName)] -> SrcSpan ->
+              Maybe (Documentation DocName) -> TyClDecl DocName -> Bool ->
+              LaTeX
+ppDataDecl instances subdocs _loc doc dataDecl unicode
+
+   =  declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
+                  (if null body then Nothing else Just (vcat body))
+   $$ instancesBit
+
+  where
+    cons      = dd_cons (tcdDataDefn dataDecl)
+    resTy     = (con_res . unLoc . head) cons
+
+    body = catMaybes [constrBit, doc >>= documentationToLaTeX]
+
+    (whereBit, leaders)
+      | null cons = (empty,[])
+      | otherwise = case resTy of
+        ResTyGADT _ -> (decltt (keyword "where"), repeat empty)
+        _           -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
+
+    constrBit
+      | null cons = Nothing
+      | otherwise = Just $
+          text "\\haddockbeginconstrs" $$
+          vcat (zipWith (ppSideBySideConstr subdocs unicode) leaders cons) $$
+          text "\\end{tabulary}\\par"
+
+    instancesBit = ppDocInstances unicode instances
+
+
+-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
+ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> LaTeX
+ppConstrHdr forall tvs ctxt unicode
+ = (if null tvs then empty else ppForall)
+   <+>
+   (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
+  where
+    ppForall = case forall of
+      Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
+      Implicit -> empty
+
+
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
+                   -> LConDecl DocName -> LaTeX
+ppSideBySideConstr subdocs unicode leader (L _ con) =
+  leader <->
+  case con_res con of
+  ResTyH98 -> case con_details con of
+
+    PrefixCon args ->
+      decltt (hsep ((header_ unicode <+> ppBinder occ) :
+                 map (ppLParendType unicode) args))
+      <-> rDoc mbDoc <+> nl
+
+    RecCon fields ->
+      (decltt (header_ unicode <+> ppBinder occ)
+        <-> rDoc mbDoc <+> nl)
+      $$
+      doRecordFields fields
+
+    InfixCon arg1 arg2 ->
+      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
+                 ppBinder occ,
+                 ppLParendType unicode arg2 ])
+      <-> rDoc mbDoc <+> nl
+
+  ResTyGADT resTy -> case con_details con of
+    -- prefix & infix could also use hsConDeclArgTys if it seemed to
+    -- simplify the code.
+    PrefixCon args -> doGADTCon args resTy
+    cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
+                                     doRecordFields fields
+    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
+
+ where
+    doRecordFields fields =
+        vcat (map (ppSideBySideField subdocs unicode) fields)
+
+    doGADTCon args resTy = decltt (ppBinder occ <+> dcolon unicode <+> hsep [
+                               ppForAll forall ltvs (con_cxt con) unicode,
+                               ppLType unicode (foldr mkFunTy resTy args) ]
+                            ) <-> rDoc mbDoc
+
+
+    header_ = ppConstrHdr forall tyVars context
+    occ     = nameOccName . getName . unLoc . con_name $ con
+    ltvs    = con_qvars con
+    tyVars  = tyvarNames (con_qvars con)
+    context = unLoc (con_cxt con)
+    forall  = con_explicit con
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst
+    mkFunTy a b = noLoc (HsFunTy a b)
+
+
+ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  LaTeX
+ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
+  decltt (ppBinder (nameOccName . getName $ name)
+    <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
+  where
+    -- don't use cd_fld_doc for same reason we don't use con_doc above
+    mbDoc = lookup name subdocs >>= combineDocumentation . fst
+
+-- {-
+-- ppHsFullConstr :: HsConDecl -> LaTeX
+-- 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 (docToLaTeX (fromJust doc))
+-- 	  | otherwise  = LaTeX.emptyTable
+--
+-- 	fields_html =
+-- 	   td <<
+-- 	      table ! [width "100%", cellpadding 0, cellspacing 8] << (
+-- 		   aboves (map ppFullField (concat (map expandField fields)))
+-- 		)
+-- -}
+--
+-- ppShortField :: Bool -> Bool -> ConDeclField DocName -> LaTeX
+-- ppShortField summary unicode (ConDeclField (L _ name) ltype _)
+--   = tda [theclass "recfield"] << (
+--       ppBinder summary (docNameOcc name)
+--       <+> dcolon unicode <+> ppLType unicode ltype
+--     )
+--
+-- {-
+-- ppFullField :: HsFieldDecl -> LaTeX
+-- 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 :: TyClDecl DocName -> Bool -> LaTeX
+ppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars
+                       , tcdDataDefn = HsDataDefn { dd_ND = nd, dd_ctxt = ctxt } }) unicode
+  = -- newtype or data
+    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
+    -- context
+    ppLContext ctxt unicode <+>
+    -- T a b c ..., or a :+: b
+    ppAppDocNameNames False name (tyvarNames tyvars)
+ppDataHeader _ _ = error "ppDataHeader: illegal argument"
+
+--------------------------------------------------------------------------------
+-- * Type applications
+--------------------------------------------------------------------------------
+
+
+-- | Print an application of a DocName and two lists of HsTypes (kinds, types)
+ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Bool -> LaTeX
+ppAppNameTypes n ks ts unicode = ppTypeApp n ks ts ppDocName (ppParendType unicode)
+
+
+-- | Print an application of a DocName and a list of Names
+ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX
+ppAppDocNameNames _summ n ns =
+  ppTypeApp n [] ns (ppBinder . nameOccName . getName) ppSymName
+
+
+-- | General printing of type applications
+ppTypeApp :: DocName -> [a] -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
+ppTypeApp n [] (t1:t2:rest) ppDN ppT
+  | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
+  | operator                    = opApp
+  where
+    operator = isNameSym . getName $ n
+    opApp = ppT t1 <+> ppDN n <+> ppT t2
+
+ppTypeApp n ks ts ppDN ppT = ppDN n <+> hsep (map ppT $ ks ++ ts)
+
+
+-------------------------------------------------------------------------------
+-- * Contexts
+-------------------------------------------------------------------------------
+
+
+ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Bool -> LaTeX
+ppLContext        = ppContext        . unLoc
+ppLContextNoArrow = ppContextNoArrow . unLoc
+
+
+ppContextNoArrow :: HsContext DocName -> Bool -> LaTeX
+ppContextNoArrow []  _ = empty
+ppContextNoArrow cxt unicode = pp_hs_context (map unLoc cxt) unicode
+
+
+ppContextNoLocs :: [HsType DocName] -> Bool -> LaTeX
+ppContextNoLocs []  _ = empty
+ppContextNoLocs cxt unicode = pp_hs_context cxt unicode <+> darrow unicode
+
+
+ppContext :: HsContext DocName -> Bool -> LaTeX
+ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
+
+
+pp_hs_context :: [HsType DocName] -> Bool -> LaTeX
+pp_hs_context []  _       = empty
+pp_hs_context [p] unicode = ppType unicode p
+pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
+
+
+-------------------------------------------------------------------------------
+-- * Types and contexts
+-------------------------------------------------------------------------------
+
+
+ppBang :: HsBang -> LaTeX
+ppBang HsNoBang = empty
+ppBang _        = char '!' -- Unpacked args is an implementation detail,
+
+
+tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX
+tupleParens HsUnboxedTuple = ubxParenList
+tupleParens _              = parenList
+
+
+-------------------------------------------------------------------------------
+-- * Rendering of HsType
+--
+-- Stolen from Html and tweaked for LaTeX generation
+-------------------------------------------------------------------------------
+
+
+pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
+
+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
+           -> LaTeX -> LaTeX  -- Wrap in parens if (ctxt >= op)
+maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
+                               | otherwise            = p
+
+
+ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocName) -> LaTeX
+ppLType       unicode y = ppType unicode (unLoc y)
+ppLParendType unicode y = ppParendType unicode (unLoc y)
+ppLFunLhType  unicode y = ppFunLhType unicode (unLoc y)
+
+
+ppType, ppParendType, ppFunLhType :: Bool -> HsType DocName -> LaTeX
+ppType       unicode ty = ppr_mono_ty pREC_TOP ty unicode
+ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode
+ppFunLhType  unicode ty = ppr_mono_ty pREC_FUN ty unicode
+
+ppLKind :: Bool -> LHsKind DocName -> LaTeX
+ppLKind unicode y = ppKind unicode (unLoc y)
+
+ppKind :: Bool -> HsKind DocName -> LaTeX
+ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode
+
+
+-- Drop top-level for-all type variables in user style
+-- since they are implicit in Haskell
+
+ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
+         -> Located (HsContext DocName) -> Bool -> LaTeX
+ppForAll expl tvs cxt unicode
+  | show_forall = forall_part <+> ppLContext cxt unicode
+  | otherwise   = ppLContext cxt unicode
+  where
+    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
+    is_explicit = case expl of {Explicit -> True; Implicit -> False}
+    forall_part = hsep (forallSymbol unicode : ppTyVars tvs) <> dot
+
+
+ppr_mono_lty :: Int -> LHsType DocName -> Bool -> LaTeX
+ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
+
+
+ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX
+ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode
+  = maybeParen ctxt_prec pREC_FUN $
+    hsep [ppForAll expl tvs ctxt unicode, ppr_mono_lty pREC_TOP ty unicode]
+
+ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
+ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name
+ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
+ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
+ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
+ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
+ppr_mono_ty _         (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
+ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
+ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty _         (HsWrapTy {})       _ = error "ppr_mono_ty HsWrapTy"
+
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
+  = maybeParen ctxt_prec pREC_OP $
+    ppr_mono_lty pREC_OP ty1 unicode <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode
+
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
+  = maybeParen ctxt_prec pREC_CON $
+    hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
+
+ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode
+  = maybeParen ctxt_prec pREC_FUN $
+    ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
+  where
+    ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
+    occName = nameOccName . getName . unLoc $ op
+
+ppr_mono_ty ctxt_prec (HsParTy ty) unicode
+--  = parens (ppr_mono_lty pREC_TOP ty)
+  = ppr_mono_lty ctxt_prec ty unicode
+
+ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
+  = ppr_mono_lty ctxt_prec ty unicode
+
+ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
+
+
+ppr_tylit :: HsTyLit -> Bool -> LaTeX
+ppr_tylit (HsNumTy n) _ = integer n
+ppr_tylit (HsStrTy s) _ = text (show s)
+  -- XXX: Ok in verbatim, but not otherwise
+  -- XXX: Do something with Unicode parameter?
+
+
+ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Bool -> LaTeX
+ppr_fun_ty ctxt_prec ty1 ty2 unicode
+  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode
+        p2 = ppr_mono_lty pREC_TOP ty2 unicode
+    in
+    maybeParen ctxt_prec pREC_FUN $
+    sep [p1, arrow unicode <+> p2]
+
+
+-------------------------------------------------------------------------------
+-- * Names
+-------------------------------------------------------------------------------
+
+
+ppBinder :: OccName -> LaTeX
+ppBinder n
+  | isInfixName n = parens $ ppOccName n
+  | otherwise     = ppOccName n
+
+ppBinderInfix :: OccName -> LaTeX
+ppBinderInfix n
+  | isInfixName n = ppOccName n
+  | otherwise     = quotes $ ppOccName n
+
+isInfixName :: OccName -> Bool
+isInfixName n = isVarSym n || isConSym n
+
+ppSymName :: Name -> LaTeX
+ppSymName name
+  | isNameSym name = parens $ ppName name
+  | otherwise = ppName name
+
+
+ppVerbOccName :: OccName -> LaTeX
+ppVerbOccName = text . latexFilter . occNameString
+
+ppIPName :: HsIPName -> LaTeX
+ppIPName ip = text $ unpackFS $ hsIPNameFS ip
+
+ppOccName :: OccName -> LaTeX
+ppOccName = text . occNameString
+
+
+ppVerbDocName :: DocName -> LaTeX
+ppVerbDocName = ppVerbOccName . nameOccName . getName
+
+
+ppVerbRdrName :: RdrName -> LaTeX
+ppVerbRdrName = ppVerbOccName . rdrNameOcc
+
+
+ppDocName :: DocName -> LaTeX
+ppDocName = ppOccName . nameOccName . getName
+
+
+ppLDocName :: Located DocName -> LaTeX
+ppLDocName (L _ d) = ppDocName d
+
+
+ppDocBinder :: DocName -> LaTeX
+ppDocBinder = ppBinder . nameOccName . getName
+
+ppDocBinderInfix :: DocName -> LaTeX
+ppDocBinderInfix = ppBinderInfix . nameOccName . getName
+
+
+ppName :: Name -> LaTeX
+ppName = ppOccName . nameOccName
+
+
+latexFilter :: String -> String
+latexFilter = foldr latexMunge ""
+
+
+latexMonoFilter :: String -> String
+latexMonoFilter = foldr latexMonoMunge ""
+
+
+latexMunge :: Char -> String -> String
+latexMunge '#'  s = "{\\char '43}" ++ s
+latexMunge '$'  s = "{\\char '44}" ++ s
+latexMunge '%'  s = "{\\char '45}" ++ s
+latexMunge '&'  s = "{\\char '46}" ++ s
+latexMunge '~'  s = "{\\char '176}" ++ s
+latexMunge '_'  s = "{\\char '137}" ++ s
+latexMunge '^'  s = "{\\char '136}" ++ s
+latexMunge '\\' s = "{\\char '134}" ++ s
+latexMunge '{'  s = "{\\char '173}" ++ s
+latexMunge '}'  s = "{\\char '175}" ++ s
+latexMunge '['  s = "{\\char 91}" ++ s
+latexMunge ']'  s = "{\\char 93}" ++ s
+latexMunge c    s = c : s
+
+
+latexMonoMunge :: Char -> String -> String
+latexMonoMunge ' ' s = '\\' : ' ' : s
+latexMonoMunge '\n' s = '\\' : '\\' : s
+latexMonoMunge c   s = latexMunge c s
+
+
+-------------------------------------------------------------------------------
+-- * Doc Markup
+-------------------------------------------------------------------------------
+
+
+parLatexMarkup :: (a -> LaTeX) -> DocMarkup a (StringContext -> LaTeX)
+parLatexMarkup ppId = Markup {
+  markupParagraph            = \p v -> p v <> text "\\par" $$ text "",
+  markupEmpty                = \_ -> empty,
+  markupString               = \s v -> text (fixString v s),
+  markupAppend               = \l r v -> l v <> r v,
+  markupIdentifier           = markupId ppId,
+  markupIdentifierUnchecked  = markupId (ppVerbOccName . snd),
+  markupModule               = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
+  markupWarning              = \p v -> emph (p v),
+  markupEmphasis             = \p v -> emph (p v),
+  markupBold                 = \p v -> bold (p v),
+  markupMonospaced           = \p _ -> tt (p Mono),
+  markupUnorderedList        = \p v -> itemizedList (map ($v) p) $$ text "",
+  markupPic                  = \p _ -> markupPic p,
+  markupOrderedList          = \p v -> enumeratedList (map ($v) p) $$ text "",
+  markupDefList              = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
+  markupCodeBlock            = \p _ -> quote (verb (p Verb)) $$ text "",
+  markupHyperlink            = \l _ -> markupLink l,
+  markupAName                = \_ _ -> empty,
+  markupProperty             = \p _ -> quote $ verb $ text p,
+  markupExample              = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
+  markupHeader               = \(Header l h) p -> header l (h p)
+  }
+  where
+    header 1 d = text "\\section*" <> braces d
+    header 2 d = text "\\subsection*" <> braces d
+    header l d
+      | l > 0 && l <= 6 = text "\\subsubsection*" <> braces d
+    header l _ = error $ "impossible header level in LaTeX generation: " ++ show l
+
+    fixString Plain s = latexFilter s
+    fixString Verb  s = s
+    fixString Mono  s = latexMonoFilter s
+
+    markupLink (Hyperlink url mLabel) = case mLabel of
+      Just label -> text "\\href" <> braces (text url) <> braces (text label)
+      Nothing    -> text "\\url"  <> braces (text url)
+
+    -- Is there a better way of doing this? Just a space is an aribtrary choice.
+    markupPic (Picture uri title) = parens (imageText title)
+      where
+        imageText Nothing = beg
+        imageText (Just t) = beg <> text " " <> text t
+
+        beg = text "image: " <> text uri
+
+    markupId ppId_ id v =
+      case v of
+        Verb  -> theid
+        Mono  -> theid
+        Plain -> text "\\haddockid" <> braces theid
+      where theid = ppId_ id
+
+
+latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
+latexMarkup = parLatexMarkup ppVerbDocName
+
+
+rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
+rdrLatexMarkup = parLatexMarkup ppVerbRdrName
+
+
+docToLaTeX :: Doc DocName -> LaTeX
+docToLaTeX doc = markup latexMarkup doc Plain
+
+
+documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
+documentationToLaTeX = fmap docToLaTeX . combineDocumentation
+
+
+rdrDocToLaTeX :: Doc RdrName -> LaTeX
+rdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain
+
+
+data StringContext = Plain | Verb | Mono
+
+
+latexStripTrailingWhitespace :: Doc a -> Doc a
+latexStripTrailingWhitespace (DocString s)
+  | null s'   = DocEmpty
+  | otherwise = DocString s
+  where s' = reverse (dropWhile isSpace (reverse s))
+latexStripTrailingWhitespace (DocAppend l r)
+  | DocEmpty <- r' = latexStripTrailingWhitespace l
+  | otherwise      = DocAppend l r'
+  where
+    r' = latexStripTrailingWhitespace r
+latexStripTrailingWhitespace (DocParagraph p) =
+  latexStripTrailingWhitespace p
+latexStripTrailingWhitespace other = other
+
+
+-------------------------------------------------------------------------------
+-- * LaTeX utils
+-------------------------------------------------------------------------------
+
+
+itemizedList :: [LaTeX] -> LaTeX
+itemizedList items =
+  text "\\begin{itemize}" $$
+  vcat (map (text "\\item" $$) items) $$
+  text "\\end{itemize}"
+
+
+enumeratedList :: [LaTeX] -> LaTeX
+enumeratedList items =
+  text "\\begin{enumerate}" $$
+  vcat (map (text "\\item " $$) items) $$
+  text "\\end{enumerate}"
+
+
+descriptionList :: [(LaTeX,LaTeX)] -> LaTeX
+descriptionList items =
+  text "\\begin{description}" $$
+  vcat (map (\(a,b) -> text "\\item" <> brackets a <+> b) items) $$
+  text "\\end{description}"
+
+
+tt :: LaTeX -> LaTeX
+tt ltx = text "\\haddocktt" <> braces ltx
+
+
+decltt :: LaTeX -> LaTeX
+decltt ltx = text "\\haddockdecltt" <> braces ltx
+
+
+emph :: LaTeX -> LaTeX
+emph ltx = text "\\emph" <> braces ltx
+
+bold :: LaTeX -> LaTeX
+bold ltx = text "\\textbf" <> braces ltx
+
+verb :: LaTeX -> LaTeX
+verb doc = text "{\\haddockverb\\begin{verbatim}" $$ doc <> text "\\end{verbatim}}"
+   -- NB. swallow a trailing \n in the verbatim text by appending the
+   -- \end{verbatim} directly, otherwise we get spurious blank lines at the
+   -- end of code blocks.
+
+
+quote :: LaTeX -> LaTeX
+quote doc = text "\\begin{quote}" $$ doc $$ text "\\end{quote}"
+
+
+dcolon, arrow, darrow, forallSymbol :: Bool -> LaTeX
+dcolon unicode = text (if unicode then "∷" else "::")
+arrow  unicode = text (if unicode then "→" else "->")
+darrow unicode = text (if unicode then "⇒" else "=>")
+forallSymbol unicode = text (if unicode then "∀" else "forall")
+
+
+dot :: LaTeX
+dot = char '.'
+
+
+parenList :: [LaTeX] -> LaTeX
+parenList = parens . hsep . punctuate comma
+
+
+ubxParenList :: [LaTeX] -> LaTeX
+ubxParenList = ubxparens . hsep . punctuate comma
+
+
+ubxparens :: LaTeX -> LaTeX
+ubxparens h = text "(#" <> h <> text "#)"
+
+
+pabrackets :: LaTeX -> LaTeX
+pabrackets h = text "[:" <> h <> text ":]"
+
+
+nl :: LaTeX
+nl = text "\\\\"
+
+
+keyword :: String -> LaTeX
+keyword = text
+
+
+infixr 4 <->  -- combining table cells
+(<->) :: LaTeX -> LaTeX -> LaTeX
+a <-> b = a <+> char '&' <+> b
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
new file mode 100644
index 00000000..9628a33d
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -0,0 +1,690 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2009,
+--                    Mark Lentczner    2010,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
+module Haddock.Backends.Xhtml (
+  ppHtml, copyHtmlBits,
+  ppHtmlIndex, ppHtmlContents,
+) where
+
+
+import Prelude hiding (div)
+
+import Haddock.Backends.Xhtml.Decl
+import Haddock.Backends.Xhtml.DocMarkup
+import Haddock.Backends.Xhtml.Layout
+import Haddock.Backends.Xhtml.Names
+import Haddock.Backends.Xhtml.Themes
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
+import Haddock.ModuleTree
+import Haddock.Types
+import Haddock.Version
+import Haddock.Utils
+import Text.XHtml hiding ( name, title, p, quote )
+import Haddock.GhcUtils
+
+import Control.Monad         ( when, unless )
+#if !MIN_VERSION_base(4,7,0)
+import Control.Monad.Instances ( ) -- for Functor Either a
+#endif
+import Data.Char             ( toUpper )
+import Data.Functor          ( (<$>) )
+import Data.List             ( sortBy, groupBy, intercalate, isPrefixOf )
+import Data.Maybe
+import System.FilePath hiding ( (</>) )
+import System.Directory
+import Data.Map              ( Map )
+import qualified Data.Map as Map hiding ( Map )
+import qualified Data.Set as Set hiding ( Set )
+import Data.Function
+import Data.Ord              ( comparing )
+
+import DynFlags (Language(..))
+import GHC hiding ( NoLink, moduleInfo )
+import Name
+import Module
+
+--------------------------------------------------------------------------------
+-- * Generating HTML documentation
+--------------------------------------------------------------------------------
+
+
+ppHtml :: String
+       -> Maybe String                 -- ^ Package
+       -> [Interface]
+       -> FilePath                     -- ^ Destination directory
+       -> Maybe (Doc GHC.RdrName)      -- ^ Prologue text, maybe
+       -> Themes                       -- ^ Themes
+       -> SourceURLs                   -- ^ The source URL (--source)
+       -> WikiURLs                     -- ^ The wiki URL (--wiki)
+       -> Maybe String                 -- ^ The contents URL (--use-contents)
+       -> Maybe String                 -- ^ The index URL (--use-index)
+       -> Bool                         -- ^ Whether to use unicode in output (--use-unicode)
+       -> QualOption                   -- ^ How to qualify names
+       -> Bool                         -- ^ Output pretty html (newlines and indenting)
+       -> IO ()
+
+ppHtml doctitle maybe_package ifaces odir prologue
+        themes maybe_source_url maybe_wiki_url
+        maybe_contents_url maybe_index_url unicode
+        qual debug =  do
+  let
+    visible_ifaces = filter visible ifaces
+    visible i = OptHide `notElem` ifaceOptions i
+
+  when (isNothing maybe_contents_url) $
+    ppHtmlContents odir doctitle maybe_package
+        themes maybe_index_url maybe_source_url maybe_wiki_url
+        (map toInstalledIface visible_ifaces)
+        False -- we don't want to display the packages in a single-package contents
+        prologue debug (makeContentsQual qual)
+
+  when (isNothing maybe_index_url) $
+    ppHtmlIndex odir doctitle maybe_package
+      themes maybe_contents_url maybe_source_url maybe_wiki_url
+      (map toInstalledIface visible_ifaces) debug
+
+  mapM_ (ppHtmlModule odir doctitle themes
+           maybe_source_url maybe_wiki_url
+           maybe_contents_url maybe_index_url unicode qual debug) visible_ifaces
+
+
+copyHtmlBits :: FilePath -> FilePath -> Themes -> IO ()
+copyHtmlBits odir libdir themes = do
+  let
+    libhtmldir = joinPath [libdir, "html"]
+    copyCssFile f = copyFile f (combine odir (takeFileName f))
+    copyLibFile f = copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
+  mapM_ copyCssFile (cssFiles themes)
+  mapM_ copyLibFile [ jsFile, framesFile ]
+
+
+headHtml :: String -> Maybe String -> Themes -> Html
+headHtml docTitle miniPage themes =
+  header << [
+    meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"],
+    thetitle << docTitle,
+    styleSheet themes,
+    script ! [src jsFile, thetype "text/javascript"] << noHtml,
+    script ! [thetype "text/javascript"]
+        -- NB: Within XHTML, the content of script tags needs to be
+        -- a <![CDATA[ section. Will break if the miniPage name could
+        -- have "]]>" in it!
+      << primHtml (
+          "//<![CDATA[\nwindow.onload = function () {pageLoad();"
+          ++ setSynopsis ++ "};\n//]]>\n")
+    ]
+  where
+    setSynopsis = maybe "" (\p -> "setSynopsis(\"" ++ p ++ "\");") miniPage
+
+
+srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
+srcButton (Just src_base_url, _, _, _) Nothing =
+  Just (anchor ! [href src_base_url] << "Source")
+srcButton (_, Just src_module_url, _, _) (Just iface) =
+  let url = spliceURL (Just $ ifaceOrigFilename iface)
+                      (Just $ ifaceMod iface) Nothing Nothing src_module_url
+   in Just (anchor ! [href url] << "Source")
+srcButton _ _ =
+  Nothing
+
+
+wikiButton :: WikiURLs -> Maybe Module -> Maybe Html
+wikiButton (Just wiki_base_url, _, _) Nothing =
+  Just (anchor ! [href wiki_base_url] << "User Comments")
+
+wikiButton (_, Just wiki_module_url, _) (Just mdl) =
+  let url = spliceURL Nothing (Just mdl) Nothing Nothing wiki_module_url
+   in Just (anchor ! [href url] << "User Comments")
+
+wikiButton _ _ =
+  Nothing
+
+
+contentsButton :: Maybe String -> Maybe Html
+contentsButton maybe_contents_url
+  = Just (anchor ! [href url] << "Contents")
+  where url = fromMaybe contentsHtmlFile maybe_contents_url
+
+
+indexButton :: Maybe String -> Maybe Html
+indexButton maybe_index_url
+  = Just (anchor ! [href url] << "Index")
+  where url = fromMaybe indexHtmlFile maybe_index_url
+
+
+bodyHtml :: String -> Maybe Interface
+    -> SourceURLs -> WikiURLs
+    -> Maybe String -> Maybe String
+    -> Html -> Html
+bodyHtml doctitle iface
+           maybe_source_url maybe_wiki_url
+           maybe_contents_url maybe_index_url
+           pageContent =
+  body << [
+    divPackageHeader << [
+      unordList (catMaybes [
+        srcButton maybe_source_url iface,
+        wikiButton maybe_wiki_url (ifaceMod <$> iface),
+        contentsButton maybe_contents_url,
+        indexButton maybe_index_url])
+            ! [theclass "links", identifier "page-menu"],
+      nonEmptySectionName << doctitle
+      ],
+    divContent << pageContent,
+    divFooter << paragraph << (
+      "Produced by " +++
+      (anchor ! [href projectUrl] << toHtml projectName) +++
+      (" version " ++ projectVersion)
+      )
+    ]
+
+
+moduleInfo :: Interface -> Html
+moduleInfo iface =
+   let
+      info = ifaceInfo iface
+
+      doOneEntry :: (String, HaddockModInfo GHC.Name -> Maybe String) -> Maybe HtmlTable
+      doOneEntry (fieldName, field) =
+        field info >>= \a -> return (th << fieldName <-> td << a)
+
+      entries :: [HtmlTable]
+      entries = mapMaybe doOneEntry [
+          ("Copyright",hmi_copyright),
+          ("License",hmi_license),
+          ("Maintainer",hmi_maintainer),
+          ("Stability",hmi_stability),
+          ("Portability",hmi_portability),
+          ("Safe Haskell",hmi_safety),
+          ("Language", lg)
+          ] ++ extsForm
+        where
+          lg inf = case hmi_language inf of
+            Nothing -> Nothing
+            Just Haskell98 -> Just "Haskell98"
+            Just Haskell2010 -> Just "Haskell2010"
+
+          extsForm
+            | OptShowExtensions `elem` ifaceOptions iface =
+              let fs = map (dropOpt . show) (hmi_extensions info)
+              in case map stringToHtml fs of
+                [] -> []
+                [x] -> extField x -- don't use a list for a single extension
+                xs -> extField $ unordList xs ! [theclass "extension-list"]
+            | otherwise = []
+            where
+              extField x = return $ th << "Extensions" <-> td << x
+              dropOpt x = if "Opt_" `isPrefixOf` x then drop 4 x else x
+   in
+      case entries of
+         [] -> noHtml
+         _ -> table ! [theclass "info"] << aboves entries
+
+
+--------------------------------------------------------------------------------
+-- * Generate the module contents
+--------------------------------------------------------------------------------
+
+
+ppHtmlContents
+   :: FilePath
+   -> String
+   -> Maybe String
+   -> Themes
+   -> Maybe String
+   -> SourceURLs
+   -> WikiURLs
+   -> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName)
+   -> Bool
+   -> Qualification  -- ^ How to qualify names
+   -> IO ()
+ppHtmlContents odir doctitle _maybe_package
+  themes maybe_index_url
+  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do
+  let tree = mkModuleTree showPkgs
+         [(instMod iface, toInstalledDescription iface) | iface <- ifaces]
+      html =
+        headHtml doctitle Nothing themes +++
+        bodyHtml doctitle Nothing
+          maybe_source_url maybe_wiki_url
+          Nothing maybe_index_url << [
+            ppPrologue qual doctitle prologue,
+            ppModuleTree qual tree
+          ]
+  createDirectoryIfMissing True odir
+  writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
+
+  -- XXX: think of a better place for this?
+  ppHtmlContentsFrame odir doctitle themes ifaces debug
+
+
+ppPrologue :: Qualification -> String -> Maybe (Doc GHC.RdrName) -> Html
+ppPrologue _ _ Nothing = noHtml
+ppPrologue qual title (Just doc) =
+  divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc))
+
+
+ppModuleTree :: Qualification -> [ModuleTree] -> Html
+ppModuleTree qual ts =
+  divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts)
+
+
+mkNodeList :: Qualification -> [String] -> String -> [ModuleTree] -> Html
+mkNodeList qual ss p ts = case ts of
+  [] -> noHtml
+  _ -> unordList (zipWith (mkNode qual ss) ps ts)
+  where
+    ps = [ p ++ '.' : show i | i <- [(1::Int)..]]
+
+
+mkNode :: Qualification -> [String] -> String -> ModuleTree -> Html
+mkNode qual ss p (Node s leaf pkg short ts) =
+  htmlModule <+> shortDescr +++ htmlPkg +++ subtree
+  where
+    modAttrs = case (ts, leaf) of
+      (_:_, False) -> collapseControl p True "module"
+      (_,   _    ) -> [theclass "module"]
+
+    cBtn = case (ts, leaf) of
+      (_:_, True) -> thespan ! collapseControl p True "" << spaceHtml
+      (_,   _   ) -> noHtml
+      -- We only need an explicit collapser button when the module name
+      -- is also a leaf, and so is a link to a module page. Indeed, the
+      -- spaceHtml is a minor hack and does upset the layout a fraction.
+
+    htmlModule = thespan ! modAttrs << (cBtn +++
+      if leaf
+        then ppModule (mkModule (stringToPackageId (fromMaybe "" pkg))
+                                       (mkModuleName mdl))
+        else toHtml s
+      )
+
+    mdl = intercalate "." (reverse (s:ss))
+
+    shortDescr = maybe noHtml (origDocToHtml qual) short
+    htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg
+
+    subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
+
+
+-- | Turn a module tree into a flat list of full module names.  E.g.,
+-- @
+--  A
+--  +-B
+--  +-C
+-- @
+-- becomes
+-- @["A", "A.B", "A.B.C"]@
+flatModuleTree :: [InstalledInterface] -> [Html]
+flatModuleTree ifaces =
+    map (uncurry ppModule' . head)
+            . groupBy ((==) `on` fst)
+            . sortBy (comparing fst)
+            $ mods
+  where
+    mods = [ (moduleString mdl, mdl) | mdl <- map instMod ifaces ]
+    ppModule' txt mdl =
+      anchor ! [href (moduleHtmlFile mdl), target mainFrameName]
+        << toHtml txt
+
+
+ppHtmlContentsFrame :: FilePath -> String -> Themes
+  -> [InstalledInterface] -> Bool -> IO ()
+ppHtmlContentsFrame odir doctitle themes ifaces debug = do
+  let mods = flatModuleTree ifaces
+      html =
+        headHtml doctitle Nothing themes +++
+        miniBody << divModuleList <<
+          (sectionName << "Modules" +++
+           ulist << [ li ! [theclass "module"] << m | m <- mods ])
+  createDirectoryIfMissing True odir
+  writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString debug html)
+
+
+--------------------------------------------------------------------------------
+-- * Generate the index
+--------------------------------------------------------------------------------
+
+
+ppHtmlIndex :: FilePath
+            -> String
+            -> Maybe String
+            -> Themes
+            -> Maybe String
+            -> SourceURLs
+            -> WikiURLs
+            -> [InstalledInterface]
+            -> Bool
+            -> IO ()
+ppHtmlIndex odir doctitle _maybe_package themes
+  maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do
+  let html = indexPage split_indices Nothing
+              (if split_indices then [] else index)
+
+  createDirectoryIfMissing True odir
+
+  when split_indices $ do
+    mapM_ (do_sub_index index) initialChars
+    -- Let's add a single large index as well for those who don't know exactly what they're looking for:
+    let mergedhtml = indexPage False Nothing index
+    writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml)
+
+  writeFile (joinPath [odir, indexHtmlFile]) (renderToString debug html)
+
+  where
+    indexPage showLetters ch items =
+      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes +++
+      bodyHtml doctitle Nothing
+        maybe_source_url maybe_wiki_url
+        maybe_contents_url Nothing << [
+          if showLetters then indexInitialLetterLinks else noHtml,
+          if null items then noHtml else
+            divIndex << [sectionName << indexName ch, buildIndex items]
+          ]
+
+    indexName ch = "Index" ++ maybe "" (\c -> " - " ++ [c]) ch
+    merged_name = "All"
+
+    buildIndex items = table << aboves (map indexElt items)
+
+    -- an arbitrary heuristic:
+    -- too large, and a single-page will be slow to load
+    -- too small, and we'll have lots of letter-indexes with only one
+    --   or two members in them, which seems inefficient or
+    --   unnecessarily hard to use.
+    split_indices = length index > 150
+
+    indexInitialLetterLinks =
+      divAlphabet <<
+         unordList (map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $
+                        [ [c] | c <- initialChars
+                              , any ((==c) . toUpper . head . fst) index ] ++
+                        [merged_name])
+
+    -- todo: what about names/operators that start with Unicode
+    -- characters?
+    -- Exports beginning with '_' can be listed near the end,
+    -- presumably they're not as important... but would be listed
+    -- with non-split index!
+    initialChars = [ 'A'..'Z' ] ++ ":!#$%&*+./<=>?@\\^|-~" ++ "_"
+
+    do_sub_index this_ix c
+      = unless (null index_part) $
+          writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)
+      where
+        html = indexPage True (Just c) 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,_) = comparing (map toUpper) n1 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 (++)))
+                 (concatMap getIfaceIndex ifaces)
+
+    getIfaceIndex iface =
+      [ (getOccString name
+         , Map.fromList [(name, [(mdl, name `Set.member` visible)])])
+         | name <- instExports iface ]
+      where
+        mdl = instMod iface
+        visible = Set.fromList (instVisibleExports iface)
+
+    indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable
+    indexElt (str, entities) =
+       case Map.toAscList entities of
+          [(nm,entries)] ->
+              td ! [ theclass "src" ] << toHtml str <->
+                          indexLinks nm entries
+          many_entities ->
+              td ! [ theclass "src" ] << toHtml str <-> td << spaceHtml </>
+                  aboves (zipWith (curry doAnnotatedEntity) [1..] many_entities)
+
+    doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable
+    doAnnotatedEntity (j,(nm,entries))
+          = td ! [ theclass "alt" ] <<
+                  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 =
+       td ! [ theclass "module" ] <<
+          hsep (punctuate comma
+          [ if visible then
+               linkId mdl (Just nm) << toHtml (moduleString mdl)
+            else
+               toHtml (moduleString mdl)
+          | (mdl, visible) <- entries ])
+
+
+--------------------------------------------------------------------------------
+-- * Generate the HTML page for a module
+--------------------------------------------------------------------------------
+
+
+ppHtmlModule
+        :: FilePath -> String -> Themes
+        -> SourceURLs -> WikiURLs
+        -> Maybe String -> Maybe String -> Bool -> QualOption
+        -> Bool -> Interface -> IO ()
+ppHtmlModule odir doctitle themes
+  maybe_source_url maybe_wiki_url
+  maybe_contents_url maybe_index_url unicode qual debug iface = do
+  let
+      mdl = ifaceMod iface
+      aliases = ifaceModuleAliases iface
+      mdl_str = moduleString mdl
+      real_qual = makeModuleQual qual aliases mdl
+      html =
+        headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
+        bodyHtml doctitle (Just iface)
+          maybe_source_url maybe_wiki_url
+          maybe_contents_url maybe_index_url << [
+            divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)),
+            ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual
+          ]
+
+  createDirectoryIfMissing True odir
+  writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
+  ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode real_qual debug
+
+ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
+  -> Interface -> Bool -> Qualification -> Bool -> IO ()
+ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual debug = do
+  let mdl = ifaceMod iface
+      html =
+        headHtml (moduleString mdl) Nothing themes +++
+        miniBody <<
+          (divModuleHeader << sectionName << moduleString mdl +++
+           miniSynopsis mdl iface unicode qual)
+  createDirectoryIfMissing True odir
+  writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString debug html)
+
+
+ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
+ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
+  = ppModuleContents qual exports +++
+    description +++
+    synopsis +++
+    divInterface (maybe_doc_hdr +++ bdy)
+  where
+    exports = numberSectionHeadings (ifaceRnExportItems iface)
+
+    -- todo: if something has only sub-docs, or fn-args-docs, should
+    -- it be measured here and thus prevent omitting the synopsis?
+    has_doc ExportDecl { expItemMbDoc = (Documentation mDoc mWarning, _) } = isJust mDoc || isJust mWarning
+    has_doc (ExportNoDecl _ _) = False
+    has_doc (ExportModule _) = False
+    has_doc _ = True
+
+    no_doc_at_all = not (any has_doc exports)
+
+    description | isNoHtml doc = doc
+                | otherwise    = divDescription $ sectionName << "Description" +++ doc
+                where doc = docSection qual (ifaceRnDoc iface)
+
+        -- omit the synopsis if there are no documentation annotations at all
+    synopsis
+      | no_doc_at_all = noHtml
+      | otherwise
+      = divSynposis $
+            paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++
+            shortDeclList (
+                mapMaybe (processExport True linksInfo unicode qual) exports
+            ) ! (collapseSection "syn" False "" ++ collapseToggle "syn")
+
+        -- if the documentation doesn't begin with a section header, then
+        -- add one ("Documentation").
+    maybe_doc_hdr
+      = case exports of
+          [] -> noHtml
+          ExportGroup {} : _ -> noHtml
+          _ -> h1 << "Documentation"
+
+    bdy =
+      foldr (+++) noHtml $
+        mapMaybe (processExport False linksInfo unicode qual) exports
+
+    linksInfo = (maybe_source_url, maybe_wiki_url)
+
+
+miniSynopsis :: Module -> Interface -> Bool -> Qualification -> Html
+miniSynopsis mdl iface unicode qual =
+    divInterface << concatMap (processForMiniSynopsis mdl unicode qual) exports
+  where
+    exports = numberSectionHeadings (ifaceRnExportItems iface)
+
+
+processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName
+                       -> [Html]
+processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0 } =
+  ((divTopDecl <<).(declElem <<)) <$> case decl0 of
+    TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
+        (FamDecl decl)    -> [ppTyFamHeader True False decl unicode qual]
+        (DataDecl{})   -> [keyword "data" <+> b]
+        (SynDecl{})    -> [keyword "type" <+> b]
+        (ClassDecl {}) -> [keyword "class" <+> b]
+        _ -> []
+    SigD (TypeSig lnames (L _ _)) ->
+      map (ppNameMini Prefix mdl . nameOccName . getName . unLoc) lnames
+    _ -> []
+processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) =
+  [groupTag lvl << docToHtml qual txt]
+processForMiniSynopsis _ _ _ _ = []
+
+
+ppNameMini :: Notation -> Module -> OccName -> Html
+ppNameMini notation mdl nm =
+    anchor ! [ href (moduleNameUrl mdl nm)
+             , target mainFrameName ]
+      << ppBinder' notation nm
+
+
+ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html
+ppTyClBinderWithVarsMini mdl decl =
+  let n = tcdName decl
+      ns = tyvarNames $ tcdTyVars decl -- it's safe to use tcdTyVars, see code above
+  in ppTypeApp n [] ns (\is_infix -> ppNameMini is_infix mdl . nameOccName . getName) ppTyName
+
+
+ppModuleContents :: Qualification -> [ExportItem DocName] -> Html
+ppModuleContents qual exports
+  | null sections = noHtml
+  | otherwise     = contentsDiv
+ where
+  contentsDiv = divTableOfContents << (
+    sectionName << "Contents" +++
+    unordList sections)
+
+  (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 = linkedAnchor (groupId id0)
+               << docToHtmlNoAnchors qual 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 = unordList 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 = go 1
+  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 -> Bool -> Qualification
+              -> ExportItem DocName -> Maybe Html
+processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
+processExport summary _ _ qual (ExportGroup lev id0 doc)
+  = nothingIf summary $ groupHeading lev id0 << docToHtml qual doc
+processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities splice)
+  = processDecl summary $ ppDecl summary links decl doc insts fixities subdocs splice unicode qual
+processExport summary _ _ qual (ExportNoDecl y [])
+  = processDeclOneLiner summary $ ppDocName qual Prefix True y
+processExport summary _ _ qual (ExportNoDecl y subs)
+  = processDeclOneLiner summary $
+      ppDocName qual Prefix True y
+      +++ parenList (map (ppDocName qual Prefix True) subs)
+processExport summary _ _ qual (ExportDoc doc)
+  = nothingIf summary $ docSection_ qual doc
+processExport summary _ _ _ (ExportModule mdl)
+  = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl
+
+
+nothingIf :: Bool -> a -> Maybe a
+nothingIf True _ = Nothing
+nothingIf False a = Just a
+
+
+processDecl :: Bool -> Html -> Maybe Html
+processDecl True = Just
+processDecl False = Just . divTopDecl
+
+
+processDeclOneLiner :: Bool -> Html -> Maybe Html
+processDeclOneLiner True = Just
+processDeclOneLiner False = Just . divTopDecl . declElem
+
+groupHeading :: Int -> String -> Html -> Html
+groupHeading lev id0 = groupTag lev ! [identifier (groupId id0)]
+
+groupTag :: Int -> Html -> Html
+groupTag lev
+  | lev == 1  = h1
+  | lev == 2  = h2
+  | lev == 3  = h3
+  | otherwise = h4
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
new file mode 100644
index 00000000..8884f69f
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -0,0 +1,885 @@
+{-# LANGUAGE TransformListComp #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Decl
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Decl (
+  ppDecl,
+
+  ppTyName, ppTyFamHeader, ppTypeApp,
+  tyvarNames
+) where
+
+
+import Haddock.Backends.Xhtml.DocMarkup
+import Haddock.Backends.Xhtml.Layout
+import Haddock.Backends.Xhtml.Names
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
+import Haddock.GhcUtils
+import Haddock.Types
+import Haddock.Doc (combineDocumentation)
+
+import           Data.List             ( intersperse, sort )
+import qualified Data.Map as Map
+import           Data.Maybe
+import           Data.Monoid           ( mempty )
+import           Text.XHtml hiding     ( name, title, p, quote )
+
+import GHC
+import GHC.Exts
+import Name
+import BooleanFormula
+
+ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
+       -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
+       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
+ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
+  TyClD (FamDecl d)         -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
+  TyClD d@(DataDecl {})     -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
+  TyClD d@(SynDecl {})      -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
+  TyClD d@(ClassDecl {})    -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+  SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities splice unicode qual
+  SigD (PatSynSig lname args ty prov req) ->
+      ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req fixities splice unicode qual
+  ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
+  InstD _                        -> noHtml
+  _                              -> error "declaration not supported by ppDecl"
+
+
+ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+             [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
+             Splice -> Unicode -> Qualification -> Html
+ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
+  ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) fixities
+           splice unicode qual
+
+ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+            [DocName] -> HsType DocName -> [(DocName, Fixity)] ->
+            Splice -> Unicode -> Qualification -> Html
+ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
+  ppSigLike summary links loc mempty doc docnames fixities (typ, pp_typ)
+            splice unicode qual
+  where
+    pp_typ = ppType unicode qual typ
+
+ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+             Located DocName ->
+             HsPatSynDetails (LHsType DocName) -> LHsType DocName ->
+             LHsContext DocName -> LHsContext DocName -> [(DocName, Fixity)] ->
+             Splice -> Unicode -> Qualification -> Html
+ppLPatSig summary links loc doc lname args typ prov req fixities splice unicode qual =
+    ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ)
+             (unLoc prov) (unLoc req) fixities splice unicode qual
+
+ppPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+            DocName ->
+            HsPatSynDetails (HsType DocName) -> HsType DocName ->
+            HsContext DocName -> HsContext DocName -> [(DocName, Fixity)] ->
+            Splice -> Unicode -> Qualification -> Html
+ppPatSig summary links loc (doc, _argDocs) docname args typ prov req fixities
+         splice unicode qual
+  | summary = pref1
+  | otherwise = topDeclElem links loc splice [docname] (pref1 <+> ppFixities fixities qual)
+                +++ docSection qual doc
+  where
+    pref1 = hsep [ toHtml "pattern"
+                 , pp_cxt prov
+                 , pp_head
+                 , dcolon unicode
+                 , pp_cxt req
+                 , ppType unicode qual typ
+                 ]
+    pp_head = case args of
+        PrefixPatSyn typs -> hsep $ ppBinder summary occname : map pp_type typs
+        InfixPatSyn left right -> hsep [pp_type left, ppBinderInfix summary occname, pp_type right]
+
+    pp_cxt cxt = ppContext cxt unicode qual
+    pp_type = ppParendType unicode qual
+
+    occname = nameOccName . getName $ docname
+
+ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
+             [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
+             Splice -> Unicode -> Qualification -> Html
+ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
+          splice unicode qual =
+  ppTypeOrFunSig summary links loc docnames typ doc
+    ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
+    , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
+    , dcolon unicode
+    )
+    splice unicode qual
+  where
+    occnames = map (nameOccName . getName) docnames
+    addFixities html
+      | summary   = html
+      | otherwise = html <+> ppFixities fixities qual
+
+
+ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
+               -> DocForDecl DocName -> (Html, Html, Html)
+               -> Splice -> Unicode -> Qualification -> Html
+ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual
+  | summary = pref1
+  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection qual doc
+  | otherwise = topDeclElem links loc splice docnames pref2 +++
+      subArguments qual (do_args 0 sep typ) +++ docSection qual doc
+  where
+    argDoc n = Map.lookup n argDocs
+
+    do_largs n leader (L _ t) = do_args n leader t
+    do_args :: Int -> Html -> HsType DocName -> [SubDecl]
+    do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
+      = (leader <+>
+          hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
+          ppLContextNoArrow lctxt unicode qual,
+          Nothing, [])
+        : do_largs n (darrow unicode) ltype
+    do_args n leader (HsForAllTy Implicit _ lctxt ltype)
+      | not (null (unLoc lctxt))
+      = (leader <+> ppLContextNoArrow lctxt unicode qual,
+          Nothing, [])
+        : do_largs n (darrow unicode) ltype
+      -- if we're not showing any 'forall' or class constraints or
+      -- anything, skip having an empty line for the context.
+      | otherwise
+      = do_largs n leader ltype
+    do_args n leader (HsFunTy lt r)
+      = (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
+        : do_largs (n+1) (arrow unicode) r
+    do_args n leader t
+      = [(leader <+> ppType unicode qual t, argDoc n, [])]
+
+ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
+ppFixities [] _ = noHtml
+ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
+  where
+    ppFix (ns, p, d) = thespan ! [theclass "fixity"] <<
+                         (toHtml d <+> toHtml (show p) <+> ppNames ns)
+
+    ppDir InfixR = "infixr"
+    ppDir InfixL = "infixl"
+    ppDir InfixN = "infix"
+
+    ppNames = case fs of
+      _:[] -> const noHtml -- Don't display names for fixities on single names
+      _    -> concatHtml . intersperse (stringToHtml ", ") . map (ppDocName qual Infix False)
+
+    uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs
+                                   , let d' = ppDir d
+                                   , then group by Down (p,d') using groupWith ]
+
+    rightEdge = thespan ! [theclass "rightedge"] << noHtml
+
+
+ppTyVars :: LHsTyVarBndrs DocName -> [Html]
+ppTyVars tvs = map ppTyName (tyvarNames tvs)
+
+
+tyvarNames :: LHsTyVarBndrs DocName -> [Name]
+tyvarNames = map getName . hsLTyVarNames
+
+
+ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
+      -> ForeignDecl DocName -> [(DocName, Fixity)]
+      -> Splice -> Unicode -> Qualification -> Html
+ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) fixities
+      splice unicode qual
+  = ppFunSig summary links loc doc [name] typ fixities splice unicode qual
+ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
+
+
+-- we skip type patterns for now
+ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan
+        -> DocForDecl DocName -> TyClDecl DocName
+        -> Splice -> Unicode -> Qualification -> Html
+ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                                                , tcdRhs = ltype })
+        splice unicode qual
+  = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
+                   (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
+                   splice unicode qual
+  where
+    hdr  = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
+    full = hdr <+> equals <+> ppLType unicode qual ltype
+    occ  = nameOccName . getName $ name
+    fixs
+      | summary   = noHtml
+      | otherwise = ppFixities fixities qual
+ppTySyn _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
+
+
+ppTypeSig :: Bool -> [OccName] -> Html  -> Bool -> Html
+ppTypeSig summary nms pp_ty unicode =
+  concatHtml htmlNames <+> dcolon unicode <+> pp_ty
+  where
+    htmlNames = intersperse (stringToHtml ", ") $ map (ppBinder summary) nms
+
+
+ppTyName :: Name -> Html
+ppTyName = ppName Prefix
+
+
+--------------------------------------------------------------------------------
+-- * Type families
+--------------------------------------------------------------------------------
+
+
+ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName
+              -> Unicode -> Qualification -> Html
+ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
+                                               , fdKindSig = mkind })
+              unicode qual =
+  (case info of
+     OpenTypeFamily
+       | associated -> keyword "type"
+       | otherwise  -> keyword "type family"
+     DataFamily
+       | associated -> keyword "data"
+       | otherwise  -> keyword "data family"
+     ClosedTypeFamily _
+                    -> keyword "type family"
+  ) <+>
+
+  ppFamDeclBinderWithVars summary d <+>
+
+  (case mkind of
+    Just kind -> dcolon unicode  <+> ppLKind unicode qual kind
+    Nothing   -> noHtml
+  )
+
+ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] ->
+           [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
+           FamilyDecl DocName -> Splice -> Unicode -> Qualification -> Html
+ppTyFam summary associated links instances fixities loc doc decl splice unicode qual
+
+  | summary   = ppTyFamHeader True associated decl unicode qual
+  | otherwise = header_ +++ docSection qual doc +++ instancesBit
+
+  where
+    docname = unLoc $ fdLName decl
+
+    header_ = topDeclElem links loc splice [docname] $
+       ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
+
+    instancesBit
+      | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
+      , not summary
+      = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
+
+      | otherwise
+      = ppInstances instances docname unicode qual
+
+    -- Individual equation of a closed type family
+    ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs
+                            , tfie_pats = HsWB { hswb_cts = ts }}
+      = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
+          <+> equals <+> ppType unicode qual (unLoc rhs)
+        , Nothing, [] )
+
+--------------------------------------------------------------------------------
+-- * Associated Types
+--------------------------------------------------------------------------------
+
+
+ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName
+            -> [(DocName, Fixity)] -> Splice -> Unicode -> Qualification -> Html
+ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
+   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual
+
+
+--------------------------------------------------------------------------------
+-- * TyClDecl helpers
+--------------------------------------------------------------------------------
+
+-- | Print a type family and its variables
+ppFamDeclBinderWithVars :: Bool -> FamilyDecl DocName -> Html
+ppFamDeclBinderWithVars summ (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
+  ppAppDocNameNames summ (unLoc lname) (tyvarNames tvs)
+
+-- | Print a newtype / data binder and its variables
+ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html
+ppDataBinderWithVars summ decl =
+  ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl)
+
+--------------------------------------------------------------------------------
+-- * Type applications
+--------------------------------------------------------------------------------
+
+
+-- | Print an application of a DocName and two lists of HsTypes (kinds, types)
+ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName]
+               -> Unicode -> Qualification -> Html
+ppAppNameTypes n ks ts unicode qual =
+    ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual)
+
+
+-- | Print an application of a DocName and a list of Names
+ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html
+ppAppDocNameNames summ n ns =
+    ppTypeApp n [] ns ppDN ppTyName
+  where
+    ppDN notation = ppBinderFixity notation summ . nameOccName . getName
+    ppBinderFixity Infix = ppBinderInfix
+    ppBinderFixity _ = ppBinder
+
+-- | General printing of type applications
+ppTypeApp :: DocName -> [a] -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
+ppTypeApp n [] (t1:t2:rest) ppDN ppT
+  | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
+  | operator                    = opApp
+  where
+    operator = isNameSym . getName $ n
+    opApp = ppT t1 <+> ppDN Infix n <+> ppT t2
+
+ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts)
+
+
+-------------------------------------------------------------------------------
+-- * Contexts
+-------------------------------------------------------------------------------
+
+
+ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode
+                              -> Qualification -> Html
+ppLContext        = ppContext        . unLoc
+ppLContextNoArrow = ppContextNoArrow . unLoc
+
+
+ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> Html
+ppContextNoArrow []  _       _     = noHtml
+ppContextNoArrow cxt unicode qual = ppHsContext (map unLoc cxt) unicode qual
+
+
+ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> Html
+ppContextNoLocs []  _       _     = noHtml
+ppContextNoLocs cxt unicode qual = ppHsContext cxt unicode qual
+    <+> darrow unicode
+
+
+ppContext :: HsContext DocName -> Unicode -> Qualification -> Html
+ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
+
+
+ppHsContext :: [HsType DocName] -> Unicode -> Qualification-> Html
+ppHsContext []  _       _     = noHtml
+ppHsContext [p] unicode qual = ppCtxType unicode qual p
+ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
+
+
+-------------------------------------------------------------------------------
+-- * Class declarations
+-------------------------------------------------------------------------------
+
+
+ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
+           -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+           -> Unicode -> Qualification -> Html
+ppClassHdr summ lctxt n tvs fds unicode qual =
+  keyword "class"
+  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml)
+  <+> ppAppDocNameNames summ n (tyvarNames tvs)
+  <+> ppFds fds unicode qual
+
+
+ppFds :: [Located ([DocName], [DocName])] -> Unicode -> Qualification -> Html
+ppFds fds unicode qual =
+  if null fds then noHtml else
+        char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
+  where
+        fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
+        ppVars = hsep . map (ppDocName qual Prefix True)
+
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
+                 -> [(DocName, DocForDecl DocName)]
+                 -> Splice -> Unicode -> Qualification -> Html
+ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
+                                          , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
+    subdocs splice unicode qual =
+  if not (any isVanillaLSig sigs) && null ats
+    then (if summary then id else topDeclElem links loc splice [nm]) hdr
+    else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
+      +++ shortSubDecls False
+          (
+            [ ppAssocType summary links doc at [] splice unicode qual | at <- ats
+              , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++
+
+                -- ToDo: add associated type defaults
+
+            [ ppFunSig summary links loc doc names typ [] splice unicode qual
+              | L _ (TypeSig lnames (L _ typ)) <- sigs
+              , let doc = lookupAnySubdoc (head names) subdocs
+                    names = map unLoc lnames ]
+              -- FIXME: is taking just the first name ok? Is it possible that
+              -- there are different subdocs for different names in a single
+              -- type signature?
+          )
+  where
+    hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual
+    nm  = unLoc lname
+ppShortClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+
+
+
+ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)]
+            -> SrcSpan -> Documentation DocName
+            -> [(DocName, DocForDecl DocName)] -> TyClDecl DocName
+            -> Splice -> Unicode -> Qualification -> Html
+ppClassDecl summary links instances fixities loc d subdocs
+        decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
+                        , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
+            splice unicode qual
+  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode qual
+  | otherwise = classheader +++ docSection qual d
+                  +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
+  where
+    classheader
+      | any isVanillaLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
+      | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
+
+    -- Only the fixity relevant to the class header
+    fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
+
+    nm   = tcdName decl
+
+    hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
+
+    -- ToDo: add assocatied typ defaults
+    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode qual
+                      | at <- ats
+                      , let n = unL . fdLName $ unL at
+                            doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
+                            subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
+
+    methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs splice unicode qual
+                           | L _ (TypeSig lnames (L _ typ)) <- lsigs
+                           , let doc = lookupAnySubdoc (head names) subdocs
+                                 subfixs = [ f | n <- names
+                                               , f@(n',_) <- fixities
+                                               , n == n' ]
+                                 names = map unLoc lnames ]
+                           -- FIXME: is taking just the first name ok? Is it possible that
+                           -- there are different subdocs for different names in a single
+                           -- type signature?
+
+    minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of
+      -- Miminal complete definition = every shown method
+      And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
+                   sort [getName n | L _ (TypeSig ns _) <- lsigs, L _ n <- ns]
+        -> noHtml
+
+      -- Minimal complete definition = the only shown method
+      Var (L _ n) : _ | [getName n] ==
+                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns]
+        -> noHtml
+
+      -- Minimal complete definition = nothing
+      And [] : _ -> subMinimal $ toHtml "Nothing"
+
+      m : _  -> subMinimal $ ppMinimal False m
+      _ -> noHtml
+
+    ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
+    ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True) fs
+    ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
+      where wrap | p = parens | otherwise = id
+
+    instancesBit = ppInstances instances nm unicode qual
+
+ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+
+
+ppInstances :: [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html
+ppInstances instances baseName unicode qual
+  = subInstances qual instName (map instDecl instances)
+  where
+    instName = getOccString $ getName baseName
+    instDecl :: DocInstance DocName -> SubDecl
+    instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
+    instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
+        <+> ppAppNameTypes n ks ts unicode qual
+    instHead (n, ks, ts, TypeInst rhs) = keyword "type"
+        <+> ppAppNameTypes n ks ts unicode qual
+        <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
+    instHead (n, ks, ts, DataInst dd) = keyword "data"
+        <+> ppAppNameTypes n ks ts unicode qual
+        <+> ppShortDataDecl False True dd unicode qual
+
+lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
+lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
+
+
+-------------------------------------------------------------------------------
+-- * Data & newtype declarations
+-------------------------------------------------------------------------------
+
+
+-- TODO: print contexts
+ppShortDataDecl :: Bool -> Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
+ppShortDataDecl summary dataInst dataDecl unicode qual
+
+  | [] <- cons = dataHeader
+
+  | [lcon] <- cons, ResTyH98 <- resTy,
+    (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual
+       = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
+
+  | ResTyH98 <- resTy = dataHeader
+      +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons)
+
+  | otherwise = (dataHeader <+> keyword "where")
+      +++ shortSubDecls dataInst (map doGADTConstr cons)
+
+  where
+    dataHeader
+      | dataInst  = noHtml
+      | otherwise = ppDataHeader summary dataDecl unicode qual
+    doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
+    doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
+
+    cons      = dd_cons (tcdDataDefn dataDecl)
+    resTy     = (con_res . unLoc . head) cons
+
+
+ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] ->
+              [(DocName, DocForDecl DocName)] ->
+              SrcSpan -> Documentation DocName -> TyClDecl DocName ->
+              Splice -> Unicode -> Qualification -> Html
+ppDataDecl summary links instances fixities subdocs loc doc dataDecl
+           splice unicode qual
+
+  | summary   = ppShortDataDecl summary False dataDecl unicode qual
+  | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
+
+  where
+    docname   = tcdName dataDecl
+    cons      = dd_cons (tcdDataDefn dataDecl)
+    resTy     = (con_res . unLoc . head) cons
+
+    header_ = topDeclElem links loc splice [docname] $
+             ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix
+
+    fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual
+
+    whereBit
+      | null cons = noHtml
+      | otherwise = case resTy of
+        ResTyGADT _ -> keyword "where"
+        _ -> noHtml
+
+    constrBit = subConstructors qual
+      [ ppSideBySideConstr subdocs subfixs unicode qual c
+      | c <- cons
+      , let subfixs = filter (\(n,_) -> n == unLoc (con_name (unLoc c))) fixities
+      ]
+
+    instancesBit = ppInstances instances docname unicode qual
+
+
+
+ppShortConstr :: Bool -> ConDecl DocName -> Unicode -> Qualification -> Html
+ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
+  where
+    (cHead,cBody,cFoot) = ppShortConstrParts summary False con unicode qual
+
+
+-- returns three pieces: header, body, footer so that header & footer can be
+-- incorporated into the declaration
+ppShortConstrParts :: Bool -> Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
+ppShortConstrParts summary dataInst con unicode qual = case con_res con of
+  ResTyH98 -> case con_details con of
+    PrefixCon args ->
+      (header_ unicode qual +++ hsep (ppBinder summary occ
+            : map (ppLParendType unicode qual) args), noHtml, noHtml)
+    RecCon fields ->
+      (header_ unicode qual +++ ppBinder summary occ <+> char '{',
+       doRecordFields fields,
+       char '}')
+    InfixCon arg1 arg2 ->
+      (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1,
+            ppBinderInfix summary occ, ppLParendType unicode qual arg2],
+       noHtml, noHtml)
+
+  ResTyGADT resTy -> case con_details con of
+    -- prefix & infix could use hsConDeclArgTys if it seemed to
+    -- simplify the code.
+    PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
+    -- display GADT records with the new syntax,
+    -- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
+    -- (except each field gets its own line in docs, to match
+    -- non-GADT records)
+    RecCon fields -> (ppBinder summary occ <+> dcolon unicode <+>
+                            ppForAll forall_ ltvs lcontext unicode qual <+> char '{',
+                            doRecordFields fields,
+                            char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
+    InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
+
+  where
+    doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) fields)
+    doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
+                             ppForAll forall_ ltvs lcontext unicode qual,
+                             ppLType unicode qual (foldr mkFunTy resTy args) ]
+
+    header_  = ppConstrHdr forall_ tyVars context
+    occ      = nameOccName . getName . unLoc . 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 is for (non-GADT) existentials constructors' syntax
+ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Unicode
+            -> Qualification -> Html
+ppConstrHdr forall_ tvs ctxt unicode qual
+ = (if null tvs then noHtml else ppForall)
+   +++
+   (if null ctxt then noHtml else ppContextNoArrow ctxt unicode qual
+        <+> darrow unicode +++ toHtml " ")
+  where
+    ppForall = case forall_ of
+      Explicit -> forallSymbol unicode <+> hsep (map (ppName Prefix) tvs) <+> toHtml ". "
+      Implicit -> noHtml
+
+
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
+                   -> Unicode -> Qualification -> LConDecl DocName -> SubDecl
+ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, fieldPart)
+ where
+    decl = case con_res con of
+      ResTyH98 -> case con_details con of
+        PrefixCon args ->
+          hsep ((header_ +++ ppBinder False occ)
+            : map (ppLParendType unicode qual) args)
+          <+> fixity
+
+        RecCon _ -> header_ +++ ppBinder False occ <+> fixity
+
+        InfixCon arg1 arg2 ->
+          hsep [header_ +++ ppLParendType unicode qual arg1,
+            ppBinderInfix False occ,
+            ppLParendType unicode qual arg2]
+          <+> fixity
+
+      ResTyGADT resTy -> case con_details con of
+        -- prefix & infix could also use hsConDeclArgTys if it seemed to
+        -- simplify the code.
+        PrefixCon args -> doGADTCon args resTy
+        cd@(RecCon _) -> doGADTCon (hsConDeclArgTys cd) resTy
+        InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
+
+    fieldPart = case con_details con of
+        RecCon fields -> [doRecordFields fields]
+        _ -> []
+
+    doRecordFields fields = subFields qual
+      (map (ppSideBySideField subdocs unicode qual) fields)
+    doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
+    doGADTCon args resTy = ppBinder False occ <+> dcolon unicode
+        <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
+                  ppLType unicode qual (foldr mkFunTy resTy args) ]
+        <+> fixity
+
+    fixity  = ppFixities fixities qual
+    header_ = ppConstrHdr forall_ tyVars context unicode qual
+    occ     = nameOccName . getName . unLoc . con_name $ con
+    ltvs    = con_qvars con
+    tyVars  = tyvarNames (con_qvars con)
+    context = unLoc (con_cxt con)
+    forall_ = con_explicit con
+    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
+    -- or also because we want Haddock to do the doc-parsing, not GHC.
+    mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst
+    mkFunTy a b = noLoc (HsFunTy a b)
+
+
+ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
+                  -> ConDeclField DocName -> SubDecl
+ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
+  (ppBinder False (nameOccName . getName $ name) <+> dcolon unicode <+> ppLType unicode qual ltype,
+    mbDoc,
+    [])
+  where
+    -- don't use cd_fld_doc for same reason we don't use con_doc above
+    mbDoc = lookup name subdocs >>= combineDocumentation . fst
+
+
+ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html
+ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
+  = ppBinder summary (nameOccName . getName $ name)
+    <+> dcolon unicode <+> ppLType unicode qual ltype
+
+
+-- | Print the LHS of a data\/newtype declaration.
+-- Currently doesn't handle 'data instance' decls or kind signatures
+ppDataHeader :: Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
+ppDataHeader summary decl@(DataDecl { tcdDataDefn =
+                                         HsDataDefn { dd_ND = nd
+                                                    , dd_ctxt = ctxt
+                                                    , dd_kindSig = ks } })
+             unicode qual
+  = -- newtype or data
+    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
+    <+>
+    -- context
+    ppLContext ctxt unicode qual <+>
+    -- T a b c ..., or a :+: b
+    ppDataBinderWithVars summary decl
+    <+> case ks of
+      Nothing -> mempty
+      Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
+
+ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
+
+--------------------------------------------------------------------------------
+-- * Types and contexts
+--------------------------------------------------------------------------------
+
+
+ppBang :: HsBang -> Html
+ppBang HsNoBang = noHtml
+ppBang _        = toHtml "!" -- Unpacked args is an implementation detail,
+                             -- so we just show the strictness annotation
+
+
+tupleParens :: HsTupleSort -> [Html] -> Html
+tupleParens HsUnboxedTuple = ubxParenList
+tupleParens _              = parenList
+
+
+--------------------------------------------------------------------------------
+-- * Rendering of HsType
+--------------------------------------------------------------------------------
+
+
+pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int
+
+pREC_TOP = 0 :: Int   -- type in ParseIface.y in GHC
+pREC_CTX = 1 :: Int   -- Used for single contexts, eg. ctx => type
+                      -- (as opposed to (ctx1, ctx2) => type)
+pREC_FUN = 2 :: Int   -- btype in ParseIface.y in GHC
+                      -- Used for LH arg of (->)
+pREC_OP  = 3 :: Int   -- Used for arg of any infix operator
+                      -- (we don't keep their fixities around)
+pREC_CON = 4 :: 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
+
+
+ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification
+                                     -> Located (HsType DocName) -> Html
+ppLType       unicode qual y = ppType unicode qual (unLoc y)
+ppLParendType unicode qual y = ppParendType unicode qual (unLoc y)
+ppLFunLhType  unicode qual y = ppFunLhType unicode qual (unLoc y)
+
+
+ppType, ppCtxType, ppParendType, ppFunLhType :: Unicode -> Qualification
+                                             -> HsType DocName -> Html
+ppType       unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual
+ppCtxType    unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual
+ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
+ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
+
+ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html
+ppLKind unicode qual y = ppKind unicode qual (unLoc y)
+
+ppKind :: Unicode -> Qualification -> HsKind DocName -> Html
+ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
+
+-- Drop top-level for-all type variables in user style
+-- since they are implicit in Haskell
+
+ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
+         -> Located (HsContext DocName) -> Unicode -> Qualification -> Html
+ppForAll expl tvs cxt unicode qual
+  | show_forall = forall_part <+> ppLContext cxt unicode qual
+  | otherwise   = ppLContext cxt unicode qual
+  where
+    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
+    is_explicit = case expl of {Explicit -> True; Implicit -> False}
+    forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
+
+
+ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html
+ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
+
+
+ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html
+ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual
+  = maybeParen ctxt_prec pREC_FUN $
+    hsep [ppForAll expl tvs ctxt unicode qual, ppr_mono_lty pREC_TOP ty unicode qual]
+
+-- UnicodeSyntax alternatives
+ppr_mono_ty _ (HsTyVar name) True _
+  | getOccString (getName name) == "*"    = toHtml "★"
+  | getOccString (getName name) == "(->)" = toHtml "(→)"
+
+ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q ty
+ppr_mono_ty _         (HsTyVar name)      _ q = ppDocName q Prefix True name
+ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
+ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
+ppr_mono_ty _         (HsKindSig ty kind) u q =
+    parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
+ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
+ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
+ppr_mono_ty ctxt_prec (HsIParamTy n ty)   u q =
+    maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q
+ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
+ppr_mono_ty _         (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
+ppr_mono_ty _         (HsRecTy {})        _ _ = error "ppr_mono_ty HsRecTy"
+ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
+ppr_mono_ty _         (HsWrapTy {})       _ _ = error "ppr_mono_ty HsWrapTy"
+
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
+  = maybeParen ctxt_prec pREC_CTX $
+    ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
+
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
+  = maybeParen ctxt_prec pREC_CON $
+    hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
+
+ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual
+  = maybeParen ctxt_prec pREC_FUN $
+    ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
+  where
+    ppr_op = ppLDocName qual Infix op
+
+ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
+--  = parens (ppr_mono_lty pREC_TOP ty)
+  = ppr_mono_lty ctxt_prec ty unicode qual
+
+ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
+  = ppr_mono_lty ctxt_prec ty unicode qual
+
+ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
+
+ppr_tylit :: HsTyLit -> Html
+ppr_tylit (HsNumTy n) = toHtml (show n)
+ppr_tylit (HsStrTy s) = toHtml (show s)
+
+
+ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html
+ppr_fun_ty ctxt_prec ty1 ty2 unicode qual
+  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual
+        p2 = ppr_mono_lty pREC_TOP ty2 unicode qual
+    in
+    maybeParen ctxt_prec pREC_FUN $
+    hsep [p1, arrow unicode <+> p2]
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
new file mode 100644
index 00000000..5e27d9b0
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -0,0 +1,143 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.DocMarkup
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.DocMarkup (
+  docToHtml,
+  rdrDocToHtml,
+  origDocToHtml,
+  docToHtmlNoAnchors,
+
+  docElement, docSection, docSection_,
+) where
+
+import Control.Applicative ((<$>))
+
+import Haddock.Backends.Xhtml.Names
+import Haddock.Backends.Xhtml.Utils
+import Haddock.Types
+import Haddock.Utils
+import Haddock.Doc (combineDocumentation)
+
+import Text.XHtml hiding ( name, p, quote )
+import Data.Maybe (fromMaybe)
+
+import GHC
+
+parHtmlMarkup :: Qualification -> Bool
+              -> (Bool -> a -> Html) -> DocMarkup a Html
+parHtmlMarkup qual insertAnchors ppId = Markup {
+  markupEmpty                = noHtml,
+  markupString               = toHtml,
+  markupParagraph            = paragraph,
+  markupAppend               = (+++),
+  markupIdentifier           = thecode . ppId insertAnchors,
+  markupIdentifierUnchecked  = thecode . ppUncheckedLink qual,
+  markupModule               = \m -> let (mdl,ref) = break (=='#') m
+                                         -- Accomodate for old style
+                                         -- foo\#bar anchors
+                                         mdl' = case reverse mdl of
+                                           '\\':_ -> init mdl
+                                           _ -> mdl
+                                     in ppModuleRef (mkModuleName mdl') ref,
+  markupWarning              = thediv ! [theclass "warning"],
+  markupEmphasis             = emphasize,
+  markupBold                 = strong,
+  markupMonospaced           = thecode,
+  markupUnorderedList        = unordList,
+  markupOrderedList          = ordList,
+  markupDefList              = defList,
+  markupCodeBlock            = pre,
+  markupHyperlink            = \(Hyperlink url mLabel)
+                               -> if insertAnchors
+                                  then anchor ! [href url]
+                                       << fromMaybe url mLabel
+                                  else toHtml $ fromMaybe url mLabel,
+  markupAName                = \aname -> namedAnchor aname << "",
+  markupPic                  = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),
+  markupProperty             = pre . toHtml,
+  markupExample              = examplesToHtml,
+  markupHeader               = \(Header l t) -> makeHeader l t
+  }
+  where
+    makeHeader :: Int -> Html -> Html
+    makeHeader 1 mkup = h1 mkup
+    makeHeader 2 mkup = h2 mkup
+    makeHeader 3 mkup = h3 mkup
+    makeHeader 4 mkup = h4 mkup
+    makeHeader 5 mkup = h5 mkup
+    makeHeader 6 mkup = h6 mkup
+    makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
+
+
+    examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
+
+    exampleToHtml (Example expression result) = htmlExample
+      where
+        htmlExample = htmlPrompt +++ htmlExpression +++ toHtml (unlines result)
+        htmlPrompt = (thecode . toHtml $ ">>> ") ! [theclass "prompt"]
+        htmlExpression = (strong . thecode . toHtml $ expression ++ "\n") ! [theclass "userinput"]
+
+
+-- If the doc is a single paragraph, don't surround it with <P> (this causes
+-- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
+docToHtml :: Qualification -> Doc DocName -> Html
+docToHtml qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
+
+-- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
+-- in links. This is used to generate the Contents box elements.
+docToHtmlNoAnchors :: Qualification -> Doc DocName -> Html
+docToHtmlNoAnchors qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
+
+origDocToHtml :: Qualification -> Doc Name -> Html
+origDocToHtml qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual True (const $ ppName Raw)
+
+
+rdrDocToHtml :: Qualification -> Doc RdrName -> Html
+rdrDocToHtml qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual True (const ppRdrName)
+
+
+docElement :: (Html -> Html) -> Html -> Html
+docElement el content_ =
+  if isNoHtml content_
+    then el ! [theclass "doc empty"] << spaceHtml
+    else el ! [theclass "doc"] << content_
+
+
+docSection :: Qualification -> Documentation DocName -> Html
+docSection qual = maybe noHtml (docSection_ qual) . combineDocumentation
+
+
+docSection_ :: Qualification -> Doc DocName -> Html
+docSection_ qual = (docElement thediv <<) . docToHtml qual
+
+
+cleanup :: Doc a -> Doc a
+cleanup = markup fmtUnParagraphLists
+  where
+    -- 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. We don't do this in code blocks as it eliminates line breaks.
+    unParagraph :: Doc a -> Doc a
+    unParagraph (DocParagraph d) = d
+    unParagraph doc              = doc
+
+    fmtUnParagraphLists :: DocMarkup a (Doc a)
+    fmtUnParagraphLists = idMarkup {
+      markupUnorderedList = DocUnorderedList . map unParagraph,
+      markupOrderedList   = DocOrderedList   . map unParagraph
+      }
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
new file mode 100644
index 00000000..e84a57b3
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -0,0 +1,235 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Layout
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Layout (
+  miniBody,
+
+  divPackageHeader, divContent, divModuleHeader, divFooter,
+  divTableOfContents, divDescription, divSynposis, divInterface,
+  divIndex, divAlphabet, divModuleList,
+
+  sectionName,
+  nonEmptySectionName,
+
+  shortDeclList,
+  shortSubDecls,
+
+  divTopDecl,
+
+  SubDecl,
+  subArguments,
+  subAssociatedTypes,
+  subConstructors,
+  subEquations,
+  subFields,
+  subInstances,
+  subMethods,
+  subMinimal,
+
+  topDeclElem, declElem,
+) where
+
+
+import Haddock.Backends.Xhtml.DocMarkup
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
+import Haddock.Types
+import Haddock.Utils (makeAnchorId)
+
+import qualified Data.Map as Map
+import Text.XHtml hiding ( name, title, p, quote )
+
+import FastString            ( unpackFS )
+import GHC
+
+
+--------------------------------------------------------------------------------
+-- * Sections of the document
+--------------------------------------------------------------------------------
+
+
+miniBody :: Html -> Html
+miniBody = body ! [identifier "mini"]
+
+
+sectionDiv :: String -> Html -> Html
+sectionDiv i = thediv ! [identifier i]
+
+
+sectionName :: Html -> Html
+sectionName = paragraph ! [theclass "caption"]
+
+
+-- | Make an element that always has at least something (a non-breaking space).
+-- If it would have otherwise been empty, then give it the class ".empty".
+nonEmptySectionName :: Html -> Html
+nonEmptySectionName c
+  | isNoHtml c = paragraph ! [theclass "caption empty"] $ spaceHtml
+  | otherwise  = paragraph ! [theclass "caption"]       $ c
+
+
+divPackageHeader, divContent, divModuleHeader, divFooter,
+  divTableOfContents, divDescription, divSynposis, divInterface,
+  divIndex, divAlphabet, divModuleList
+    :: Html -> Html
+
+divPackageHeader    = sectionDiv "package-header"
+divContent          = sectionDiv "content"
+divModuleHeader     = sectionDiv "module-header"
+divFooter           = sectionDiv "footer"
+divTableOfContents  = sectionDiv "table-of-contents"
+divDescription      = sectionDiv "description"
+divSynposis         = sectionDiv "synopsis"
+divInterface        = sectionDiv "interface"
+divIndex            = sectionDiv "index"
+divAlphabet         = sectionDiv "alphabet"
+divModuleList       = sectionDiv "module-list"
+
+
+--------------------------------------------------------------------------------
+-- * Declaration containers
+--------------------------------------------------------------------------------
+
+
+shortDeclList :: [Html] -> Html
+shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
+
+
+shortSubDecls :: Bool -> [Html] -> Html
+shortSubDecls inst items = ulist ! [theclass c] << map (i <<) items
+  where i | inst      = li ! [theclass "inst"]
+          | otherwise = li
+        c | inst      = "inst"
+          | otherwise = "subs"
+
+
+divTopDecl :: Html -> Html
+divTopDecl = thediv ! [theclass "top"]
+
+
+type SubDecl = (Html, Maybe (Doc DocName), [Html])
+
+
+divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html
+divSubDecls cssClass captionName = maybe noHtml wrap
+  where
+    wrap = (subSection <<) . (subCaption +++)
+    subSection = thediv ! [theclass $ unwords ["subs", cssClass]]
+    subCaption = paragraph ! [theclass "caption"] << captionName
+
+
+subDlist :: Qualification -> [SubDecl] -> Maybe Html
+subDlist _ [] = Nothing
+subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv
+  where
+    subEntry (decl, mdoc, subs) =
+      dterm ! [theclass "src"] << decl
+      +++
+      docElement ddef << (fmap (docToHtml qual) mdoc +++ subs)
+
+    clearDiv = thediv ! [ theclass "clear" ] << noHtml
+
+
+subTable :: Qualification -> [SubDecl] -> Maybe Html
+subTable _ [] = Nothing
+subTable qual decls = Just $ table << aboves (concatMap subRow decls)
+  where
+    subRow (decl, mdoc, subs) =
+      (td ! [theclass "src"] << decl
+       <->
+       docElement td << fmap (docToHtml qual) mdoc)
+      : map (cell . (td <<)) subs
+
+
+subBlock :: [Html] -> Maybe Html
+subBlock [] = Nothing
+subBlock hs = Just $ toHtml hs
+
+
+subArguments :: Qualification -> [SubDecl] -> Html
+subArguments qual = divSubDecls "arguments" "Arguments" . subTable qual
+
+
+subAssociatedTypes :: [Html] -> Html
+subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock
+
+
+subConstructors :: Qualification -> [SubDecl] -> Html
+subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
+
+
+subFields :: Qualification -> [SubDecl] -> Html
+subFields qual = divSubDecls "fields" "Fields" . subDlist qual
+
+
+subEquations :: Qualification -> [SubDecl] -> Html
+subEquations qual = divSubDecls "equations" "Equations" . subTable qual
+
+
+subInstances :: Qualification -> String -> [SubDecl] -> Html
+subInstances qual nm = maybe noHtml wrap . instTable
+  where
+    wrap = (subSection <<) . (subCaption +++)
+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable qual
+    subSection = thediv ! [theclass "subs instances"]
+    subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
+    id_ = makeAnchorId $ "i:" ++ nm
+
+subMethods :: [Html] -> Html
+subMethods = divSubDecls "methods" "Methods" . subBlock
+
+subMinimal :: Html -> Html
+subMinimal = divSubDecls "minimal" "Minimal complete definition" . Just . declElem
+
+
+-- a box for displaying code
+declElem :: Html -> Html
+declElem = paragraph ! [theclass "src"]
+
+
+-- a box for top level documented names
+-- it adds a source and wiki link at the right hand side of the box
+topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
+topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names html =
+    declElem << (html <+> srcLink <+> wikiLink)
+  where srcLink = let nameUrl = Map.lookup origPkg sourceMap
+                      lineUrl = Map.lookup origPkg lineMap
+                      mUrl | splice    = lineUrl
+                                         -- Use the lineUrl as a backup
+                           | otherwise = maybe lineUrl Just nameUrl in
+          case mUrl of
+            Nothing  -> noHtml
+            Just url -> let url' = spliceURL (Just fname) (Just origMod)
+                                               (Just n) (Just loc) url
+                          in anchor ! [href url', theclass "link"] << "Source"
+
+        wikiLink =
+          case maybe_wiki_url of
+            Nothing  -> noHtml
+            Just url -> let url' = spliceURL (Just fname) (Just mdl)
+                                               (Just n) (Just loc) url
+                          in anchor ! [href url', theclass "link"] << "Comments"
+
+        -- For source links, we want to point to the original module,
+        -- because only that will have the source.
+        -- TODO: do something about type instances. They will point to
+        -- the module defining the type family, which is wrong.
+        origMod = nameModule n
+        origPkg = modulePackageId origMod
+
+        -- Name must be documented, otherwise we wouldn't get here
+        Documented n mdl = head names
+        -- FIXME: is it ok to simply take the first name?
+
+        fname = case loc of
+                RealSrcSpan l -> unpackFS (srcSpanFile l)
+                UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan"
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
new file mode 100644
index 00000000..cf12da40
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -0,0 +1,171 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Names
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Names (
+  ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,
+  ppBinder, ppBinderInfix, ppBinder',
+  ppModule, ppModuleRef, ppIPName, linkId, Notation(..)
+) where
+
+
+import Haddock.Backends.Xhtml.Utils
+import Haddock.GhcUtils
+import Haddock.Types
+import Haddock.Utils
+
+import Text.XHtml hiding ( name, title, p, quote )
+import qualified Data.Map as M
+import qualified Data.List as List
+
+import GHC
+import Name
+import RdrName
+import FastString (unpackFS)
+
+
+-- | Indicator of how to render a 'DocName' into 'Html'
+data Notation = Raw -- ^ Render as-is.
+              | Infix -- ^ Render using infix notation.
+              | Prefix -- ^ Render using prefix notation.
+                deriving (Eq, Show)
+
+ppOccName :: OccName -> Html
+ppOccName = toHtml . occNameString
+
+
+ppRdrName :: RdrName -> Html
+ppRdrName = ppOccName . rdrNameOcc
+
+ppIPName :: HsIPName -> Html
+ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS
+
+
+ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html
+ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName
+
+
+-- The Bool indicates if it is to be rendered in infix notation
+ppLDocName :: Qualification -> Notation -> Located DocName -> Html
+ppLDocName qual notation (L _ d) = ppDocName qual notation True d
+
+ppDocName :: Qualification -> Notation -> Bool -> DocName -> Html
+ppDocName qual notation insertAnchors docName =
+  case docName of
+    Documented name mdl ->
+      linkIdOcc mdl (Just (nameOccName name)) insertAnchors
+      << ppQualifyName qual notation name mdl
+    Undocumented name
+      | isExternalName name || isWiredInName name ->
+          ppQualifyName qual notation name (nameModule name)
+      | otherwise -> ppName notation name
+
+-- | Render a name depending on the selected qualification mode
+ppQualifyName :: Qualification -> Notation -> Name -> Module -> Html
+ppQualifyName qual notation name mdl =
+  case qual of
+    NoQual   -> ppName notation name
+    FullQual -> ppFullQualName notation mdl name
+    LocalQual localmdl ->
+      if moduleString mdl == moduleString localmdl
+        then ppName notation name
+        else ppFullQualName notation mdl name
+    RelativeQual localmdl ->
+      case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
+        -- local, A.x -> x
+        Just []      -> ppName notation name
+        -- sub-module, A.B.x -> B.x
+        Just ('.':m) -> toHtml $ m ++ '.' : getOccString name
+        -- some module with same prefix, ABC.x -> ABC.x
+        Just _       -> ppFullQualName notation mdl name
+        -- some other module, D.x -> D.x
+        Nothing      -> ppFullQualName notation mdl name
+    AliasedQual aliases localmdl ->
+      case (moduleString mdl == moduleString localmdl,
+            M.lookup mdl aliases) of
+        (False, Just alias) -> ppQualName notation alias name
+        _ -> ppName notation name
+
+
+ppFullQualName :: Notation -> Module -> Name -> Html
+ppFullQualName notation mdl name = wrapInfix notation (getOccName name) qname
+  where
+    qname = toHtml $ moduleString mdl ++ '.' : getOccString name
+
+ppQualName :: Notation -> ModuleName -> Name -> Html
+ppQualName notation mdlName name = wrapInfix notation (getOccName name) qname
+  where
+    qname = toHtml $ moduleNameString mdlName ++ '.' : getOccString name
+
+ppName :: Notation -> Name -> Html
+ppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccString name)
+
+
+ppBinder :: Bool -> OccName -> 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 n = linkedAnchor (nameAnchorId n) << ppBinder' Prefix n
+ppBinder False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
+                        << ppBinder' Prefix n
+
+ppBinderInfix :: Bool -> OccName -> Html
+ppBinderInfix True n = linkedAnchor (nameAnchorId n) << ppBinder' Infix n
+ppBinderInfix False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
+                             << ppBinder' Infix n
+
+ppBinder' :: Notation -> OccName -> Html
+ppBinder' notation n = wrapInfix notation n $ ppOccName n
+
+wrapInfix :: Notation -> OccName -> Html -> Html
+wrapInfix notation n = case notation of
+  Infix | is_star_kind -> id
+        | not is_sym -> quote
+  Prefix | is_star_kind -> id
+         | is_sym -> parens
+  _ -> id
+  where
+    is_sym = isSymOcc n
+    is_star_kind = isTcOcc n && occNameString n == "*"
+
+linkId :: Module -> Maybe Name -> Html -> Html
+linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True
+
+
+linkIdOcc :: Module -> Maybe OccName -> Bool -> Html -> Html
+linkIdOcc mdl mbName insertAnchors =
+  if insertAnchors
+  then anchor ! [href url]
+  else id
+  where
+    url = case mbName of
+      Nothing   -> moduleUrl mdl
+      Just name -> moduleNameUrl mdl name
+
+
+linkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html
+linkIdOcc' mdl mbName = anchor ! [href url]
+  where
+    url = case mbName of
+      Nothing   -> moduleHtmlFile' mdl
+      Just name -> moduleNameUrl' mdl name
+
+
+ppModule :: Module -> Html
+ppModule mdl = anchor ! [href (moduleUrl mdl)]
+               << toHtml (moduleString mdl)
+
+
+ppModuleRef :: ModuleName -> String -> Html
+ppModuleRef mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)]
+                      << toHtml (moduleNameString mdl)
+    -- NB: The ref parameter already includes the '#'.
+    -- This function is only called from markupModule expanding a
+    -- DocModule, which doesn't seem to be ever be used.
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
new file mode 100644
index 00000000..79b093ec
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
@@ -0,0 +1,209 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Themes
+-- Copyright   :  (c) Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Themes (
+    Themes,
+    getThemes,
+
+    cssFiles, styleSheet
+    )
+    where
+
+import Haddock.Options
+
+import Control.Applicative
+import Control.Monad (liftM)
+import Data.Char (toLower)
+import Data.Either (lefts, rights)
+import Data.List (nub)
+import Data.Maybe (isJust, listToMaybe)
+
+import System.Directory
+import System.FilePath
+import Text.XHtml hiding ( name, title, p, quote, (</>) )
+import qualified Text.XHtml as XHtml
+
+
+--------------------------------------------------------------------------------
+-- * CSS Themes
+--------------------------------------------------------------------------------
+
+data Theme = Theme {
+  themeName :: String,
+  themeHref :: String,
+  themeFiles :: [FilePath]
+  }
+
+type Themes = [Theme]
+
+type PossibleTheme = Either String Theme
+type PossibleThemes = Either String Themes
+
+
+-- | Find a theme by name (case insensitive match)
+findTheme :: String -> Themes -> Maybe Theme
+findTheme s = listToMaybe . filter ((== ls).lower.themeName)
+  where lower = map toLower
+        ls = lower s
+
+
+-- | Standard theme used by default
+standardTheme :: FilePath -> IO PossibleThemes
+standardTheme libDir = liftM (liftEither (take 1)) (defaultThemes libDir)
+
+
+-- | Default themes that are part of Haddock; added with --default-themes
+-- The first theme in this list is considered the standard theme.
+-- Themes are "discovered" by scanning the html sub-dir of the libDir,
+-- and looking for directories with the extension .theme or .std-theme.
+-- The later is, obviously, the standard theme.
+defaultThemes :: FilePath -> IO PossibleThemes
+defaultThemes libDir = do
+  themeDirs <- getDirectoryItems (libDir </> "html")
+  themes <- mapM directoryTheme $ discoverThemes themeDirs
+  return $ sequenceEither themes
+  where
+    discoverThemes paths =
+      filterExt ".std-theme" paths ++ filterExt ".theme" paths
+    filterExt ext = filter ((== ext).takeExtension)
+
+
+-- | Build a theme from a single .css file
+singleFileTheme :: FilePath -> IO PossibleTheme
+singleFileTheme path =
+  if isCssFilePath path
+      then retRight $ Theme name file [path]
+      else errMessage "File extension isn't .css" path
+  where
+    name = takeBaseName path
+    file = takeFileName path
+
+
+-- | Build a theme from a directory
+directoryTheme :: FilePath -> IO PossibleTheme
+directoryTheme path = do
+  items <- getDirectoryItems path
+  case filter isCssFilePath items of
+    [cf] -> retRight $ Theme (takeBaseName path) (takeFileName cf) items
+    [] -> errMessage "No .css file in theme directory" path
+    _ -> errMessage "More than one .css file in theme directory" path
+
+
+-- | Check if we have a built in theme
+doesBuiltInExist :: IO PossibleThemes -> String -> IO Bool
+doesBuiltInExist pts s = fmap (either (const False) test) pts
+  where test = isJust . findTheme s
+
+
+-- | Find a built in theme
+builtInTheme :: IO PossibleThemes -> String -> IO PossibleTheme
+builtInTheme pts s = either Left fetch <$> pts
+  where fetch = maybe (Left ("Unknown theme: " ++ s)) Right . findTheme s
+
+
+--------------------------------------------------------------------------------
+-- * CSS Theme Arguments
+--------------------------------------------------------------------------------
+
+-- | Process input flags for CSS Theme arguments
+getThemes :: FilePath -> [Flag] -> IO PossibleThemes
+getThemes libDir flags =
+  liftM concatEither (mapM themeFlag flags) >>= someTheme
+  where
+    themeFlag :: Flag -> IO (Either String Themes)
+    themeFlag (Flag_CSS path) = (liftM . liftEither) (:[]) (theme path)
+    themeFlag (Flag_BuiltInThemes) = builtIns
+    themeFlag _ = retRight []
+
+    theme :: FilePath -> IO PossibleTheme
+    theme path = pick path
+      [(doesFileExist,              singleFileTheme),
+       (doesDirectoryExist,         directoryTheme),
+       (doesBuiltInExist builtIns,  builtInTheme builtIns)]
+      "Theme not found"
+
+    pick :: FilePath
+      -> [(FilePath -> IO Bool, FilePath -> IO PossibleTheme)] -> String
+      -> IO PossibleTheme
+    pick path [] msg = errMessage msg path
+    pick path ((test,build):opts) msg = do
+      pass <- test path
+      if pass then build path else pick path opts msg
+
+
+    someTheme :: Either String Themes -> IO (Either String Themes)
+    someTheme (Right []) = standardTheme libDir
+    someTheme est = return est
+
+    builtIns = defaultThemes libDir
+
+
+errMessage :: String -> FilePath -> IO (Either String a)
+errMessage msg path = return (Left msg')
+  where msg' = "Error: " ++ msg ++ ": \"" ++ path ++ "\"\n"
+
+
+retRight :: a -> IO (Either String a)
+retRight = return . Right
+
+
+--------------------------------------------------------------------------------
+-- * File Utilities
+--------------------------------------------------------------------------------
+
+
+getDirectoryItems :: FilePath -> IO [FilePath]
+getDirectoryItems path =
+  map (combine path) . filter notDot <$> getDirectoryContents path
+  where notDot s = s /= "." && s /= ".."
+
+
+isCssFilePath :: FilePath -> Bool
+isCssFilePath path = takeExtension path == ".css"
+
+
+--------------------------------------------------------------------------------
+-- * Style Sheet Utilities
+--------------------------------------------------------------------------------
+
+cssFiles :: Themes -> [String]
+cssFiles ts = nub $ concatMap themeFiles ts
+
+
+styleSheet :: Themes -> Html
+styleSheet ts = toHtml $ zipWith mkLink rels ts
+  where
+    rels = "stylesheet" : repeat "alternate stylesheet"
+    mkLink aRel t =
+      thelink
+        ! [ href (themeHref t),  rel aRel, thetype "text/css",
+            XHtml.title (themeName t)
+          ]
+        << noHtml
+
+--------------------------------------------------------------------------------
+-- * Either Utilities
+--------------------------------------------------------------------------------
+
+-- These three routines are here because Haddock does not have access to the
+-- Control.Monad.Error module which supplies the Functor and Monad instances
+-- for Either String.
+
+sequenceEither :: [Either a b] -> Either a [b]
+sequenceEither es = maybe (Right $ rights es) Left (listToMaybe (lefts es))
+
+
+liftEither :: (b -> c) -> Either a b -> Either a c
+liftEither f = either Left (Right . f)
+
+
+concatEither :: [Either a [b]] -> Either a [b]
+concatEither = liftEither concat . sequenceEither
+
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
new file mode 100644
index 00000000..122861c3
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
@@ -0,0 +1,37 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Types
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Types (
+  SourceURLs, WikiURLs,
+  LinksInfo,
+  Splice,
+  Unicode,
+) where
+
+
+import Data.Map
+import GHC
+
+
+-- the base, module and entity URLs for the source code and wiki links.
+type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageId FilePath, Map PackageId FilePath)
+type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)
+
+
+-- The URL for source and wiki links
+type LinksInfo = (SourceURLs, WikiURLs)
+
+-- Whether something is a splice or not
+type Splice = Bool
+
+-- Whether unicode syntax is to be used
+type Unicode = Bool
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
new file mode 100644
index 00000000..cbcbbd6d
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -0,0 +1,218 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Backends.Html.Util
+-- Copyright   :  (c) Simon Marlow   2003-2006,
+--                    David Waern    2006-2009,
+--                    Mark Lentczner 2010
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Backends.Xhtml.Utils (
+  renderToString,
+
+  namedAnchor, linkedAnchor,
+  spliceURL,
+  groupId,
+
+  (<+>), (<=>), char,
+  keyword, punctuate,
+
+  braces, brackets, pabrackets, parens, parenList, ubxParenList,
+  arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote,
+
+  hsep, vcat,
+
+  collapseSection, collapseToggle, collapseControl,
+) where
+
+
+import Haddock.GhcUtils
+import Haddock.Utils
+
+import Data.Maybe
+
+import Text.XHtml hiding ( name, title, p, quote )
+import qualified Text.XHtml as XHtml
+
+import GHC      ( SrcSpan(..), srcSpanStartLine, Name )
+import Module   ( Module )
+import Name     ( getOccString, nameOccName, isValOcc )
+
+
+spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
+             Maybe SrcSpan -> String -> String
+spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
+ where
+  file = fromMaybe "" maybe_file
+  mdl = case maybe_mod of
+          Nothing           -> ""
+          Just m -> moduleString m
+
+  (name, kind) =
+    case maybe_name of
+      Nothing             -> ("","")
+      Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v")
+             | otherwise -> (escapeStr (getOccString n), "t")
+
+  line = case maybe_loc of
+    Nothing -> ""
+    Just span_ ->
+      case span_ of
+      RealSrcSpan span__ ->
+        show $ srcSpanStartLine span__
+      UnhelpfulSpan _ ->
+        error "spliceURL UnhelpfulSpan"
+
+  run "" = ""
+  run ('%':'M':rest) = mdl  ++ run rest
+  run ('%':'F':rest) = file ++ run rest
+  run ('%':'N':rest) = name ++ run rest
+  run ('%':'K':rest) = kind ++ run rest
+  run ('%':'L':rest) = line ++ run rest
+  run ('%':'%':rest) = '%'   : run rest
+
+  run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl  ++ 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) mdl ++ run rest
+
+  run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) =
+    map (\x -> if x == '/' then c else x) file ++ run rest
+
+  run ('%':'{':'L':'I':'N':'E':'}':rest)         = line ++ run rest
+
+  run (c:rest) = c : run rest
+
+
+renderToString :: Bool -> Html -> String
+renderToString debug html
+  | debug = renderHtml html
+  | otherwise = showHtml html
+
+
+hsep :: [Html] -> Html
+hsep [] = noHtml
+hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
+
+-- | Concatenate a series of 'Html' values vertically, with linebreaks in between.
+vcat :: [Html] -> Html
+vcat [] = noHtml
+vcat htmls = foldr1 (\a b -> a+++br+++b) htmls
+
+
+infixr 8 <+>
+(<+>) :: Html -> Html -> Html
+a <+> b = a +++ sep +++ b
+  where
+    sep = if isNoHtml a || isNoHtml b then noHtml else toHtml " "
+
+-- | Join two 'Html' values together with a linebreak in between.
+--   Has 'noHtml' as left identity.
+infixr 8 <=>
+(<=>) :: Html -> Html -> Html
+a <=> b = a +++ sep +++ b
+  where
+    sep = if isNoHtml a then noHtml else br
+
+
+keyword :: String -> Html
+keyword s = thespan ! [theclass "keyword"] << toHtml s
+
+
+equals, comma :: Html
+equals = char '='
+comma  = char ','
+
+
+char :: Char -> Html
+char c = toHtml [c]
+
+
+quote :: Html -> Html
+quote h = char '`' +++ h +++ '`'
+
+
+parens, brackets, pabrackets, 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
+
+
+parenList :: [Html] -> Html
+parenList = parens . hsep . punctuate comma
+
+
+ubxParenList :: [Html] -> Html
+ubxParenList = ubxparens . hsep . punctuate comma
+
+
+ubxparens :: Html -> Html
+ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
+
+
+dcolon, arrow, darrow, forallSymbol :: Bool -> Html
+dcolon unicode = toHtml (if unicode then "∷" else "::")
+arrow  unicode = toHtml (if unicode then "→" else "->")
+darrow unicode = toHtml (if unicode then "⇒" else "=>")
+forallSymbol unicode = if unicode then toHtml "∀" else keyword "forall"
+
+
+dot :: Html
+dot = toHtml "."
+
+
+-- | Generate a named anchor
+namedAnchor :: String -> Html -> Html
+namedAnchor n = anchor ! [XHtml.name n]
+
+
+linkedAnchor :: String -> Html -> Html
+linkedAnchor n = anchor ! [href ('#':n)]
+
+
+-- | generate an anchor identifier for a group
+groupId :: String -> String
+groupId g = makeAnchorId ("g:" ++ g)
+
+--
+-- A section of HTML which is collapsible.
+--
+
+-- | Attributes for an area that can be collapsed
+collapseSection :: String -> Bool -> String -> [HtmlAttr]
+collapseSection id_ state classes = [ identifier sid, theclass cs ]
+  where cs = unwords (words classes ++ [pick state "show" "hide"])
+        sid = "section." ++ id_
+
+-- | Attributes for an area that toggles a collapsed area
+collapseToggle :: String -> [HtmlAttr]
+collapseToggle id_ = [ strAttr "onclick" js ]
+  where js = "toggleSection('" ++ id_ ++ "')";
+  
+-- | Attributes for an area that toggles a collapsed area,
+-- and displays a control.
+collapseControl :: String -> Bool -> String -> [HtmlAttr]
+collapseControl id_ state classes =
+  [ identifier cid, theclass cs ] ++ collapseToggle id_
+  where cs = unwords (words classes ++ [pick state "collapser" "expander"])
+        cid = "control." ++ id_
+
+
+pick :: Bool -> a -> a -> a
+pick True  t _ = t
+pick False _ f = f
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
new file mode 100644
index 00000000..73ff3f1a
--- /dev/null
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -0,0 +1,403 @@
+{-# LANGUAGE CPP, PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Convert
+-- Copyright   :  (c) Isaac Dupree 2009,
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Conversion between TyThing and HsDecl. This functionality may be moved into
+-- GHC at some point.
+-----------------------------------------------------------------------------
+module Haddock.Convert where
+-- Some other functions turned out to be useful for converting
+-- instance heads, which aren't TyThings, so just export everything.
+
+
+import HsSyn
+import TcType ( tcSplitSigmaTy )
+import TypeRep
+import Type(isStrLitTy)
+import Kind ( splitKindFunTys, synTyConResKind, isKind )
+import Name
+import Var
+import Class
+import TyCon
+import CoAxiom
+import ConLike
+import DataCon
+import PatSyn
+import FamInstEnv
+import BasicTypes ( TupleSort(..) )
+import TysPrim ( alphaTyVars )
+import TysWiredIn ( listTyConName, eqTyCon )
+import PrelNames (ipClassName)
+import Bag ( emptyBag )
+import Unique ( getUnique )
+import SrcLoc ( Located, noLoc, unLoc )
+import Data.List( partition )
+import Haddock.Types
+
+
+-- the main function here! yay!
+tyThingToLHsDecl :: TyThing -> LHsDecl Name
+tyThingToLHsDecl t = noLoc $ case t of
+  -- ids (functions and zero-argument a.k.a. CAFs) get a type signature.
+  -- Including built-in functions like seq.
+  -- foreign-imported functions could be represented with ForD
+  -- instead of SigD if we wanted...
+  --
+  -- in a future code version we could turn idVarDetails = foreign-call
+  -- into a ForD instead of a SigD if we wanted.  Haddock doesn't
+  -- need to care.
+  AnId i -> SigD (synifyIdSig ImplicitizeForAll i)
+
+  -- type-constructors (e.g. Maybe) are complicated, put the definition
+  -- later in the file (also it's used for class associated-types too.)
+  ATyCon tc
+    | Just cl <- tyConClass_maybe tc -- classes are just a little tedious
+    -> let extractFamilyDecl :: TyClDecl a -> LFamilyDecl a
+           extractFamilyDecl (FamDecl d) = noLoc d
+           extractFamilyDecl _           =
+             error "tyThingToLHsDecl: impossible associated tycon"
+
+           atTyClDecls = [synifyTyCon Nothing at_tc | (at_tc, _) <- classATItems cl]
+           atFamDecls  = map extractFamilyDecl atTyClDecls in
+       TyClD $ ClassDecl
+         { tcdCtxt = synifyCtx (classSCTheta cl)
+         , tcdLName = synifyName cl
+         , tcdTyVars = synifyTyVars (classTyVars cl)
+         , tcdFDs = map (\ (l,r) -> noLoc
+                        (map getName l, map getName r) ) $
+                         snd $ classTvsFds cl
+         , tcdSigs = noLoc (MinimalSig . fmap noLoc $ classMinimalDef cl) :
+                      map (noLoc . synifyIdSig DeleteTopLevelQuantification)
+                        (classMethods cl)
+         , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
+         -- class associated-types are a subset of TyCon:
+         , tcdATs = atFamDecls
+         , tcdATDefs = [] --ignore associated type defaults
+         , tcdDocs = [] --we don't have any docs at this point
+         , tcdFVs = placeHolderNames }
+    | otherwise
+    -> TyClD (synifyTyCon Nothing tc)
+
+  -- type-constructors (e.g. Maybe) are complicated, put the definition
+  -- later in the file (also it's used for class associated-types too.)
+  ACoAxiom ax -> synifyAxiom ax
+
+  -- a data-constructor alone just gets rendered as a function:
+  AConLike (RealDataCon dc) -> SigD (TypeSig [synifyName dc]
+    (synifyType ImplicitizeForAll (dataConUserType dc)))
+
+  AConLike (PatSynCon ps) ->
+#if MIN_VERSION_ghc(7,8,3)
+      let (_, _, req_theta, prov_theta, _, res_ty) = patSynSig ps
+#else
+      let (_, _, (req_theta, prov_theta)) = patSynSig ps
+#endif
+      in SigD $ PatSynSig (synifyName ps)
+#if MIN_VERSION_ghc(7,8,3)
+                          (fmap (synifyType WithinType) (patSynTyDetails ps))
+                          (synifyType WithinType res_ty)
+#else
+                          (fmap (synifyType WithinType) (patSynTyDetails ps))
+                          (synifyType WithinType (patSynType ps))
+#endif
+                          (synifyCtx req_theta)
+                          (synifyCtx prov_theta)
+
+synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn Name
+synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
+  = let name       = synifyName tc
+        typats     = map (synifyType WithinType) args
+        hs_rhs     = synifyType WithinType rhs
+        (kvs, tvs) = partition isKindVar tkvs
+    in TyFamInstEqn { tfie_tycon = name
+                    , tfie_pats  = HsWB { hswb_cts = typats
+                                        , hswb_kvs = map tyVarName kvs
+                                        , hswb_tvs = map tyVarName tvs }
+                    , tfie_rhs   = hs_rhs }
+
+synifyAxiom :: CoAxiom br -> HsDecl Name
+synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
+  | isOpenSynFamilyTyCon tc
+  , Just branch <- coAxiomSingleBranch_maybe ax
+  = InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch
+                                     , tfid_fvs = placeHolderNames }))
+
+  | Just ax' <- isClosedSynFamilyTyCon_maybe tc
+  , getUnique ax' == getUnique ax   -- without the getUniques, type error
+  = TyClD (synifyTyCon (Just ax) tc)
+
+  | otherwise
+  = error "synifyAxiom: closed/open family confusion"
+
+synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> TyClDecl Name
+synifyTyCon coax tc
+  | isFunTyCon tc || isPrimTyCon tc 
+  = DataDecl { tcdLName = synifyName tc
+             , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
+                         let mk_hs_tv realKind fakeTyVar 
+                                = noLoc $ KindedTyVar (getName fakeTyVar) 
+                                                      (synifyKindSig realKind)
+                         in HsQTvs { hsq_kvs = []   -- No kind polymorphism
+                                   , hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc)))
+                                                                alphaTyVars --a, b, c... which are unfortunately all kind *
+                                   }
+                            
+           , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither 
+                                                    -- algebraic data nor newtype:
+                                      , dd_ctxt = noLoc []
+                                      , dd_cType = Nothing
+                                      , dd_kindSig = Just (synifyKindSig (tyConKind tc))
+                                               -- we have their kind accurately:
+                                      , dd_cons = []  -- No constructors
+                                      , dd_derivs = Nothing }
+           , tcdFVs = placeHolderNames }
+
+  | isSynFamilyTyCon tc 
+  = case synTyConRhs_maybe tc of
+      Just rhs ->
+        let info = case rhs of
+                     OpenSynFamilyTyCon -> OpenTypeFamily
+                     ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) ->
+                       ClosedTypeFamily (brListMap (noLoc . synifyAxBranch tc) branches)
+                     _ -> error "synifyTyCon: type/data family confusion"
+        in FamDecl (FamilyDecl { fdInfo = info
+                               , fdLName = synifyName tc
+                               , fdTyVars = synifyTyVars (tyConTyVars tc)
+                               , fdKindSig = Just (synifyKindSig (synTyConResKind tc)) })
+      Nothing -> error "synifyTyCon: impossible open type synonym?"
+
+  | isDataFamilyTyCon tc 
+  = --(why no "isOpenAlgTyCon"?)
+    case algTyConRhs tc of
+        DataFamilyTyCon ->
+          FamDecl (FamilyDecl DataFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
+                              Nothing) --always kind '*'
+        _ -> error "synifyTyCon: impossible open data type?"
+  | isSynTyCon tc
+  = case synTyConRhs_maybe tc of
+        Just (SynonymTyCon ty) ->
+          SynDecl { tcdLName = synifyName tc
+                  , tcdTyVars = synifyTyVars (tyConTyVars tc)
+                  , tcdRhs = synifyType WithinType ty
+                  , tcdFVs = placeHolderNames }
+        _ -> error "synifyTyCon: impossible synTyCon"
+  | otherwise =
+  -- (closed) newtype and data
+  let
+  alg_nd = if isNewTyCon tc then NewType else DataType
+  alg_ctx = synifyCtx (tyConStupidTheta tc)
+  name = case coax of
+    Just a -> synifyName a -- Data families are named according to their
+                           -- CoAxioms, not their TyCons
+    _ -> synifyName tc
+  tyvars = synifyTyVars (tyConTyVars tc)
+  kindSig = Just (tyConKind tc)
+  -- The data constructors.
+  --
+  -- Any data-constructors not exported from the module that *defines* the
+  -- type will not (cannot) be included.
+  --
+  -- Very simple constructors, Haskell98 with no existentials or anything,
+  -- probably look nicer in non-GADT syntax.  In source code, all constructors
+  -- must be declared with the same (GADT vs. not) syntax, and it probably
+  -- is less confusing to follow that principle for the documentation as well.
+  --
+  -- There is no sensible infix-representation for GADT-syntax constructor
+  -- declarations.  They cannot be made in source code, but we could end up
+  -- with some here in the case where some constructors use existentials.
+  -- That seems like an acceptable compromise (they'll just be documented
+  -- in prefix position), since, otherwise, the logic (at best) gets much more
+  -- complicated. (would use dataConIsInfix.)
+  use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc)
+  cons = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc)
+  -- "deriving" doesn't affect the signature, no need to specify any.
+  alg_deriv = Nothing
+  defn = HsDataDefn { dd_ND      = alg_nd
+                    , dd_ctxt    = alg_ctx
+                    , dd_cType   = Nothing
+                    , dd_kindSig = fmap synifyKindSig kindSig
+                    , dd_cons    = cons 
+                    , dd_derivs  = alg_deriv }
+ in DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
+             , tcdFVs = placeHolderNames }
+
+-- User beware: it is your responsibility to pass True (use_gadt_syntax)
+-- for any constructor that would be misrepresented by omitting its
+-- result-type.
+-- But you might want pass False in simple enough cases,
+-- if you think it looks better.
+synifyDataCon :: Bool -> DataCon -> LConDecl Name
+synifyDataCon use_gadt_syntax dc = noLoc $
+ let
+  -- dataConIsInfix allegedly tells us whether it was declared with
+  -- infix *syntax*.
+  use_infix_syntax = dataConIsInfix dc
+  use_named_field_syntax = not (null field_tys)
+  name = synifyName dc
+  -- con_qvars means a different thing depending on gadt-syntax
+  (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc
+
+  qvars = if use_gadt_syntax
+          then synifyTyVars (univ_tvs ++ ex_tvs)
+          else synifyTyVars ex_tvs
+
+  -- skip any EqTheta, use 'orig'inal syntax
+  ctx = synifyCtx theta
+
+  linear_tys = zipWith (\ty bang ->
+            let tySyn = synifyType WithinType ty
+                src_bang = case bang of
+                             HsUnpack {} -> HsUserBang (Just True) True
+                             HsStrict    -> HsUserBang (Just False) True
+                             _           -> bang
+            in case src_bang of
+                 HsNoBang -> tySyn
+                 _        -> noLoc $ HsBangTy bang tySyn
+            -- HsNoBang never appears, it's implied instead.
+          )
+          arg_tys (dataConStrictMarks dc)
+  field_tys = zipWith (\field synTy -> ConDeclField
+                                           (synifyName field) synTy Nothing)
+                (dataConFieldLabels dc) linear_tys
+  hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
+          (True,True) -> error "synifyDataCon: contradiction!"
+          (True,False) -> RecCon field_tys
+          (False,False) -> PrefixCon linear_tys
+          (False,True) -> case linear_tys of
+                           [a,b] -> InfixCon a b
+                           _ -> error "synifyDataCon: infix with non-2 args?"
+  hs_res_ty = if use_gadt_syntax
+              then ResTyGADT (synifyType WithinType res_ty)
+              else ResTyH98
+ -- finally we get synifyDataCon's result!
+ in ConDecl name Implicit{-we don't know nor care-}
+      qvars ctx hs_arg_tys hs_res_ty Nothing
+      False --we don't want any "deprecated GADT syntax" warnings!
+
+
+synifyName :: NamedThing n => n -> Located Name
+synifyName = noLoc . getName
+
+
+synifyIdSig :: SynifyTypeState -> Id -> Sig Name
+synifyIdSig s i = TypeSig [synifyName i] (synifyType s (varType i))
+
+
+synifyCtx :: [PredType] -> LHsContext Name
+synifyCtx = noLoc . map (synifyType WithinType)
+
+
+synifyTyVars :: [TyVar] -> LHsTyVarBndrs Name
+synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
+                           , hsq_tvs = map synifyTyVar tvs }
+  where
+    (kvs, tvs) = partition isKindVar ktvs
+    synifyTyVar tv 
+      | isLiftedTypeKind kind = noLoc (UserTyVar name)
+      | otherwise             = noLoc (KindedTyVar name (synifyKindSig kind))
+      where
+        kind = tyVarKind tv
+        name = getName tv
+
+--states of what to do with foralls:
+data SynifyTypeState
+  = WithinType
+  -- ^ normal situation.  This is the safe one to use if you don't
+  -- quite understand what's going on.
+  | ImplicitizeForAll
+  -- ^ beginning of a function definition, in which, to make it look
+  --   less ugly, those rank-1 foralls are made implicit.
+  | DeleteTopLevelQuantification
+  -- ^ because in class methods the context is added to the type
+  --   (e.g. adding @forall a. Num a =>@ to @(+) :: a -> a -> a@)
+  --   which is rather sensible,
+  --   but we want to restore things to the source-syntax situation where
+  --   the defining class gets to quantify all its functions for free!
+
+
+synifyType :: SynifyTypeState -> Type -> LHsType Name
+synifyType _ (TyVarTy tv) = noLoc $ HsTyVar (getName tv)
+synifyType _ (TyConApp tc tys)
+  -- Use non-prefix tuple syntax where possible, because it looks nicer.
+  | isTupleTyCon tc, tyConArity tc == length tys =
+     noLoc $ HsTupleTy (case tupleTyConSort tc of
+                          BoxedTuple      -> HsBoxedTuple
+                          ConstraintTuple -> HsConstraintTuple
+                          UnboxedTuple    -> HsUnboxedTuple)
+                       (map (synifyType WithinType) tys)
+  -- ditto for lists
+  | getName tc == listTyConName, [ty] <- tys =
+     noLoc $ HsListTy (synifyType WithinType ty)
+  -- ditto for implicit parameter tycons
+  | tyConName tc == ipClassName
+  , [name, ty] <- tys
+  , Just x <- isStrLitTy name
+  = noLoc $ HsIParamTy (HsIPName x) (synifyType WithinType ty)
+  -- and equalities
+  | tc == eqTyCon
+  , [ty1, ty2] <- tys
+  = noLoc $ HsEqTy (synifyType WithinType ty1) (synifyType WithinType ty2)
+  -- Most TyCons:
+  | otherwise =
+    foldl (\t1 t2 -> noLoc (HsAppTy t1 t2))
+      (noLoc $ HsTyVar (getName tc))
+      (map (synifyType WithinType) tys)
+synifyType _ (AppTy t1 t2) = let
+  s1 = synifyType WithinType t1
+  s2 = synifyType WithinType t2
+  in noLoc $ HsAppTy s1 s2
+synifyType _ (FunTy t1 t2) = let
+  s1 = synifyType WithinType t1
+  s2 = synifyType WithinType t2
+  in noLoc $ HsFunTy s1 s2
+synifyType s forallty@(ForAllTy _tv _ty) =
+  let (tvs, ctx, tau) = tcSplitSigmaTy forallty
+  in case s of
+    DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau
+    _ -> let
+      forallPlicitness = case s of
+              WithinType -> Explicit
+              ImplicitizeForAll -> Implicit
+              _ -> error "synifyType: impossible case!!!"
+      sTvs = synifyTyVars tvs
+      sCtx = synifyCtx ctx
+      sTau = synifyType WithinType tau
+     in noLoc $
+           HsForAllTy forallPlicitness sTvs sCtx sTau
+synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t
+
+synifyTyLit :: TyLit -> HsTyLit
+synifyTyLit (NumTyLit n) = HsNumTy n
+synifyTyLit (StrTyLit s) = HsStrTy s
+
+synifyKindSig :: Kind -> LHsKind Name
+synifyKindSig k = synifyType WithinType k
+
+synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
+synifyInstHead (_, preds, cls, types) =
+  ( getName cls
+  , map (unLoc . synifyType WithinType) ks
+  , map (unLoc . synifyType WithinType) ts
+  , ClassInst $ map (unLoc . synifyType WithinType) preds
+  )
+  where (ks,ts) = break (not . isKind) types
+
+-- Convert a family instance, this could be a type family or data family
+synifyFamInst :: FamInst -> Bool -> InstHead Name
+synifyFamInst fi opaque =
+  ( fi_fam fi
+  , map (unLoc . synifyType WithinType) ks
+  , map (unLoc . synifyType WithinType) ts
+  , case fi_flavor fi of
+      SynFamilyInst | opaque -> TypeInst Nothing
+      SynFamilyInst -> TypeInst . Just . unLoc . synifyType WithinType $ fi_rhs fi
+      DataFamilyInst c -> DataInst $ synifyTyCon (Just $ famInstAxiom fi) c
+  )
+  where (ks,ts) = break (not . isKind) $ fi_tys fi
diff --git a/haddock-api/src/Haddock/Doc.hs b/haddock-api/src/Haddock/Doc.hs
new file mode 100644
index 00000000..91ad709f
--- /dev/null
+++ b/haddock-api/src/Haddock/Doc.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Haddock.Doc ( module Documentation.Haddock.Doc
+                   , docCodeBlock
+                   , combineDocumentation
+                   ) where
+
+import Data.Maybe
+import Documentation.Haddock.Doc
+import Haddock.Types
+
+combineDocumentation :: Documentation name -> Maybe (Doc name)
+combineDocumentation (Documentation Nothing Nothing) = Nothing
+combineDocumentation (Documentation mDoc mWarning)   =
+  Just (fromMaybe DocEmpty mWarning `docAppend` fromMaybe DocEmpty mDoc)
+
+-- Drop trailing whitespace from @..@ code blocks.  Otherwise this:
+--
+--    -- @
+--    -- foo
+--    -- @
+--
+-- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML
+-- gives an extra vertical space after the code block.  The single space
+-- on the final line seems to trigger the extra vertical space.
+--
+docCodeBlock :: DocH mod id -> DocH mod id
+docCodeBlock (DocString s)
+  = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
+docCodeBlock (DocAppend l r)
+  = DocAppend l (docCodeBlock r)
+docCodeBlock d = d
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
new file mode 100644
index 00000000..c06b34a6
--- /dev/null
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -0,0 +1,304 @@
+{-# LANGUAGE FlexibleInstances, ViewPatterns #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.GhcUtils
+-- Copyright   :  (c) David Waern 2006-2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Utils for dealing with types from the GHC API
+-----------------------------------------------------------------------------
+module Haddock.GhcUtils where
+
+
+import Data.Version
+import Control.Applicative  ( (<$>) )
+import Control.Arrow
+import Data.Foldable hiding (concatMap)
+import Data.Function
+import Data.Traversable
+import Distribution.Compat.ReadP
+import Distribution.Text
+
+import Exception
+import Outputable
+import Name
+import Packages
+import Module
+import RdrName (GlobalRdrEnv)
+import GhcMonad (withSession)
+import HscTypes
+import UniqFM
+import GHC
+import Class
+
+
+moduleString :: Module -> String
+moduleString = moduleNameString . moduleName
+
+
+-- return the (name,version) of the package
+modulePackageInfo :: Module -> (String, [Char])
+modulePackageInfo modu = case unpackPackageId pkg of
+                          Nothing -> (packageIdString pkg, "")
+                          Just x -> (display $ pkgName x, showVersion (pkgVersion x))
+  where pkg = modulePackageId modu
+
+
+-- This was removed from GHC 6.11
+-- XXX we shouldn't be using it, probably
+
+-- | Try and interpret a GHC 'PackageId' as a cabal 'PackageIdentifer'. Returns @Nothing@ if
+-- we could not parse it as such an object.
+unpackPackageId :: PackageId -> Maybe PackageIdentifier
+unpackPackageId p
+  = case [ pid | (pid,"") <- readP_to_S parse str ] of
+        []      -> Nothing
+        (pid:_) -> Just pid
+  where str = packageIdString p
+
+
+lookupLoadedHomeModuleGRE  :: GhcMonad m => ModuleName -> m (Maybe GlobalRdrEnv)
+lookupLoadedHomeModuleGRE mod_name = withSession $ \hsc_env ->
+  case lookupUFM (hsc_HPT hsc_env) mod_name of
+    Just mod_info      -> return (mi_globals (hm_iface mod_info))
+    _not_a_home_module -> return Nothing
+
+
+isNameSym :: Name -> Bool
+isNameSym = isSymOcc . nameOccName
+
+
+isVarSym :: OccName -> Bool
+isVarSym = isLexVarSym . occNameFS
+
+isConSym :: OccName -> Bool
+isConSym = isLexConSym . occNameFS
+
+
+getMainDeclBinder :: HsDecl name -> [name]
+getMainDeclBinder (TyClD d) = [tcdName d]
+getMainDeclBinder (ValD d) =
+  case collectHsBindBinders d of
+    []       -> []
+    (name:_) -> [name]
+getMainDeclBinder (SigD d) = sigNameNoLoc d
+getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
+getMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []
+getMainDeclBinder _ = []
+
+-- Extract the source location where an instance is defined. This is used
+-- to correlate InstDecls with their Instance/CoAxiom Names, via the
+-- instanceMap.
+getInstLoc :: InstDecl name -> SrcSpan
+getInstLoc (ClsInstD (ClsInstDecl { cid_poly_ty = L l _ })) = l
+getInstLoc (DataFamInstD (DataFamInstDecl { dfid_tycon = L l _ })) = l
+getInstLoc (TyFamInstD (TyFamInstDecl
+  -- Since CoAxioms' Names refer to the whole line for type family instances
+  -- in particular, we need to dig a bit deeper to pull out the entire
+  -- equation. This does not happen for data family instances, for some reason.
+  { tfid_eqn = L _ (TyFamInstEqn { tfie_rhs = L l _ })})) = l
+
+-- Useful when there is a signature with multiple names, e.g.
+--   foo, bar :: Types..
+-- but only one of the names is exported and we have to change the
+-- type signature to only include the exported names.
+filterLSigNames :: (name -> Bool) -> LSig name -> Maybe (LSig name)
+filterLSigNames p (L loc sig) = L loc <$> (filterSigNames p sig)
+
+filterSigNames :: (name -> Bool) -> Sig name -> Maybe (Sig name)
+filterSigNames p orig@(SpecSig n _ _)          = ifTrueJust (p $ unLoc n) orig
+filterSigNames p orig@(InlineSig n _)          = ifTrueJust (p $ unLoc n) orig
+filterSigNames p orig@(FixSig (FixitySig n _)) = ifTrueJust (p $ unLoc n) orig
+filterSigNames _ orig@(MinimalSig _)           = Just orig
+filterSigNames p (TypeSig ns ty)               =
+  case filter (p . unLoc) ns of
+    []       -> Nothing
+    filtered -> Just (TypeSig filtered ty)
+filterSigNames _ _                           = Nothing
+
+ifTrueJust :: Bool -> name -> Maybe name
+ifTrueJust True  = Just
+ifTrueJust False = const Nothing
+
+sigName :: LSig name -> [name]
+sigName (L _ sig) = sigNameNoLoc sig
+
+sigNameNoLoc :: Sig name -> [name]
+sigNameNoLoc (TypeSig   ns _)         = map unLoc ns
+sigNameNoLoc (PatSynSig n _ _ _ _)    = [unLoc n]
+sigNameNoLoc (SpecSig   n _ _)        = [unLoc n]
+sigNameNoLoc (InlineSig n _)          = [unLoc n]
+sigNameNoLoc (FixSig (FixitySig n _)) = [unLoc n]
+sigNameNoLoc _                        = []
+
+
+isTyClD :: HsDecl a -> Bool
+isTyClD (TyClD _) = True
+isTyClD _ = False
+
+
+isClassD :: HsDecl a -> Bool
+isClassD (TyClD d) = isClassDecl d
+isClassD _ = False
+
+
+isDocD :: HsDecl a -> Bool
+isDocD (DocD _) = True
+isDocD _ = False
+
+
+isInstD :: HsDecl a -> Bool
+isInstD (InstD _) = True
+isInstD _ = False
+
+
+isValD :: HsDecl a -> Bool
+isValD (ValD _) = True
+isValD _ = False
+
+
+declATs :: HsDecl a -> [a]
+declATs (TyClD d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d
+declATs _ = []
+
+
+pretty :: Outputable a => DynFlags -> a -> String
+pretty = showPpr
+
+
+trace_ppr :: Outputable a => DynFlags -> a -> b -> b
+trace_ppr dflags x y = trace (pretty dflags x) y
+
+
+-------------------------------------------------------------------------------
+-- * Located
+-------------------------------------------------------------------------------
+
+
+unL :: Located a -> a
+unL (L _ x) = x
+
+
+reL :: a -> Located a
+reL = L undefined
+
+
+before :: Located a -> Located a -> Bool
+before = (<) `on` getLoc
+
+
+instance Foldable (GenLocated l) where
+  foldMap f (L _ x) = f x
+
+
+instance Traversable (GenLocated l) where
+  mapM f (L l x) = (return . L l) =<< f x
+  traverse f (L l x) = L l <$> f x
+
+-------------------------------------------------------------------------------
+-- * NamedThing instances
+-------------------------------------------------------------------------------
+
+
+instance NamedThing (TyClDecl Name) where
+  getName = tcdName
+
+
+instance NamedThing (ConDecl Name) where
+  getName = unL . con_name
+
+
+-------------------------------------------------------------------------------
+-- * Subordinates
+-------------------------------------------------------------------------------
+
+
+class Parent a where
+  children :: a -> [Name]
+
+
+instance Parent (ConDecl Name) where
+  children con =
+    case con_details con of
+      RecCon fields -> map (unL . cd_fld_name) fields
+      _             -> []
+
+
+instance Parent (TyClDecl Name) where
+  children d
+    | isDataDecl  d = map (unL . con_name . unL) . dd_cons . tcdDataDefn $ d
+    | isClassDecl d =
+        map (unL . fdLName . unL) (tcdATs d) ++
+        [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ]
+    | otherwise = []
+
+
+-- | A parent and its children
+family :: (NamedThing a, Parent a) => a -> (Name, [Name])
+family = getName &&& children
+
+
+-- | A mapping from the parent (main-binder) to its children and from each
+-- child to its grand-children, recursively.
+families :: TyClDecl Name -> [(Name, [Name])]
+families d
+  | isDataDecl  d = family d : map (family . unL) (dd_cons (tcdDataDefn d))
+  | isClassDecl d = [family d]
+  | otherwise     = []
+
+
+-- | A mapping from child to parent
+parentMap :: TyClDecl Name -> [(Name, Name)]
+parentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ]
+
+
+-- | The parents of a subordinate in a declaration
+parents :: Name -> HsDecl Name -> [Name]
+parents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ]
+parents _ _ = []
+
+
+-------------------------------------------------------------------------------
+-- * Utils that work in monads defined by GHC
+-------------------------------------------------------------------------------
+
+
+modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()
+modifySessionDynFlags f = do
+  dflags <- getSessionDynFlags
+  _ <- setSessionDynFlags (f dflags)
+  return ()
+
+
+-- | A variant of 'gbracket' where the return value from the first computation
+-- is not required.
+gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c
+gbracket_ before_ after thing = gbracket before_ (const after) (const thing)
+
+-- Extract the minimal complete definition of a Name, if one exists
+minimalDef :: GhcMonad m => Name -> m (Maybe ClassMinimalDef)
+minimalDef n = do
+  mty <- lookupGlobalName n
+  case mty of
+    Just (ATyCon (tyConClass_maybe -> Just c)) -> return . Just $ classMinimalDef c
+    _ -> return Nothing
+
+-------------------------------------------------------------------------------
+-- * DynFlags
+-------------------------------------------------------------------------------
+
+
+setObjectDir, setHiDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags
+setObjectDir  f d = d{ objectDir  = Just f}
+setHiDir      f d = d{ hiDir      = Just f}
+setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
+  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
+  -- \#included from the .hc file when compiling with -fvia-C.
+setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
+
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
new file mode 100644
index 00000000..60a20fe5
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -0,0 +1,244 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2010,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module typechecks Haskell modules using the GHC API and processes
+-- the result to create 'Interface's. The typechecking and the 'Interface'
+-- creation is interleaved, so that when a module is processed, the
+-- 'Interface's of all previously processed modules are available. The
+-- creation of an 'Interface' from a typechecked module is delegated to
+-- "Haddock.Interface.Create".
+--
+-- When all modules have been typechecked and processed, information about
+-- instances are attached to each 'Interface'. This task is delegated to
+-- "Haddock.Interface.AttachInstances". Note that this is done as a separate
+-- step because GHC can't know about all instances until all modules have been
+-- typechecked.
+--
+-- As a last step a link environment is built which maps names to the \"best\"
+-- places to link to in the documentation, and all 'Interface's are \"renamed\"
+-- using this environment.
+-----------------------------------------------------------------------------
+module Haddock.Interface (
+  processModules
+) where
+
+
+import Haddock.GhcUtils
+import Haddock.InterfaceFile
+import Haddock.Interface.Create
+import Haddock.Interface.AttachInstances
+import Haddock.Interface.Rename
+import Haddock.Options hiding (verbosity)
+import Haddock.Types
+import Haddock.Utils
+
+import Control.Monad
+import Data.List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Distribution.Verbosity
+import System.Directory
+import System.FilePath
+import Text.Printf
+
+import Digraph
+import DynFlags hiding (verbosity)
+import Exception
+import GHC hiding (verbosity)
+import HscTypes
+import FastString (unpackFS)
+
+-- | Create 'Interface's and a link environment by typechecking the list of
+-- modules using the GHC API and processing the resulting syntax trees.
+processModules
+  :: Verbosity                  -- ^ Verbosity of logging to 'stdout'
+  -> [String]                   -- ^ A list of file or module names sorted by
+                                -- module topology
+  -> [Flag]                     -- ^ Command-line flags
+  -> [InterfaceFile]            -- ^ Interface files of package dependencies
+  -> Ghc ([Interface], LinkEnv) -- ^ Resulting list of interfaces and renaming
+                                -- environment
+processModules verbosity modules flags extIfaces = do
+
+  out verbosity verbose "Creating interfaces..."
+  let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces
+                                   , iface <- ifInstalledIfaces ext ]
+  interfaces <- createIfaces0 verbosity modules flags instIfaceMap
+
+  let exportedNames =
+        Set.unions $ map (Set.fromList . ifaceExports) $
+        filter (\i -> not $ OptHide `elem` ifaceOptions i) interfaces
+      mods = Set.fromList $ map ifaceMod interfaces
+  out verbosity verbose "Attaching instances..."
+  interfaces' <- attachInstances (exportedNames, mods) interfaces instIfaceMap
+
+  out verbosity verbose "Building cross-linking environment..."
+  -- Combine the link envs of the external packages into one
+  let extLinks  = Map.unions (map ifLinkEnv extIfaces)
+      homeLinks = buildHomeLinks interfaces -- Build the environment for the home
+                                            -- package
+      links     = homeLinks `Map.union` extLinks
+
+  out verbosity verbose "Renaming interfaces..."
+  let warnings = Flag_NoWarnings `notElem` flags
+  dflags <- getDynFlags
+  let (interfaces'', msgs) =
+         runWriter $ mapM (renameInterface dflags links warnings) interfaces'
+  liftIO $ mapM_ putStrLn msgs
+
+  return (interfaces'', homeLinks)
+
+
+--------------------------------------------------------------------------------
+-- * Module typechecking and Interface creation
+--------------------------------------------------------------------------------
+
+
+createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]
+createIfaces0 verbosity modules flags instIfaceMap =
+  -- Output dir needs to be set before calling depanal since depanal uses it to
+  -- compute output file names that are stored in the DynFlags of the
+  -- resulting ModSummaries.
+  (if useTempDir then withTempOutputDir else id) $ do
+    modGraph <- depAnalysis
+    if needsTemplateHaskell modGraph then do
+      modGraph' <- enableCompilation modGraph
+      createIfaces verbosity flags instIfaceMap modGraph'
+    else
+      createIfaces verbosity flags instIfaceMap modGraph
+
+  where
+    useTempDir :: Bool
+    useTempDir = Flag_NoTmpCompDir `notElem` flags
+
+
+    withTempOutputDir :: Ghc a -> Ghc a
+    withTempOutputDir action = do
+      tmp <- liftIO getTemporaryDirectory
+      x   <- liftIO getProcessID
+      let dir = tmp </> ".haddock-" ++ show x
+      modifySessionDynFlags (setOutputDir dir)
+      withTempDir dir action
+
+
+    depAnalysis :: Ghc ModuleGraph
+    depAnalysis = do
+      targets <- mapM (\f -> guessTarget f Nothing) modules
+      setTargets targets
+      depanal [] False
+
+
+    enableCompilation :: ModuleGraph -> Ghc ModuleGraph
+    enableCompilation modGraph = do
+      let enableComp d = let platform = targetPlatform d
+                         in d { hscTarget = defaultObjectTarget platform }
+      modifySessionDynFlags enableComp
+      -- We need to update the DynFlags of the ModSummaries as well.
+      let upd m = m { ms_hspp_opts = enableComp (ms_hspp_opts m) }
+      let modGraph' = map upd modGraph
+      return modGraph'
+
+
+createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc [Interface]
+createIfaces verbosity flags instIfaceMap mods = do
+  let sortedMods = flattenSCCs $ topSortModuleGraph False mods Nothing
+  out verbosity normal "Haddock coverage:"
+  (ifaces, _) <- foldM f ([], Map.empty) sortedMods
+  return (reverse ifaces)
+  where
+    f (ifaces, ifaceMap) modSummary = do
+      x <- processModule verbosity modSummary flags ifaceMap instIfaceMap
+      return $ case x of
+        Just iface -> (iface:ifaces, Map.insert (ifaceMod iface) iface ifaceMap)
+        Nothing    -> (ifaces, ifaceMap) -- Boot modules don't generate ifaces.
+
+
+processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface)
+processModule verbosity modsum flags modMap instIfaceMap = do
+  out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
+  tm <- loadModule =<< typecheckModule =<< parseModule modsum
+  if not $ isBootSummary modsum then do
+    out verbosity verbose "Creating interface..."
+    (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
+    liftIO $ mapM_ putStrLn msg
+    dflags <- getDynFlags
+    let (haddockable, haddocked) = ifaceHaddockCoverage interface
+        percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
+        modString = moduleString (ifaceMod interface)
+        coverageMsg = printf " %3d%% (%3d /%3d) in '%s'" percentage haddocked haddockable modString
+        header = case ifaceDoc interface of
+          Documentation Nothing _ -> False
+          _ -> True
+        undocumentedExports = [ formatName s n | ExportDecl { expItemDecl = L s n
+                                                            , expItemMbDoc = (Documentation Nothing _, _)
+                                                            } <- ifaceExportItems interface ]
+          where
+            formatName :: SrcSpan -> HsDecl Name -> String
+            formatName loc n = p (getMainDeclBinder n) ++ case loc of
+              RealSrcSpan rss -> " (" ++ unpackFS (srcSpanFile rss) ++ ":" ++ show (srcSpanStartLine rss) ++ ")"
+              _ -> ""
+
+            p [] = ""
+            p (x:_) = let n = pretty dflags x
+                          ms = modString ++ "."
+                      in if ms `isPrefixOf` n
+                         then drop (length ms) n
+                         else n
+
+    out verbosity normal coverageMsg
+    when (Flag_PrintMissingDocs `elem` flags
+          && not (null undocumentedExports && header)) $ do
+      out verbosity normal "  Missing documentation for:"
+      unless header $ out verbosity normal "    Module header"
+      mapM_ (out verbosity normal . ("    " ++)) undocumentedExports
+    interface' <- liftIO $ evaluate interface
+    return (Just interface')
+  else
+    return Nothing
+
+
+--------------------------------------------------------------------------------
+-- * Building of cross-linking environment
+--------------------------------------------------------------------------------
+
+
+-- | 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 :: [Interface] -> LinkEnv
+buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces)
+  where
+    upd old_env iface
+      | OptHide    `elem` ifaceOptions iface = old_env
+      | OptNotHome `elem` ifaceOptions iface =
+        foldl' keep_old old_env exported_names
+      | otherwise = foldl' keep_new old_env exported_names
+      where
+        exported_names = ifaceVisibleExports iface
+        mdl            = ifaceMod iface
+        keep_old env n = Map.insertWith (\_ old -> old) n mdl env
+        keep_new env n = Map.insert n mdl env
+
+
+--------------------------------------------------------------------------------
+-- * Utils
+--------------------------------------------------------------------------------
+
+
+withTempDir :: (ExceptionMonad m, MonadIO m) => FilePath -> m a -> m a
+withTempDir dir = gbracket_ (liftIO $ createDirectory dir)
+                            (liftIO $ removeDirectoryRecursive dir)
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
new file mode 100644
index 00000000..a0bac8fc
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -0,0 +1,221 @@
+{-# LANGUAGE CPP, MagicHash #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.AttachInstances
+-- Copyright   :  (c) Simon Marlow 2006,
+--                    David Waern  2006-2009,
+--                    Isaac Dupree 2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.AttachInstances (attachInstances) where
+
+
+import Haddock.Types
+import Haddock.Convert
+import Haddock.GhcUtils
+
+import Control.Arrow
+import Data.List
+import Data.Ord (comparing)
+import Data.Function (on)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import Class
+import FamInstEnv
+import FastString
+import GHC
+import GhcMonad (withSession)
+import Id
+import InstEnv
+import MonadUtils (liftIO)
+import Name
+import PrelNames
+import TcRnDriver (tcRnGetInfo)
+import TcType (tcSplitSigmaTy)
+import TyCon
+import TypeRep
+import TysPrim( funTyCon )
+import Var hiding (varName)
+#define FSLIT(x) (mkFastString# (x#))
+
+type ExportedNames = Set.Set Name
+type Modules = Set.Set Module
+type ExportInfo = (ExportedNames, Modules)
+
+-- Also attaches fixities
+attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
+attachInstances expInfo ifaces instIfaceMap = mapM attach ifaces
+  where
+    -- TODO: take an IfaceMap as input
+    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
+
+    attach iface = do
+      newItems <- mapM (attachToExportItem expInfo iface ifaceMap instIfaceMap)
+                       (ifaceExportItems iface)
+      return $ iface { ifaceExportItems = newItems }
+
+
+attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
+attachToExportItem expInfo iface ifaceMap instIfaceMap export =
+  case attachFixities export of
+    e@ExportDecl { expItemDecl = L _ (TyClD d) } -> do
+      mb_info <- getAllInfo (tcdName d)
+      let export' =
+            e {
+              expItemInstances =
+                case mb_info of
+                  Just (_, _, cls_instances, fam_instances) ->
+                    let fam_insts = [ (synifyFamInst i opaque, n)
+                                    | i <- sortBy (comparing instFam) fam_instances
+                                    , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap
+                                    , not $ isNameHidden expInfo (fi_fam i)
+                                    , not $ any (isTypeHidden expInfo) (fi_tys i)
+                                    , let opaque = isTypeHidden expInfo (fi_rhs i)
+                                    ]
+                        cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
+                                    | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
+                                    , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
+                                    , not $ isInstanceHidden expInfo cls tys
+                                    ]
+                    in cls_insts ++ fam_insts
+                  Nothing -> []
+            }
+      return export'
+    e -> return e
+  where
+    attachFixities e@ExportDecl{ expItemDecl = L _ d } = e { expItemFixities =
+      nubBy ((==) `on` fst) $ expItemFixities e ++
+      [ (n',f) | n <- getMainDeclBinder d
+              , Just subs <- [instLookup instSubMap n iface ifaceMap instIfaceMap]
+              , n' <- n : subs
+              , Just f <- [instLookup instFixMap n' iface ifaceMap instIfaceMap]
+      ] }
+
+    attachFixities e = e
+
+
+instLookup :: (InstalledInterface -> Map.Map Name a) -> Name
+            -> Interface -> IfaceMap -> InstIfaceMap -> Maybe a
+instLookup f name iface ifaceMap instIfaceMap =
+  case Map.lookup name (f $ toInstalledIface iface) of
+    res@(Just _) -> res
+    Nothing -> do
+      let ifaceMaps = Map.union (fmap toInstalledIface ifaceMap) instIfaceMap
+      iface' <- Map.lookup (nameModule name) ifaceMaps
+      Map.lookup name (f iface')
+
+-- | Like GHC's 'instanceHead' but drops "silent" arguments.
+instanceHead' :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
+instanceHead' ispec = (tvs, dropSilentArgs dfun theta, cls, tys)
+  where
+    dfun = is_dfun ispec
+    (tvs, cls, tys) = instanceHead ispec
+    (_, theta, _) = tcSplitSigmaTy (idType dfun)
+
+-- | Drop "silent" arguments. See GHC Note [Silent superclass
+-- arguments].
+dropSilentArgs :: DFunId -> ThetaType -> ThetaType
+dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
+
+
+-- | Like GHC's getInfo but doesn't cut things out depending on the
+-- interative context, which we don't set sufficiently anyway.
+getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst]))
+getAllInfo name = withSession $ \hsc_env -> do 
+   (_msgs, r) <- liftIO $ tcRnGetInfo hsc_env name
+   return r
+
+
+--------------------------------------------------------------------------------
+-- Collecting and sorting instances
+--------------------------------------------------------------------------------
+
+
+-- | Simplified type for sorting types, ignoring qualification (not visible
+-- in Haddock output) and unifying special tycons with normal ones.
+-- For the benefit of the user (looks nice and predictable) and the
+-- tests (which prefer output to be deterministic).
+data SimpleType = SimpleType Name [SimpleType]
+                | SimpleTyLit TyLit
+                  deriving (Eq,Ord)
+
+
+instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])
+instHead (_, _, cls, args)
+  = (map argCount args, className cls, map simplify args)
+
+argCount :: Type -> Int
+argCount (AppTy t _) = argCount t + 1
+argCount (TyConApp _ ts) = length ts
+argCount (FunTy _ _ ) = 2
+argCount (ForAllTy _ t) = argCount t
+argCount _ = 0
+
+simplify :: Type -> SimpleType
+simplify (ForAllTy _ t) = simplify t
+simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2]
+simplify (AppTy t1 t2) = SimpleType s (ts ++ [simplify t2])
+  where (SimpleType s ts) = simplify t1
+simplify (TyVarTy v) = SimpleType (tyVarName v) []
+simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
+simplify (LitTy l) = SimpleTyLit l
+
+-- Used for sorting
+instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
+instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
+  = (map argCount ts, n, map simplify ts, argCount t, simplify t)
+
+
+funTyConName :: Name
+funTyConName = mkWiredInName gHC_PRIM
+                        (mkOccNameFS tcName FSLIT("(->)"))
+                        funTyConKey
+                        (ATyCon funTyCon)       -- Relevant TyCon
+                        BuiltInSyntax
+
+--------------------------------------------------------------------------------
+-- Filtering hidden instances
+--------------------------------------------------------------------------------
+
+-- | A class or data type is hidden iff
+--
+-- * it is defined in one of the modules that are being processed
+--
+-- * and it is not exported by any non-hidden module
+isNameHidden :: ExportInfo -> Name -> Bool
+isNameHidden (names, modules) name =
+  nameModule name `Set.member` modules &&
+  not (name `Set.member` names)
+
+-- | We say that an instance is «hidden» iff its class or any (part)
+-- of its type(s) is hidden.
+isInstanceHidden :: ExportInfo -> Class -> [Type] -> Bool
+isInstanceHidden expInfo cls tys =
+    instClassHidden || instTypeHidden
+  where
+    instClassHidden :: Bool
+    instClassHidden = isNameHidden expInfo $ getName cls
+
+    instTypeHidden :: Bool
+    instTypeHidden = any (isTypeHidden expInfo) tys
+
+isTypeHidden :: ExportInfo -> Type -> Bool
+isTypeHidden expInfo = typeHidden
+  where
+    typeHidden :: Type -> Bool
+    typeHidden t =
+      case t of
+        TyVarTy {} -> False
+        AppTy t1 t2 -> typeHidden t1 || typeHidden t2
+        TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args
+        FunTy t1 t2 -> typeHidden t1 || typeHidden t2
+        ForAllTy _ ty -> typeHidden ty
+        LitTy _ -> False
+
+    nameHidden :: Name -> Bool
+    nameHidden = isNameHidden expInfo
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
new file mode 100644
index 00000000..b66773ae
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -0,0 +1,867 @@
+{-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-}
+{-# OPTIONS_GHC -Wwarn #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.Create
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.Create (createInterface) where
+
+import Documentation.Haddock.Doc (docAppend)
+import Haddock.Types
+import Haddock.Options
+import Haddock.GhcUtils
+import Haddock.Utils
+import Haddock.Convert
+import Haddock.Interface.LexParseRn
+
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Ord
+import Control.Applicative
+import Control.Arrow (second)
+import Control.DeepSeq
+import Control.Monad
+import Data.Function (on)
+import qualified Data.Foldable as F
+
+import qualified Packages
+import qualified Module
+import qualified SrcLoc
+import GHC
+import HscTypes
+import Name
+import Bag
+import RdrName
+import TcRnTypes
+import FastString (concatFS)
+
+
+-- | Use a 'TypecheckedModule' to produce an 'Interface'.
+-- To do this, we need access to already processed modules in the topological
+-- sort. That's what's in the 'IfaceMap'.
+createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface
+createInterface tm flags modMap instIfaceMap = do
+
+  let ms             = pm_mod_summary . tm_parsed_module $ tm
+      mi             = moduleInfo tm
+      L _ hsm        = parsedSource tm
+      !safety        = modInfoSafe mi
+      mdl            = ms_mod ms
+      dflags         = ms_hspp_opts ms
+      !instances     = modInfoInstances mi
+      !fam_instances = md_fam_insts md
+      !exportedNames = modInfoExports mi
+
+      (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, md) = tm_internals_ tm
+
+  -- The renamed source should always be available to us, but it's best
+  -- to be on the safe side.
+  (group_, mayExports, mayDocHeader) <-
+    case renamedSource tm of
+      Nothing -> do
+        liftErrMsg $ tell [ "Warning: Renamed source is not available." ]
+        return (emptyRnGroup, Nothing, Nothing)
+      Just (x, _, y, z) -> return (x, y, z)
+
+  opts0 <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl
+  let opts
+        | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0
+        | otherwise = opts0
+
+  (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
+
+  let declsWithDocs = topDecls group_
+      fixMap = mkFixMap group_
+      (decls, _) = unzip declsWithDocs
+      localInsts = filter (nameIsLocalOrFrom mdl) $  map getName instances
+                                                  ++ map getName fam_instances
+      -- Locations of all TH splices
+      splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]
+
+      maps@(!docMap, !argMap, !subMap, !declMap, _) =
+        mkMaps dflags gre localInsts declsWithDocs
+
+  let exports0 = fmap (reverse . map unLoc) mayExports
+      exports
+        | OptIgnoreExports `elem` opts = Nothing
+        | otherwise = exports0
+      warningMap = mkWarningMap dflags warnings gre exportedNames
+
+  let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
+
+  exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls
+                   maps fixMap splices exports instIfaceMap dflags
+
+  let !visibleNames = mkVisibleNames maps exportItems opts
+
+  -- Measure haddock documentation coverage.
+  let prunedExportItems0 = pruneExportItems exportItems
+      !haddockable = 1 + length exportItems -- module + exports
+      !haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0
+      !coverage = (haddockable, haddocked)
+
+  -- Prune the export list to just those declarations that have
+  -- documentation, if the 'prune' option is on.
+  let prunedExportItems'
+        | OptPrune `elem` opts = prunedExportItems0
+        | otherwise = exportItems
+      !prunedExportItems = seqList prunedExportItems' `seq` prunedExportItems'
+
+  let !aliases =
+        mkAliasMap dflags $ tm_renamed_source tm
+      modWarn = moduleWarning dflags gre warnings
+
+  return $! Interface {
+    ifaceMod             = mdl
+  , ifaceOrigFilename    = msHsFilePath ms
+  , ifaceInfo            = info
+  , ifaceDoc             = Documentation mbDoc modWarn
+  , ifaceRnDoc           = Documentation Nothing Nothing
+  , ifaceOptions         = opts
+  , ifaceDocMap          = docMap
+  , ifaceArgMap          = argMap
+  , ifaceRnDocMap        = M.empty
+  , ifaceRnArgMap        = M.empty
+  , ifaceExportItems     = prunedExportItems
+  , ifaceRnExportItems   = []
+  , ifaceExports         = exportedNames
+  , ifaceVisibleExports  = visibleNames
+  , ifaceDeclMap         = declMap
+  , ifaceSubMap          = subMap
+  , ifaceFixMap          = fixMap
+  , ifaceModuleAliases   = aliases
+  , ifaceInstances       = instances
+  , ifaceFamInstances    = fam_instances
+  , ifaceHaddockCoverage = coverage
+  , ifaceWarningMap      = warningMap
+  }
+
+mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
+mkAliasMap dflags mRenamedSource =
+  case mRenamedSource of
+    Nothing -> M.empty
+    Just (_,impDecls,_,_) ->
+      M.fromList $
+      mapMaybe (\(SrcLoc.L _ impDecl) -> do
+        alias <- ideclAs impDecl
+        return $
+          (lookupModuleDyn dflags
+             (fmap Module.fsToPackageId $
+              ideclPkgQual impDecl)
+             (case ideclName impDecl of SrcLoc.L _ name -> name),
+           alias))
+        impDecls
+
+-- similar to GHC.lookupModule
+lookupModuleDyn ::
+  DynFlags -> Maybe PackageId -> ModuleName -> Module
+lookupModuleDyn _ (Just pkgId) mdlName =
+  Module.mkModule pkgId mdlName
+lookupModuleDyn dflags Nothing mdlName =
+  flip Module.mkModule mdlName $
+  case filter snd $
+       Packages.lookupModuleInAllPackages dflags mdlName of
+    (pkgId,_):_ -> Packages.packageConfigId pkgId
+    [] -> Module.mainPackageId
+
+
+-------------------------------------------------------------------------------
+-- Warnings
+-------------------------------------------------------------------------------
+
+mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> WarningMap
+mkWarningMap dflags warnings gre exps = case warnings of
+  NoWarnings  -> M.empty
+  WarnAll _   -> M.empty
+  WarnSome ws ->
+    let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ
+              , let n = gre_name elt, n `elem` exps ]
+    in M.fromList $ map (second $ parseWarning dflags gre) ws'
+
+moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> Maybe (Doc Name)
+moduleWarning _ _ NoWarnings = Nothing
+moduleWarning _ _ (WarnSome _) = Nothing
+moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w
+
+parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name
+parseWarning dflags gre w = force $ case w of
+  DeprecatedTxt msg -> format "Deprecated: " (concatFS msg)
+  WarningTxt    msg -> format "Warning: "    (concatFS msg)
+  where
+    format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
+                  . processDocString dflags gre $ HsDocString xs
+
+
+-------------------------------------------------------------------------------
+-- Doc options
+--
+-- Haddock options that are embedded in the source file
+-------------------------------------------------------------------------------
+
+
+mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
+mkDocOpts mbOpts flags mdl = do
+  opts <- case mbOpts of
+    Just opts -> case words $ replace ',' ' ' opts of
+      [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return []
+      xs -> liftM catMaybes (mapM parseOption xs)
+    Nothing -> return []
+  hm <- if Flag_HideModule (moduleString mdl) `elem` flags
+        then return $ OptHide : opts
+        else return opts
+  if Flag_ShowExtensions (moduleString mdl) `elem` flags
+    then return $ OptShowExtensions : hm
+    else return hm
+
+
+parseOption :: String -> ErrMsgM (Maybe DocOption)
+parseOption "hide"            = return (Just OptHide)
+parseOption "prune"           = return (Just OptPrune)
+parseOption "ignore-exports"  = return (Just OptIgnoreExports)
+parseOption "not-home"        = return (Just OptNotHome)
+parseOption "show-extensions" = return (Just OptShowExtensions)
+parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
+
+
+--------------------------------------------------------------------------------
+-- Maps
+--------------------------------------------------------------------------------
+
+
+type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap, InstMap)
+
+-- | Create 'Maps' by looping through the declarations. For each declaration,
+-- find its names, its subordinates, and its doc strings. Process doc strings
+-- into 'Doc's.
+mkMaps :: DynFlags
+       -> GlobalRdrEnv
+       -> [Name]
+       -> [(LHsDecl Name, [HsDocString])]
+       -> Maps
+mkMaps dflags gre instances decls =
+  let (a, b, c, d) = unzip4 $ map mappings decls
+  in (f' $ map (nubBy ((==) `on` fst)) a , f b, f c, f d, instanceMap)
+  where
+    f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
+    f = M.fromListWith (<>) . concat
+
+    f' :: [[(Name, Doc Name)]] -> Map Name (Doc Name)
+    f' = M.fromListWith docAppend . concat
+
+    mappings :: (LHsDecl Name, [HsDocString])
+             -> ( [(Name, Doc Name)]
+                , [(Name, Map Int (Doc Name))]
+                , [(Name, [Name])]
+                , [(Name,  [LHsDecl Name])]
+                )
+    mappings (ldecl, docStrs) =
+      let L l decl = ldecl
+          declDoc :: [HsDocString] -> Map Int HsDocString
+                  -> (Maybe (Doc Name), Map Int (Doc Name))
+          declDoc strs m =
+            let doc' = processDocStrings dflags gre strs
+                m' = M.map (processDocStringParas dflags gre) m
+            in (doc', m')
+          (doc, args) = declDoc docStrs (typeDocs decl)
+          subs :: [(Name, [HsDocString], Map Int HsDocString)]
+          subs = subordinates instanceMap decl
+          (subDocs, subArgs) = unzip $ map (\(_, strs, m) -> declDoc strs m) subs
+          ns = names l decl
+          subNs = [ n | (n, _, _) <- subs ]
+          dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ]
+          am = [ (n, args) | n <- ns ] ++ zip subNs subArgs
+          sm = [ (n, subNs) | n <- ns ]
+          cm = [ (n, [ldecl]) | n <- ns ++ subNs ]
+      in seqList ns `seq`
+          seqList subNs `seq`
+          doc `seq`
+          seqList subDocs `seq`
+          seqList subArgs `seq`
+          (dm, am, sm, cm)
+
+    instanceMap :: Map SrcSpan Name
+    instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
+
+    names :: SrcSpan -> HsDecl Name -> [Name]
+    names l (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+      where loc = case d of
+              TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
+              _ -> getInstLoc d
+    names _ decl = getMainDeclBinder decl
+
+-- Note [2]:
+------------
+-- We relate ClsInsts to InstDecls using the SrcSpans buried inside them.
+-- That should work for normal user-written instances (from looking at GHC
+-- sources). We can assume that commented instances are user-written.
+-- This lets us relate Names (from ClsInsts) to comments (associated
+-- with InstDecls).
+
+
+--------------------------------------------------------------------------------
+-- Declarations
+--------------------------------------------------------------------------------
+
+
+-- | Get all subordinate declarations inside a declaration, and their docs.
+subordinates :: InstMap -> HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)]
+subordinates instMap decl = case decl of
+  InstD (ClsInstD d) -> do
+    DataFamInstDecl { dfid_tycon = L l _
+                    , dfid_defn = def    } <- unLoc <$> cid_datafam_insts d
+    [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs def
+
+  InstD (DataFamInstD d)  -> dataSubs (dfid_defn d)
+  TyClD d | isClassDecl d -> classSubs d
+          | isDataDecl  d -> dataSubs (tcdDataDefn d)
+  _ -> []
+  where
+    classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd
+                   , name <- getMainDeclBinder d, not (isValD d)
+                   ]
+    dataSubs dd = constrs ++ fields
+      where
+        cons = map unL $ (dd_cons dd)
+        constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty)
+                  | c <- cons ]
+        fields  = [ (unL n, maybeToList $ fmap unL doc, M.empty)
+                  | RecCon flds <- map con_details cons
+                  , ConDeclField n _ doc <- flds ]
+
+-- | Extract function argument docs from inside types.
+typeDocs :: HsDecl Name -> Map Int HsDocString
+typeDocs d =
+  let docs = go 0 in
+  case d of
+    SigD (TypeSig _ ty) -> docs (unLoc ty)
+    SigD (PatSynSig _ arg_tys ty req prov) ->
+        let allTys = ty : concat [ F.toList arg_tys, unLoc req, unLoc prov ]
+        in F.foldMap (docs . unLoc) allTys
+    ForD (ForeignImport _ ty _ _) -> docs (unLoc ty)
+    TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
+    _ -> M.empty
+  where
+    go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
+    go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
+    go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
+    go n (HsDocTy _ (L _ doc)) = M.singleton n doc
+    go _ _ = M.empty
+
+
+-- | All the sub declarations of a class (that we handle), ordered by
+-- source location, with documentation attached if it exists.
+classDecls :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
+  where
+    decls = docs ++ defs ++ sigs ++ ats
+    docs  = mkDecls tcdDocs DocD class_
+#if MIN_VERSION_ghc(7,8,3)
+    defs  = mkDecls (bagToList . tcdMeths) ValD class_
+#else
+    defs  = mkDecls (map snd . bagToList . tcdMeths) ValD class_
+#endif
+    sigs  = mkDecls tcdSigs SigD class_
+    ats   = mkDecls tcdATs (TyClD . FamDecl) class_
+
+
+-- | The top-level declarations of a module that we care about,
+-- ordered by source location, with documentation attached if it exists.
+topDecls :: HsGroup Name -> [(LHsDecl Name, [HsDocString])]
+topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
+
+-- | Extract a map of fixity declarations only
+mkFixMap :: HsGroup Name -> FixMap
+mkFixMap group_ = M.fromList [ (n,f)
+                             | L _ (FixitySig (L _ n) f) <- hs_fixds group_ ]
+
+
+-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
+ungroup :: HsGroup Name -> [LHsDecl Name]
+ungroup group_ =
+  mkDecls (tyClGroupConcat . hs_tyclds) TyClD  group_ ++
+  mkDecls hs_derivds             DerivD group_ ++
+  mkDecls hs_defds               DefD   group_ ++
+  mkDecls hs_fords               ForD   group_ ++
+  mkDecls hs_docs                DocD   group_ ++
+  mkDecls hs_instds              InstD  group_ ++
+  mkDecls (typesigs . hs_valds)  SigD   group_ ++
+#if MIN_VERSION_ghc(7,8,3)
+  mkDecls (valbinds . hs_valds)  ValD   group_
+#else
+  mkDecls (map snd . valbinds . hs_valds)  ValD   group_
+#endif
+  where
+    typesigs (ValBindsOut _ sigs) = filter isVanillaLSig sigs
+    typesigs _ = error "expected ValBindsOut"
+
+    valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds
+    valbinds _ = error "expected ValBindsOut"
+
+
+-- | Take a field of declarations from a data structure and create HsDecls
+-- using the given constructor
+mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
+mkDecls field con struct = [ L loc (con decl) | L loc decl <- field struct ]
+
+
+-- | Sort by source location
+sortByLoc :: [Located a] -> [Located a]
+sortByLoc = sortBy (comparing getLoc)
+
+
+--------------------------------------------------------------------------------
+-- Filtering of declarations
+--
+-- We filter out declarations that we don't intend to handle later.
+--------------------------------------------------------------------------------
+
+
+-- | Filter out declarations that we don't handle in Haddock
+filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
+filterDecls = filter (isHandled . unL . fst)
+  where
+    isHandled (ForD (ForeignImport {})) = True
+    isHandled (TyClD {}) = True
+    isHandled (InstD {}) = True
+    isHandled (SigD d) = isVanillaLSig (reL d)
+    isHandled (ValD _) = True
+    -- we keep doc declarations to be able to get at named docs
+    isHandled (DocD _) = True
+    isHandled _ = False
+
+
+-- | Go through all class declarations and filter their sub-declarations
+filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
+filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
+                      | x@(L loc d, doc) <- decls ]
+  where
+    filterClass (TyClD c) =
+      TyClD $ c { tcdSigs = filter (liftA2 (||) isVanillaLSig isMinimalLSig) $ tcdSigs c }
+    filterClass _ = error "expected TyClD"
+
+
+--------------------------------------------------------------------------------
+-- Collect docs
+--
+-- To be able to attach the right Haddock comment to the right declaration,
+-- we sort the declarations by their SrcLoc and "collect" the docs for each
+-- declaration.
+--------------------------------------------------------------------------------
+
+
+-- | Collect docs and attach them to the right declarations.
+collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
+collectDocs = go Nothing []
+  where
+    go Nothing _ [] = []
+    go (Just prev) docs [] = finished prev docs []
+    go prev docs (L _ (DocD (DocCommentNext str)) : ds)
+      | Nothing <- prev = go Nothing (str:docs) ds
+      | Just decl <- prev = finished decl docs (go Nothing [str] ds)
+    go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds
+    go Nothing docs (d:ds) = go (Just d) docs ds
+    go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
+
+    finished decl docs rest = (decl, reverse docs) : rest
+
+
+-- | Build the list of items that will become the documentation, from the
+-- export list.  At this point, the list of ExportItems is in terms of
+-- original names.
+--
+-- We create the export items even if the module is hidden, since they
+-- might be useful when creating the export items for other modules.
+mkExportItems
+  :: IfaceMap
+  -> Module             -- this module
+  -> WarningMap
+  -> GlobalRdrEnv
+  -> [Name]             -- exported names (orig)
+  -> [LHsDecl Name]
+  -> Maps
+  -> FixMap
+  -> [SrcSpan]          -- splice locations
+  -> Maybe [IE Name]
+  -> InstIfaceMap
+  -> DynFlags
+  -> ErrMsgGhc [ExportItem Name]
+mkExportItems
+  modMap thisMod warnings gre exportedNames decls
+  maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags =
+  case optExports of
+    Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls
+    Just exports -> liftM concat $ mapM lookupExport exports
+  where
+    lookupExport (IEVar x)             = declWith x
+    lookupExport (IEThingAbs t)        = declWith t
+    lookupExport (IEThingAll t)        = declWith t
+    lookupExport (IEThingWith t _)     = declWith t
+    lookupExport (IEModuleContents m)  =
+      moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices
+    lookupExport (IEGroup lev docStr)  = return $
+      return . ExportGroup lev "" $ processDocString dflags gre docStr
+
+    lookupExport (IEDoc docStr)        = return $
+      return . ExportDoc $ processDocStringParas dflags gre docStr
+
+    lookupExport (IEDocNamed str)      = liftErrMsg $
+      findNamedDoc str [ unL d | d <- decls ] >>= return . \case
+        Nothing -> []
+        Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc
+
+    declWith :: Name -> ErrMsgGhc [ ExportItem Name ]
+    declWith t =
+      case findDecl t of
+        ([L l (ValD _)], (doc, _)) -> do
+          -- Top-level binding without type signature
+          export <- hiValExportItem dflags t doc (l `elem` splices) $ M.lookup t fixMap
+          return [export]
+        (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->
+          let declNames = getMainDeclBinder (unL decl)
+          in case () of
+            _
+              -- temp hack: we filter out separately exported ATs, since we haven't decided how
+              -- to handle them yet. We should really give an warning message also, and filter the
+              -- name out in mkVisibleNames...
+              | t `elem` declATs (unL decl)        -> return []
+
+              -- We should not show a subordinate by itself if any of its
+              -- parents is also exported. See note [1].
+              | t `notElem` declNames,
+                Just p <- find isExported (parents t $ unL decl) ->
+                do liftErrMsg $ tell [
+                     "Warning: " ++ moduleString thisMod ++ ": " ++
+                     pretty dflags (nameOccName t) ++ " is exported separately but " ++
+                     "will be documented under " ++ pretty dflags (nameOccName p) ++
+                     ". Consider exporting it together with its parent(s)" ++
+                     " for code clarity." ]
+                   return []
+
+              -- normal case
+              | otherwise -> case decl of
+                  -- A single signature might refer to many names, but we
+                  -- create an export item for a single name only.  So we
+                  -- modify the signature to contain only that single name.
+                  L loc (SigD sig) ->
+                    -- fromJust is safe since we already checked in guards
+                    -- that 't' is a name declared in this declaration.
+                    let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
+                    in return [ mkExportDecl t newDecl docs_ ]
+
+                  L loc (TyClD cl@ClassDecl{}) -> do
+                    mdef <- liftGhcToErrMsgGhc $ minimalDef t
+                    let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+                    return [ mkExportDecl t
+                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
+
+                  _ -> return [ mkExportDecl t decl docs_ ]
+
+        -- Declaration from another package
+        ([], _) -> do
+          mayDecl <- hiDecl dflags t
+          case mayDecl of
+            Nothing -> return [ ExportNoDecl t [] ]
+            Just decl ->
+              -- We try to get the subs and docs
+              -- from the installed .haddock file for that package.
+              case M.lookup (nameModule t) instIfaceMap of
+                Nothing -> do
+                   liftErrMsg $ tell
+                      ["Warning: Couldn't find .haddock for export " ++ pretty dflags t]
+                   let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates instMap (unLoc decl) ]
+                   return [ mkExportDecl t decl (noDocForDecl, subs_) ]
+                Just iface ->
+                   return [ mkExportDecl t decl (lookupDocs t warnings (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+
+        _ -> return []
+
+
+    mkExportDecl :: Name -> LHsDecl Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name
+    mkExportDecl name decl (doc, subs) = decl'
+      where
+        decl' = ExportDecl (restrictTo sub_names (extractDecl name mdl decl)) doc subs' [] fixities False
+        mdl = nameModule name
+        subs' = filter (isExported . fst) subs
+        sub_names = map fst subs'
+        fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ]
+
+
+    isExported = (`elem` exportedNames)
+
+
+    findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)]))
+    findDecl n
+      | m == thisMod, Just ds <- M.lookup n declMap =
+          (ds, lookupDocs n warnings docMap argMap subMap)
+      | Just iface <- M.lookup m modMap, Just ds <- M.lookup n (ifaceDeclMap iface) =
+          (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface))
+      | otherwise = ([], (noDocForDecl, []))
+      where
+        m = nameModule n
+
+
+hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl Name))
+hiDecl dflags t = do
+  mayTyThing <- liftGhcToErrMsgGhc $ lookupName t
+  case mayTyThing of
+    Nothing -> do
+      liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty dflags t]
+      return Nothing
+    Just x -> return (Just (tyThingToLHsDecl x))
+
+
+hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> Bool -> Maybe Fixity -> ErrMsgGhc (ExportItem Name)
+hiValExportItem dflags name doc splice fixity = do
+  mayDecl <- hiDecl dflags name
+  case mayDecl of
+    Nothing -> return (ExportNoDecl name [])
+    Just decl -> return (ExportDecl decl doc [] [] fixities splice)
+  where
+    fixities = case fixity of
+      Just f  -> [(name, f)]
+      Nothing -> []
+
+
+-- | Lookup docs for a declaration from maps.
+lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+lookupDocs n warnings docMap argMap subMap =
+  let lookupArgDoc x = M.findWithDefault M.empty x argMap in
+  let doc = (lookupDoc n, lookupArgDoc n) in
+  let subs = M.findWithDefault [] n subMap in
+  let subDocs = [ (s, (lookupDoc s, lookupArgDoc s)) | s <- subs ] in
+  (doc, subDocs)
+  where
+    lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)
+
+
+-- | Return all export items produced by an exported module. That is, we're
+-- interested in the exports produced by \"module B\" in such a scenario:
+--
+-- > module A (module B) where
+-- > import B (...) hiding (...)
+--
+-- There are three different cases to consider:
+--
+-- 1) B is hidden, in which case we return all its exports that are in scope in A.
+-- 2) B is visible, but not all its exports are in scope in A, in which case we
+--    only return those that are.
+-- 3) B is visible and all its exports are in scope, in which case we return
+--    a single 'ExportModule' item.
+moduleExports :: Module           -- ^ Module A
+              -> ModuleName       -- ^ The real name of B, the exported module
+              -> DynFlags         -- ^ The flags used when typechecking A
+              -> WarningMap
+              -> GlobalRdrEnv     -- ^ The renaming environment used for A
+              -> [Name]           -- ^ All the exports of A
+              -> [LHsDecl Name]   -- ^ All the declarations in A
+              -> IfaceMap         -- ^ Already created interfaces
+              -> InstIfaceMap     -- ^ Interfaces in other packages
+              -> Maps
+              -> FixMap
+              -> [SrcSpan]        -- ^ Locations of all TH splices
+              -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items
+moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps fixMap splices
+  | m == thisMod = fullModuleContents dflags warnings gre maps fixMap splices decls
+  | otherwise =
+    case M.lookup m ifaceMap of
+      Just iface
+        | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface)
+        | otherwise -> return [ ExportModule m ]
+
+      Nothing -> -- We have to try to find it in the installed interfaces
+                 -- (external packages).
+        case M.lookup expMod (M.mapKeys moduleName instIfaceMap) of
+          Just iface -> return [ ExportModule (instMod iface) ]
+          Nothing -> do
+            liftErrMsg $
+              tell ["Warning: " ++ pretty dflags thisMod ++ ": Could not find " ++
+                    "documentation for exported module: " ++ pretty dflags expMod]
+            return []
+  where
+    m = mkModule packageId expMod
+    packageId = modulePackageId thisMod
+
+
+-- Note [1]:
+------------
+-- It is unnecessary to document a subordinate by itself at the top level if
+-- any of its parents is also documented. Furthermore, if the subordinate is a
+-- record field or a class method, documenting it under its parent
+-- indicates its special status.
+--
+-- A user might expect that it should show up separately, so we issue a
+-- warning. It's a fine opportunity to also tell the user she might want to
+-- export the subordinate through the parent export item for clarity.
+--
+-- The code removes top-level subordinates also when the parent is exported
+-- through a 'module' export. I think that is fine.
+--
+-- (For more information, see Trac #69)
+
+
+fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> FixMap -> [SrcSpan]
+                   -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name]
+fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls =
+  liftM catMaybes $ mapM mkExportItem (expandSig decls)
+  where
+    -- A type signature can have multiple names, like:
+    --   foo, bar :: Types..
+    --
+    -- We go through the list of declarations and expand type signatures, so
+    -- that every type signature has exactly one name!
+    expandSig :: [LHsDecl name] -> [LHsDecl name]
+    expandSig = foldr f []
+      where
+        f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
+        f (L l (SigD (TypeSig    names t)))          xs = foldr (\n acc -> L l (SigD (TypeSig    [n] t))          : acc) xs names
+        f (L l (SigD (GenericSig names t)))          xs = foldr (\n acc -> L l (SigD (GenericSig [n] t))          : acc) xs names
+        f x xs = x : xs
+
+    mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
+    mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
+      return . Just . ExportGroup lev "" $ processDocString dflags gre docStr
+    mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do
+      return . Just . ExportDoc $ processDocStringParas dflags gre docStr
+    mkExportItem (L l (ValD d))
+      | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap =
+          -- Top-level binding without type signature.
+          let (doc, _) = lookupDocs name warnings docMap argMap subMap in
+          fmap Just (hiValExportItem dflags name doc (l `elem` splices) $ M.lookup name fixMap)
+      | otherwise = return Nothing
+    mkExportItem decl@(L l (InstD d))
+      | Just name <- M.lookup (getInstLoc d) instMap =
+        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
+        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+    mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
+      mdef <- liftGhcToErrMsgGhc $ minimalDef name
+      let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+      expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
+    mkExportItem decl@(L l d)
+      | name:_ <- getMainDeclBinder d = expDecl decl l name
+      | otherwise = return Nothing
+
+    fixities name subs = [ (n,f) | n <- name : map fst subs
+                                 , Just f <- [M.lookup n fixMap] ]
+
+    expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+      where (doc, subs) = lookupDocs name warnings docMap argMap subMap
+
+
+-- | Sometimes the declaration we want to export is not the "main" declaration:
+-- it might be an individual record selector or a class method.  In these
+-- cases we have to extract the required declaration (and somehow cobble
+-- together a type signature for it...).
+extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name
+extractDecl name mdl decl
+  | name `elem` getMainDeclBinder (unLoc decl) = decl
+  | otherwise  =
+    case unLoc decl of
+      TyClD d@ClassDecl {} ->
+        let matches = [ sig | sig <- tcdSigs d, name `elem` sigName sig,
+                        isVanillaLSig sig ] -- TODO: document fixity
+        in case matches of
+          [s0] -> let (n, tyvar_names) = (tcdName d, getTyVars d)
+                      L pos sig = extractClassDecl n tyvar_names s0
+                  in L pos (SigD sig)
+          _ -> error "internal: extractDecl (ClassDecl)"
+      TyClD d@DataDecl {} ->
+        let (n, tyvar_names) = (tcdName d, map toTypeNoLoc $ getTyVars d)
+        in SigD <$> extractRecSel name mdl n tyvar_names (dd_cons (tcdDataDefn d))
+      InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n
+                                          , dfid_pats = HsWB { hswb_cts = tys }
+                                          , dfid_defn = defn }) ->
+        SigD <$> extractRecSel name mdl n tys (dd_cons defn)
+      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
+        let matches = [ d | L _ d <- insts
+                          , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
+                          , ConDeclField { cd_fld_name = L _ n } <- rec
+                          , n == name
+                      ]
+        in case matches of
+          [d0] -> extractDecl name mdl (noLoc . InstD $ DataFamInstD d0)
+          _ -> error "internal: extractDecl (ClsInstD)"
+      _ -> error "internal: extractDecl"
+  where
+    getTyVars = hsLTyVarLocNames . tyClDeclTyVars
+
+
+toTypeNoLoc :: Located Name -> LHsType Name
+toTypeNoLoc = noLoc . HsTyVar . unLoc
+
+
+extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name
+extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of
+  L _ (HsForAllTy expl tvs (L _ preds) ty) ->
+    L pos (TypeSig lname (noLoc (HsForAllTy expl tvs (lctxt preds) ty)))
+  _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit emptyHsQTvs (lctxt []) ltype)))
+  where
+    lctxt = noLoc . ctxt
+    ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds
+extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl"
+
+
+extractRecSel :: Name -> Module -> Name -> [LHsType Name] -> [LConDecl Name]
+              -> LSig Name
+extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
+
+extractRecSel nm mdl t tvs (L _ con : rest) =
+  case con_details con of
+    RecCon fields | (ConDeclField n ty _ : _) <- matching_fields fields ->
+      L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))))
+    _ -> extractRecSel nm mdl t tvs rest
+ where
+  matching_fields flds = [ f | f@(ConDeclField n _ _) <- flds, unLoc n == nm ]
+  data_ty
+    | ResTyGADT ty <- con_res con = ty
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs
+
+
+-- | Keep export items with docs.
+pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
+pruneExportItems = filter hasDoc
+  where
+    hasDoc (ExportDecl{expItemMbDoc = (Documentation d _, _)}) = isJust d
+    hasDoc _ = True
+
+
+mkVisibleNames :: Maps -> [ExportItem Name] -> [DocOption] -> [Name]
+mkVisibleNames (_, _, _, _, instMap) exports opts
+  | OptHide `elem` opts = []
+  | otherwise = let ns = concatMap exportName exports
+                in seqList ns `seq` ns
+  where
+    exportName e@ExportDecl {} = name ++ subs
+      where subs = map fst (expItemSubDocs e)
+            name = case unLoc $ expItemDecl e of
+              InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
+              decl    -> getMainDeclBinder decl
+    exportName ExportNoDecl {} = [] -- we don't count these as visible, since
+                                    -- we don't want links to go to them.
+    exportName _ = []
+
+seqList :: [a] -> ()
+seqList [] = ()
+seqList (x : xs) = x `seq` seqList xs
+
+-- | Find a stand-alone documentation comment by its name.
+findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString)
+findNamedDoc name = search
+  where
+    search [] = do
+      tell ["Cannot find documentation for: $" ++ name]
+      return Nothing
+    search (DocD (DocCommentNamed name' doc) : rest)
+      | name == name' = return (Just doc)
+      | otherwise = search rest
+    search (_other_decl : rest) = search rest
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
new file mode 100644
index 00000000..f1021436
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -0,0 +1,146 @@
+{-# OPTIONS_GHC -Wwarn #-}
+{-# LANGUAGE BangPatterns #-}
+  -----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.LexParseRn
+-- Copyright   :  (c) Isaac Dupree 2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.LexParseRn
+  ( processDocString
+  , processDocStringParas
+  , processDocStrings
+  , processModuleHeader
+  ) where
+
+import Control.Applicative
+import Data.IntSet (toList)
+import Data.List
+import Documentation.Haddock.Doc (docConcat)
+import DynFlags (ExtensionFlag(..), languageExtensions)
+import FastString
+import GHC
+import Haddock.Interface.ParseModuleHeader
+import Haddock.Parser
+import Haddock.Types
+import Name
+import Outputable (showPpr)
+import RdrName
+
+processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Maybe (Doc Name)
+processDocStrings dflags gre strs =
+  case docConcat $ map (processDocStringParas dflags gre) strs of
+    DocEmpty -> Nothing
+    x -> Just x
+
+
+processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
+processDocStringParas = process parseParas
+
+
+processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name
+processDocString = process parseString
+
+process :: (DynFlags -> String -> Doc RdrName)
+        -> DynFlags
+        -> GlobalRdrEnv
+        -> HsDocString
+        -> Doc Name
+process parse dflags gre (HsDocString fs) =
+  rename dflags gre $ parse dflags (unpackFS fs)
+
+
+processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
+                    -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))
+processModuleHeader dflags gre safety mayStr = do
+  (hmi, doc) <-
+    case mayStr of
+      Nothing -> return failure
+      Just (L _ (HsDocString fs)) -> do
+        let str = unpackFS fs
+            (hmi, doc) = parseModuleHeader dflags str
+            !descr = rename dflags gre <$> hmi_description hmi
+            hmi' = hmi { hmi_description = descr }
+            doc' = rename dflags gre doc
+        return (hmi', Just doc')
+
+  let flags :: [ExtensionFlag]
+      -- We remove the flags implied by the language setting and we display the language instead
+      flags = map toEnum (toList $ extensionFlags dflags) \\ languageExtensions (language dflags)
+  return (hmi { hmi_safety = Just $ showPpr dflags safety
+              , hmi_language = language dflags
+              , hmi_extensions = flags
+              } , doc)
+  where
+    failure = (emptyHaddockModInfo, Nothing)
+
+
+rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name
+rename dflags gre = rn
+  where
+    rn d = case d of
+      DocAppend a b -> DocAppend (rn a) (rn b)
+      DocParagraph doc -> DocParagraph (rn doc)
+      DocIdentifier x -> do
+        let choices = dataTcOccs' x
+        let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
+        case names of
+          [] ->
+            case choices of
+              [] -> DocMonospaced (DocString (showPpr dflags x))
+              [a] -> outOfScope dflags a
+              a:b:_ | isRdrTc a -> outOfScope dflags a
+                    | otherwise -> outOfScope dflags b
+          [a] -> DocIdentifier a
+          a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
+              -- If an id can refer to multiple things, we give precedence to type
+              -- constructors.
+
+      DocWarning doc -> DocWarning (rn doc)
+      DocEmphasis doc -> DocEmphasis (rn doc)
+      DocBold doc -> DocBold (rn doc)
+      DocMonospaced doc -> DocMonospaced (rn doc)
+      DocUnorderedList docs -> DocUnorderedList (map rn docs)
+      DocOrderedList docs -> DocOrderedList (map rn docs)
+      DocDefList list -> DocDefList [ (rn a, rn b) | (a, b) <- list ]
+      DocCodeBlock doc -> DocCodeBlock (rn doc)
+      DocIdentifierUnchecked x -> DocIdentifierUnchecked x
+      DocModule str -> DocModule str
+      DocHyperlink l -> DocHyperlink l
+      DocPic str -> DocPic str
+      DocAName str -> DocAName str
+      DocProperty p -> DocProperty p
+      DocExamples e -> DocExamples e
+      DocEmpty -> DocEmpty
+      DocString str -> DocString str
+      DocHeader (Header l t) -> DocHeader $ Header l (rn t)
+
+dataTcOccs' :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+--
+-- We use this definition instead of the GHC's to provide proper linking to
+-- functions accross modules. See ticket #253 on Haddock Trac.
+dataTcOccs' rdr_name
+  | isDataOcc occ             = [rdr_name, rdr_name_tc]
+  | otherwise                 = [rdr_name]
+  where
+    occ = rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+
+
+outOfScope :: DynFlags -> RdrName -> Doc a
+outOfScope dflags x =
+  case x of
+    Unqual occ -> monospaced occ
+    Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
+    Orig _ occ -> monospaced occ
+    Exact name -> monospaced name  -- Shouldn't happen since x is out of scope
+  where
+    monospaced a = DocMonospaced (DocString (showPpr dflags a))
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
new file mode 100644
index 00000000..6848dc63
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -0,0 +1,150 @@
+{-# OPTIONS_GHC -Wwarn #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.ParseModuleHeader
+-- Copyright   :  (c) Simon Marlow 2006, Isaac Dupree 2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (mplus)
+import Data.Char
+import DynFlags
+import Haddock.Parser
+import Haddock.Types
+import RdrName
+
+-- -----------------------------------------------------------------------------
+-- Parsing module headers
+
+-- NB.  The headers must be given in the order Module, Description,
+-- Copyright, License, Maintainer, Stability, Portability, except that
+-- any or all may be omitted.
+parseModuleHeader :: DynFlags -> String -> (HaddockModInfo RdrName, Doc RdrName)
+parseModuleHeader dflags str0 =
+   let
+      getKey :: String -> String -> (Maybe String,String)
+      getKey key str = case parseKey key str of
+         Nothing -> (Nothing,str)
+         Just (value,rest) -> (Just value,rest)
+
+      (_moduleOpt,str1) = getKey "Module" str0
+      (descriptionOpt,str2) = getKey "Description" str1
+      (copyrightOpt,str3) = getKey "Copyright" str2
+      (licenseOpt,str4) = getKey "License" str3
+      (licenceOpt,str5) = getKey "Licence" str4
+      (maintainerOpt,str6) = getKey "Maintainer" str5
+      (stabilityOpt,str7) = getKey "Stability" str6
+      (portabilityOpt,str8) = getKey "Portability" str7
+
+   in (HaddockModInfo {
+          hmi_description = parseString dflags <$> descriptionOpt,
+          hmi_copyright = copyrightOpt,
+          hmi_license = licenseOpt `mplus` licenceOpt,
+          hmi_maintainer = maintainerOpt,
+          hmi_stability = stabilityOpt,
+          hmi_portability = portabilityOpt,
+          hmi_safety = Nothing,
+          hmi_language = Nothing, -- set in LexParseRn
+          hmi_extensions = [] -- also set in LexParseRn
+          }, parseParas dflags str8)
+
+-- | This function is how we read keys.
+--
+-- all fields in the header are optional and have the form
+--
+-- [spaces1][field name][spaces] ":"
+--    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
+-- where each [spaces2] should have [spaces1] as a prefix.
+--
+-- Thus for the key "Description",
+--
+-- > Description : this is a
+-- >    rather long
+-- >
+-- >    description
+-- >
+-- > The module comment starts here
+--
+-- the value will be "this is a .. description" and the rest will begin
+-- at "The module comment".
+parseKey :: String -> String -> Maybe (String,String)
+parseKey key toParse0 =
+   do
+      let
+         (spaces0,toParse1) = extractLeadingSpaces toParse0
+
+         indentation = spaces0
+      afterKey0 <- extractPrefix key toParse1
+      let
+         afterKey1 = extractLeadingSpaces afterKey0
+      afterColon0 <- case snd afterKey1 of
+         ':':afterColon -> return afterColon
+         _ -> Nothing
+      let
+         (_,afterColon1) = extractLeadingSpaces afterColon0
+
+      return (scanKey True indentation afterColon1)
+   where
+      scanKey :: Bool -> String -> String -> (String,String)
+      scanKey _       _           [] = ([],[])
+      scanKey isFirst indentation str =
+         let
+            (nextLine,rest1) = extractNextLine str
+
+            accept = isFirst || sufficientIndentation || allSpaces
+
+            sufficientIndentation = case extractPrefix indentation nextLine of
+               Just (c:_) | isSpace c -> True
+               _ -> False
+
+            allSpaces = case extractLeadingSpaces nextLine of
+               (_,[]) -> True
+               _ -> False
+         in
+            if accept
+               then
+                  let
+                     (scanned1,rest2) = scanKey False indentation rest1
+
+                     scanned2 = case scanned1 of
+                        "" -> if allSpaces then "" else nextLine
+                        _ -> nextLine ++ "\n" ++ scanned1
+                  in
+                     (scanned2,rest2)
+               else
+                  ([],str)
+
+      extractLeadingSpaces :: String -> (String,String)
+      extractLeadingSpaces [] = ([],[])
+      extractLeadingSpaces (s@(c:cs))
+         | isSpace c =
+            let
+               (spaces1,cs1) = extractLeadingSpaces cs
+            in
+               (c:spaces1,cs1)
+         | otherwise = ([],s)
+
+      extractNextLine :: String -> (String,String)
+      extractNextLine [] = ([],[])
+      extractNextLine (c:cs)
+         | c == '\n' =
+            ([],cs)
+         | otherwise =
+            let
+               (line,rest) = extractNextLine cs
+            in
+               (c:line,rest)
+
+      -- comparison is case-insensitive.
+      extractPrefix :: String -> String -> Maybe String
+      extractPrefix [] s = Just s
+      extractPrefix _ [] = Nothing
+      extractPrefix (c1:cs1) (c2:cs2)
+         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
+         | otherwise = Nothing
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
new file mode 100644
index 00000000..748e0210
--- /dev/null
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -0,0 +1,506 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Interface.Rename
+-- Copyright   :  (c) Simon Marlow 2003-2006,
+--                    David Waern  2006-2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Interface.Rename (renameInterface) where
+
+
+import Data.Traversable (traverse)
+
+import Haddock.GhcUtils
+import Haddock.Types
+
+import Bag (emptyBag)
+import GHC hiding (NoLink)
+import Name
+
+import Control.Applicative
+import Control.Monad hiding (mapM)
+import Data.List
+import qualified Data.Map as Map hiding ( Map )
+import Data.Traversable (mapM)
+import Prelude hiding (mapM)
+
+
+renameInterface :: DynFlags -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface
+renameInterface dflags renamingEnv warnings iface =
+
+  -- first create the local env, where every name exported by this module
+  -- is mapped to itself, and everything else comes from the global renaming
+  -- env
+  let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)
+        where fn env name = Map.insert name (ifaceMod iface) env
+
+      -- rename names in the exported declarations to point to things that
+      -- are closer to, or maybe even exported by, the current module.
+      (renamedExportItems, missingNames1)
+        = runRnFM localEnv (renameExportItems (ifaceExportItems iface))
+
+      (rnDocMap, missingNames2) = runRnFM localEnv (mapM renameDoc (ifaceDocMap iface))
+
+      (rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
+
+      (finalModuleDoc, missingNames4)
+        = runRnFM localEnv (renameDocumentation (ifaceDoc iface))
+
+      -- combine the missing names and filter out the built-ins, which would
+      -- otherwise allways be missing.
+      missingNames = nub $ filter isExternalName  -- XXX: isExternalName filters out too much
+                    (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4)
+
+      -- filter out certain built in type constructors using their string
+      -- representation. TODO: use the Name constants from the GHC API.
+--      strings = filter (`notElem` ["()", "[]", "(->)"])
+--                (map pretty missingNames)
+      strings = map (pretty dflags) . filter (\n -> not (isSystemName n || isBuiltInSyntax n)) $ missingNames
+
+  in do
+    -- report things that we couldn't link to. Only do this for non-hidden
+    -- modules.
+    unless (OptHide `elem` ifaceOptions iface || null strings || not warnings) $
+      tell ["Warning: " ++ moduleString (ifaceMod iface) ++
+            ": could not find link destinations for:\n"++
+            unwords ("   " : strings) ]
+
+    return $ iface { ifaceRnDoc         = finalModuleDoc,
+                     ifaceRnDocMap      = rnDocMap,
+                     ifaceRnArgMap      = rnArgMap,
+                     ifaceRnExportItems = renamedExportItems }
+
+
+--------------------------------------------------------------------------------
+-- 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 RnM a =
+  RnM { unRn :: (Name -> (Bool, DocName))  -- name lookup function
+             -> (a,[Name])
+      }
+
+instance Monad RnM where
+  (>>=) = thenRn
+  return = returnRn
+
+instance Functor RnM where
+  fmap f x = do a <- x; return (f a)
+
+instance Applicative RnM where
+  pure = return
+  (<*>) = ap
+
+returnRn :: a -> RnM a
+returnRn a   = RnM (const (a,[]))
+thenRn :: RnM a -> (a -> RnM b) -> RnM 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 (const ((),[name]))
+
+lookupRn :: Name -> RnM DocName
+lookupRn name = do
+  lkp <- getLookupRn
+  case lkp name of
+    (False,maps_to) -> do outRn name; return maps_to
+    (True, maps_to) -> return maps_to
+
+
+runRnFM :: LinkEnv -> RnM a -> (a,[Name])
+runRnFM env rn = unRn rn lkp
+  where
+    lkp n = case Map.lookup n env of
+      Nothing  -> (False, Undocumented n)
+      Just mdl -> (True,  Documented n mdl)
+
+
+--------------------------------------------------------------------------------
+-- Renaming
+--------------------------------------------------------------------------------
+
+
+rename :: Name -> RnM DocName
+rename = lookupRn
+
+
+renameL :: Located Name -> RnM (Located DocName)
+renameL = mapM rename
+
+
+renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName]
+renameExportItems = mapM renameExportItem
+
+
+renameDocForDecl :: DocForDecl Name -> RnM (DocForDecl DocName)
+renameDocForDecl (doc, fnArgsDoc) =
+  (,) <$> renameDocumentation doc <*> renameFnArgsDoc fnArgsDoc
+
+
+renameDocumentation :: Documentation Name -> RnM (Documentation DocName)
+renameDocumentation (Documentation mDoc mWarning) =
+  Documentation <$> mapM renameDoc mDoc <*> mapM renameDoc mWarning
+
+
+renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
+renameLDocHsSyn = return
+
+
+renameDoc :: Doc Name -> RnM (Doc DocName)
+renameDoc = traverse rename
+
+
+renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
+renameFnArgsDoc = mapM renameDoc
+
+
+renameLType :: LHsType Name -> RnM (LHsType DocName)
+renameLType = mapM renameType
+
+renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
+renameLKind = renameLType
+
+renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
+renameMaybeLKind = traverse renameLKind
+
+renameType :: HsType Name -> RnM (HsType DocName)
+renameType t = case t of
+  HsForAllTy expl tyvars lcontext ltype -> do
+    tyvars'   <- renameLTyVarBndrs 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 ty -> return . HsListTy =<< renameLType ty
+  HsPArrTy ty -> return . HsPArrTy =<< renameLType ty
+  HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty)
+  HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
+
+  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
+
+  HsOpTy a (w, L loc op) b -> do
+    op' <- rename op
+    a'  <- renameLType a
+    b'  <- renameLType b
+    return (HsOpTy a' (w, L loc op') b')
+
+  HsParTy ty -> return . HsParTy =<< renameLType ty
+
+  HsKindSig ty k -> do
+    ty' <- renameLType ty
+    k' <- renameLKind k
+    return (HsKindSig ty' k')
+
+  HsDocTy ty doc -> do
+    ty' <- renameLType ty
+    doc' <- renameLDocHsSyn doc
+    return (HsDocTy ty' doc')
+
+  HsTyLit x -> return (HsTyLit x)
+
+  HsWrapTy a b            -> HsWrapTy a <$> renameType b
+  HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a
+  HsCoreTy a              -> pure (HsCoreTy a)
+  HsExplicitListTy  a b   -> HsExplicitListTy  a <$> mapM renameLType b
+  HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b
+  HsQuasiQuoteTy a        -> HsQuasiQuoteTy <$> renameHsQuasiQuote a
+  HsSpliceTy _ _          -> error "renameType: HsSpliceTy"
+
+renameHsQuasiQuote :: HsQuasiQuote Name -> RnM (HsQuasiQuote DocName)
+renameHsQuasiQuote (HsQuasiQuote a b c) = HsQuasiQuote <$> rename a <*> pure b <*> pure c
+
+renameLTyVarBndrs :: LHsTyVarBndrs Name -> RnM (LHsTyVarBndrs DocName)
+renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
+  = do { tvs' <- mapM renameLTyVarBndr tvs
+       ; return (HsQTvs { hsq_kvs = error "haddock:renameLTyVarBndrs", hsq_tvs = tvs' }) }
+                -- This is rather bogus, but I'm not sure what else to do
+
+renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
+renameLTyVarBndr (L loc (UserTyVar n))
+  = do { n' <- rename n
+       ; return (L loc (UserTyVar n')) }
+renameLTyVarBndr (L loc (KindedTyVar n kind))
+  = do { n' <- rename n
+       ; kind' <- renameLKind kind
+       ; return (L loc (KindedTyVar n' kind')) }
+
+renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
+renameLContext (L loc context) = do
+  context' <- mapM renameLType context
+  return (L loc context')
+
+
+renameInstHead :: InstHead Name -> RnM (InstHead DocName)
+renameInstHead (className, k, types, rest) = do
+  className' <- rename className
+  k' <- mapM renameType k
+  types' <- mapM renameType types
+  rest' <- case rest of
+    ClassInst cs -> ClassInst <$> mapM renameType cs
+    TypeInst  ts -> TypeInst  <$> traverse renameType ts
+    DataInst  dd -> DataInst  <$> renameTyClD dd
+  return (className', k', types', rest')
+
+
+renameLDecl :: LHsDecl Name -> RnM (LHsDecl DocName)
+renameLDecl (L loc d) = return . L loc =<< renameDecl d
+
+
+renameDecl :: HsDecl Name -> RnM (HsDecl DocName)
+renameDecl decl = case decl 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')
+  InstD d -> do
+    d' <- renameInstD d
+    return (InstD d')
+  _ -> error "renameDecl"
+
+renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName))
+renameLThing fn (L loc x) = return . L loc =<< fn x
+
+renameTyClD :: TyClDecl Name -> RnM (TyClDecl DocName)
+renameTyClD d = case d of
+  ForeignType lname b -> do
+    lname' <- renameL lname
+    return (ForeignType lname' b)
+
+--  TyFamily flav lname ltyvars kind tckind -> do
+  FamDecl { tcdFam = decl } -> do
+    decl' <- renameFamilyDecl decl
+    return (FamDecl { tcdFam = decl' })
+
+  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = fvs } -> do
+    lname'    <- renameL lname
+    tyvars'   <- renameLTyVarBndrs tyvars
+    rhs'     <- renameLType rhs
+    return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = fvs })
+
+  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = fvs } -> do
+    lname'    <- renameL lname
+    tyvars'   <- renameLTyVarBndrs tyvars
+    defn'     <- renameDataDefn defn
+    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = fvs })
+
+  ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
+            , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
+    lcontext' <- renameLContext lcontext
+    lname'    <- renameL lname
+    ltyvars'  <- renameLTyVarBndrs ltyvars
+    lfundeps' <- mapM renameLFunDep lfundeps
+    lsigs'    <- mapM renameLSig lsigs
+    ats'      <- mapM (renameLThing renameFamilyDecl) ats
+    at_defs'  <- mapM (mapM renameTyFamInstD) at_defs
+    -- we don't need the default methods or the already collected doc entities
+    return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
+                      , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
+                      , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames })
+
+  where
+    renameLFunDep (L loc (xs, ys)) = do
+      xs' <- mapM rename xs
+      ys' <- mapM rename ys
+      return (L loc (xs', ys'))
+
+    renameLSig (L loc sig) = return . L loc =<< renameSig sig
+
+renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName)
+renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
+                             , fdTyVars = ltyvars, fdKindSig = tckind }) = do
+    info'    <- renameFamilyInfo info
+    lname'   <- renameL lname
+    ltyvars' <- renameLTyVarBndrs ltyvars
+    tckind'  <- renameMaybeLKind tckind
+    return (FamilyDecl { fdInfo = info', fdLName = lname'
+                       , fdTyVars = ltyvars', fdKindSig = tckind' })
+
+renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
+renameFamilyInfo DataFamily     = return DataFamily
+renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
+renameFamilyInfo (ClosedTypeFamily eqns)
+  = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
+       ; return $ ClosedTypeFamily eqns' }
+
+renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)
+renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
+                           , dd_kindSig = k, dd_cons = cons }) = do
+    lcontext' <- renameLContext lcontext
+    k'        <- renameMaybeLKind k
+    cons'     <- mapM (mapM renameCon) cons
+    -- I don't think we need the derivings, so we return Nothing
+    return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
+                       , dd_kindSig = k', dd_cons = cons', dd_derivs = Nothing })
+
+renameCon :: ConDecl Name -> RnM (ConDecl DocName)
+renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
+                        , con_cxt = lcontext, con_details = details
+                        , con_res = restype, con_doc = mbldoc }) = do
+      lname'    <- renameL lname
+      ltyvars'  <- renameLTyVarBndrs ltyvars
+      lcontext' <- renameLContext lcontext
+      details'  <- renameDetails details
+      restype'  <- renameResType restype
+      mbldoc'   <- mapM renameLDocHsSyn mbldoc
+      return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
+                   , con_details = details', con_res = restype', con_doc = mbldoc' })
+  where
+    renameDetails (RecCon fields) = return . RecCon =<< mapM renameConDeclFieldField fields
+    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+    renameDetails (InfixCon a b) = do
+      a' <- renameLType a
+      b' <- renameLType b
+      return (InfixCon a' b')
+
+    renameResType (ResTyH98) = return ResTyH98
+    renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
+
+
+renameConDeclFieldField :: ConDeclField Name -> RnM (ConDeclField DocName)
+renameConDeclFieldField (ConDeclField name t doc) = do
+  name' <- renameL name
+  t'   <- renameLType t
+  doc' <- mapM renameLDocHsSyn doc
+  return (ConDeclField name' t' doc')
+
+
+renameSig :: Sig Name -> RnM (Sig DocName)
+renameSig sig = case sig of
+  TypeSig lnames ltype -> do
+    lnames' <- mapM renameL lnames
+    ltype' <- renameLType ltype
+    return (TypeSig lnames' ltype')
+  PatSynSig lname args ltype lreq lprov -> do
+    lname' <- renameL lname
+    args' <- case args of
+        PrefixPatSyn largs -> PrefixPatSyn <$> mapM renameLType largs
+        InfixPatSyn lleft lright -> InfixPatSyn <$> renameLType lleft <*> renameLType lright
+    ltype' <- renameLType ltype
+    lreq' <- renameLContext lreq
+    lprov' <- renameLContext lprov
+    return $ PatSynSig lname' args' ltype' lreq' lprov'
+  FixSig (FixitySig lname fixity) -> do
+    lname' <- renameL lname
+    return $ FixSig (FixitySig lname' fixity)
+  MinimalSig s -> MinimalSig <$> traverse renameL s
+  -- we have filtered out all other kinds of signatures in Interface.Create
+  _ -> error "expected TypeSig"
+
+
+renameForD :: ForeignDecl Name -> RnM (ForeignDecl DocName)
+renameForD (ForeignImport lname ltype co x) = do
+  lname' <- renameL lname
+  ltype' <- renameLType ltype
+  return (ForeignImport lname' ltype' co x)
+renameForD (ForeignExport lname ltype co x) = do
+  lname' <- renameL lname
+  ltype' <- renameLType ltype
+  return (ForeignExport lname' ltype' co x)
+
+
+renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
+renameInstD (ClsInstD { cid_inst = d }) = do
+  d' <- renameClsInstD d
+  return (ClsInstD { cid_inst = d' })
+renameInstD (TyFamInstD { tfid_inst = d }) = do
+  d' <- renameTyFamInstD d
+  return (TyFamInstD { tfid_inst = d' })
+renameInstD (DataFamInstD { dfid_inst = d }) = do
+  d' <- renameDataFamInstD d
+  return (DataFamInstD { dfid_inst = d' })
+
+renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
+renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_datafam_insts = lADTs }) = do
+  ltype' <- renameLType ltype
+  lATs'  <- mapM (mapM renameTyFamInstD) lATs
+  lADTs' <- mapM (mapM renameDataFamInstD) lADTs
+  return (ClsInstDecl { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = []
+                      , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })
+
+
+renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName)
+renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
+  = do { eqn' <- renameLThing renameTyFamInstEqn eqn
+       ; return (TyFamInstDecl { tfid_eqn = eqn'
+                               , tfid_fvs = placeHolderNames }) }
+
+renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName)
+renameTyFamInstEqn (TyFamInstEqn { tfie_tycon = tc, tfie_pats = pats_w_bndrs, tfie_rhs = rhs })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
+       ; rhs' <- renameLType rhs
+       ; return (TyFamInstEqn { tfie_tycon = tc', tfie_pats = pats_w_bndrs { hswb_cts = pats' }
+                              , tfie_rhs = rhs' }) }
+
+renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName)
+renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, dfid_defn = defn })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
+       ; defn' <- renameDataDefn defn
+       ; return (DataFamInstDecl { dfid_tycon = tc', dfid_pats = pats_w_bndrs { hswb_cts = pats' }
+                                 , dfid_defn = defn', dfid_fvs = placeHolderNames }) }
+
+renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
+renameExportItem item = case item of
+  ExportModule mdl -> return (ExportModule mdl)
+  ExportGroup lev id_ doc -> do
+    doc' <- renameDoc doc
+    return (ExportGroup lev id_ doc')
+  ExportDecl decl doc subs instances fixities splice -> do
+    decl' <- renameLDecl decl
+    doc'  <- renameDocForDecl doc
+    subs' <- mapM renameSub subs
+    instances' <- forM instances $ \(inst, idoc) -> do
+      inst' <- renameInstHead inst
+      idoc' <- mapM renameDoc idoc
+      return (inst', idoc')
+    fixities' <- forM fixities $ \(name, fixity) -> do
+      name' <- lookupRn name
+      return (name', fixity)
+    return (ExportDecl decl' doc' subs' instances' fixities' splice)
+  ExportNoDecl x subs -> do
+    x'    <- lookupRn x
+    subs' <- mapM lookupRn subs
+    return (ExportNoDecl x' subs')
+  ExportDoc doc -> do
+    doc' <- renameDoc doc
+    return (ExportDoc doc')
+
+
+renameSub :: (Name, DocForDecl Name) -> RnM (DocName, DocForDecl DocName)
+renameSub (n,doc) = do
+  n' <- rename n
+  doc' <- renameDocForDecl doc
+  return (n', doc')
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
new file mode 100644
index 00000000..bb997b9a
--- /dev/null
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -0,0 +1,636 @@
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.InterfaceFile
+-- Copyright   :  (c) David Waern       2006-2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Reading and writing the .haddock interface file
+-----------------------------------------------------------------------------
+module Haddock.InterfaceFile (
+  InterfaceFile(..), ifPackageId,
+  readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
+  writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility
+) where
+
+
+import Haddock.Types
+import Haddock.Utils hiding (out)
+
+import Control.Monad
+import Data.Array
+import Data.Functor ((<$>))
+import Data.IORef
+import Data.List
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Word
+
+import BinIface (getSymtabName, getDictFastString)
+import Binary
+import FastMutInt
+import FastString
+import GHC hiding (NoLink)
+import GhcMonad (withSession)
+import HscTypes
+import IfaceEnv
+import Name
+import UniqFM
+import UniqSupply
+import Unique
+
+
+data InterfaceFile = InterfaceFile {
+  ifLinkEnv         :: LinkEnv,
+  ifInstalledIfaces :: [InstalledInterface]
+}
+
+
+ifPackageId :: InterfaceFile -> PackageId
+ifPackageId if_ =
+  case ifInstalledIfaces if_ of
+    [] -> error "empty InterfaceFile"
+    iface:_ -> modulePackageId $ instMod iface
+
+
+binaryInterfaceMagic :: Word32
+binaryInterfaceMagic = 0xD0Cface
+
+
+-- IMPORTANT: Since datatypes in the GHC API might change between major
+-- versions, and because we store GHC datatypes in our interface files, we need
+-- to make sure we version our interface files accordingly.
+--
+-- If you change the interface file format or adapt Haddock to work with a new
+-- major version of GHC (so that the format changes indirectly) *you* need to
+-- follow these steps:
+--
+-- (1) increase `binaryInterfaceVersion`
+--
+-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
+--
+binaryInterfaceVersion :: Word16
+#if __GLASGOW_HASKELL__ == 708
+binaryInterfaceVersion = 25
+
+binaryInterfaceVersionCompatibility :: [Word16]
+binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
+#else
+#error Unsupported GHC version
+#endif
+
+
+initBinMemSize :: Int
+initBinMemSize = 1024*1024
+
+
+writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
+writeInterfaceFile filename iface = do
+  bh0 <- openBinMem initBinMemSize
+  put_ bh0 binaryInterfaceMagic
+  put_ bh0 binaryInterfaceVersion
+
+  -- remember where the dictionary pointer will go
+  dict_p_p <- tellBin bh0
+  put_ bh0 dict_p_p
+
+  -- remember where the symbol table pointer will go
+  symtab_p_p <- tellBin bh0
+  put_ bh0 symtab_p_p
+
+  -- Make some intial state
+  symtab_next <- newFastMutInt
+  writeFastMutInt symtab_next 0
+  symtab_map <- newIORef emptyUFM
+  let bin_symtab = BinSymbolTable {
+                      bin_symtab_next = symtab_next,
+                      bin_symtab_map  = symtab_map }
+  dict_next_ref <- newFastMutInt
+  writeFastMutInt dict_next_ref 0
+  dict_map_ref <- newIORef emptyUFM
+  let bin_dict = BinDictionary {
+                      bin_dict_next = dict_next_ref,
+                      bin_dict_map  = dict_map_ref }
+
+  -- put the main thing
+  let bh = setUserData bh0 $ newWriteState (putName bin_symtab)
+                                           (putFastString bin_dict)
+  put_ bh iface
+
+  -- write the symtab pointer at the front of the file
+  symtab_p <- tellBin bh
+  putAt bh symtab_p_p symtab_p
+  seekBin bh symtab_p
+
+  -- write the symbol table itself
+  symtab_next' <- readFastMutInt symtab_next
+  symtab_map'  <- readIORef symtab_map
+  putSymbolTable bh symtab_next' symtab_map'
+
+  -- write the dictionary pointer at the fornt of the file
+  dict_p <- tellBin bh
+  putAt bh dict_p_p dict_p
+  seekBin bh dict_p
+
+  -- write the dictionary itself
+  dict_next <- readFastMutInt dict_next_ref
+  dict_map  <- readIORef dict_map_ref
+  putDictionary bh dict_next dict_map
+
+  -- and send the result to the file
+  writeBinMem bh filename
+  return ()
+
+
+type NameCacheAccessor m = (m NameCache, NameCache -> m ())
+
+
+nameCacheFromGhc :: NameCacheAccessor Ghc
+nameCacheFromGhc = ( read_from_session , write_to_session )
+  where
+    read_from_session = do
+       ref <- withSession (return . hsc_NC)
+       liftIO $ readIORef ref
+    write_to_session nc' = do
+       ref <- withSession (return . hsc_NC)
+       liftIO $ writeIORef ref nc'
+
+
+freshNameCache :: NameCacheAccessor IO
+freshNameCache = ( create_fresh_nc , \_ -> return () )
+  where
+    create_fresh_nc = do
+       u  <- mkSplitUniqSupply 'a' -- ??
+       return (initNameCache u [])
+
+
+-- | Read a Haddock (@.haddock@) interface file. Return either an
+-- 'InterfaceFile' or an error message.
+--
+-- This function can be called in two ways.  Within a GHC session it will
+-- update the use and update the session's name cache.  Outside a GHC session
+-- a new empty name cache is used.  The function is therefore generic in the
+-- monad being used.  The exact monad is whichever monad the first
+-- argument, the getter and setter of the name cache, requires.
+--
+readInterfaceFile :: forall m.
+                     MonadIO m
+                  => NameCacheAccessor m
+                  -> FilePath
+                  -> m (Either String InterfaceFile)
+readInterfaceFile (get_name_cache, set_name_cache) filename = do
+  bh0 <- liftIO $ readBinMem filename
+
+  magic   <- liftIO $ get bh0
+  version <- liftIO $ get bh0
+
+  case () of
+    _ | magic /= binaryInterfaceMagic -> return . Left $
+      "Magic number mismatch: couldn't load interface file: " ++ filename
+      | version `notElem` binaryInterfaceVersionCompatibility -> return . Left $
+      "Interface file is of wrong version: " ++ filename
+      | otherwise -> with_name_cache $ \update_nc -> do
+
+      dict  <- get_dictionary bh0
+
+      -- read the symbol table so we are capable of reading the actual data
+      bh1 <- do
+          let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
+                                                   (getDictFastString dict)
+          symtab <- update_nc (get_symbol_table bh1)
+          return $ setUserData bh1 $ newReadState (getSymtabName (NCU (\f -> update_nc (return . f))) dict symtab)
+                                                  (getDictFastString dict)
+
+      -- load the actual data
+      iface <- liftIO $ get bh1
+      return (Right iface)
+ where
+   with_name_cache :: forall a.
+                      ((forall n b. MonadIO n
+                                => (NameCache -> n (NameCache, b))
+                                -> n b)
+                       -> m a)
+                   -> m a
+   with_name_cache act = do
+      nc_var <-  get_name_cache >>= (liftIO . newIORef)
+      x <- act $ \f -> do
+              nc <- liftIO $ readIORef nc_var
+              (nc', x) <- f nc
+              liftIO $ writeIORef nc_var nc'
+              return x
+      liftIO (readIORef nc_var) >>= set_name_cache
+      return x
+
+   get_dictionary bin_handle = liftIO $ do
+      dict_p <- get bin_handle
+      data_p <- tellBin bin_handle
+      seekBin bin_handle dict_p
+      dict <- getDictionary bin_handle
+      seekBin bin_handle data_p
+      return dict
+
+   get_symbol_table bh1 theNC = liftIO $ do
+      symtab_p <- get bh1
+      data_p'  <- tellBin bh1
+      seekBin bh1 symtab_p
+      (nc', symtab) <- getSymbolTable bh1 theNC
+      seekBin bh1 data_p'
+      return (nc', symtab)
+
+
+-------------------------------------------------------------------------------
+-- * Symbol table
+-------------------------------------------------------------------------------
+
+
+putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
+putName BinSymbolTable{
+            bin_symtab_map = symtab_map_ref,
+            bin_symtab_next = symtab_next }    bh name
+  = do
+    symtab_map <- readIORef symtab_map_ref
+    case lookupUFM symtab_map name of
+      Just (off,_) -> put_ bh (fromIntegral off :: Word32)
+      Nothing -> do
+         off <- readFastMutInt symtab_next
+         writeFastMutInt symtab_next (off+1)
+         writeIORef symtab_map_ref
+             $! addToUFM symtab_map name (off,name)
+         put_ bh (fromIntegral off :: Word32)
+
+
+data BinSymbolTable = BinSymbolTable {
+        bin_symtab_next :: !FastMutInt, -- The next index to use
+        bin_symtab_map  :: !(IORef (UniqFM (Int,Name)))
+                                -- indexed by Name
+  }
+
+
+putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
+putFastString BinDictionary { bin_dict_next = j_r,
+                              bin_dict_map  = out_r}  bh f
+  = do
+    out <- readIORef out_r
+    let unique = getUnique f
+    case lookupUFM out unique of
+        Just (j, _)  -> put_ bh (fromIntegral j :: Word32)
+        Nothing -> do
+           j <- readFastMutInt j_r
+           put_ bh (fromIntegral j :: Word32)
+           writeFastMutInt j_r (j + 1)
+           writeIORef out_r $! addToUFM out unique (j, f)
+
+
+data BinDictionary = BinDictionary {
+        bin_dict_next :: !FastMutInt, -- The next index to use
+        bin_dict_map  :: !(IORef (UniqFM (Int,FastString)))
+                                -- indexed by FastString
+  }
+
+
+putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
+putSymbolTable bh next_off symtab = do
+  put_ bh next_off
+  let names = elems (array (0,next_off-1) (eltsUFM symtab))
+  mapM_ (\n -> serialiseName bh n symtab) names
+
+
+getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
+getSymbolTable bh namecache = do
+  sz <- get bh
+  od_names <- replicateM sz (get bh)
+  let arr = listArray (0,sz-1) names
+      (namecache', names) = mapAccumR (fromOnDiskName arr) namecache od_names
+  return (namecache', arr)
+
+
+type OnDiskName = (PackageId, ModuleName, OccName)
+
+
+fromOnDiskName
+   :: Array Int Name
+   -> NameCache
+   -> OnDiskName
+   -> (NameCache, Name)
+fromOnDiskName _ nc (pid, mod_name, occ) =
+  let
+        modu  = mkModule pid mod_name
+        cache = nsNames nc
+  in
+  case lookupOrigNameCache cache modu occ of
+     Just name -> (nc, name)
+     Nothing   ->
+        let
+                us        = nsUniqs nc
+                u         = uniqFromSupply us
+                name      = mkExternalName u modu occ noSrcSpan
+                new_cache = extendNameCache cache modu occ name
+        in
+        case splitUniqSupply us of { (us',_) ->
+        ( nc{ nsUniqs = us', nsNames = new_cache }, name )
+        }
+
+
+serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
+serialiseName bh name _ = do
+  let modu = nameModule name
+  put_ bh (modulePackageId modu, moduleName modu, nameOccName name)
+
+
+-------------------------------------------------------------------------------
+-- * GhcBinary instances
+-------------------------------------------------------------------------------
+
+
+instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
+  put_ bh m = put_ bh (Map.toList m)
+  get bh = fmap (Map.fromList) (get bh)
+
+
+instance Binary InterfaceFile where
+  put_ bh (InterfaceFile env ifaces) = do
+    put_ bh env
+    put_ bh ifaces
+
+  get bh = do
+    env    <- get bh
+    ifaces <- get bh
+    return (InterfaceFile env ifaces)
+
+
+instance Binary InstalledInterface where
+  put_ bh (InstalledInterface modu info docMap argMap
+           exps visExps opts subMap fixMap) = do
+    put_ bh modu
+    put_ bh info
+    put_ bh docMap
+    put_ bh argMap
+    put_ bh exps
+    put_ bh visExps
+    put_ bh opts
+    put_ bh subMap
+    put_ bh fixMap
+
+  get bh = do
+    modu    <- get bh
+    info    <- get bh
+    docMap  <- get bh
+    argMap  <- get bh
+    exps    <- get bh
+    visExps <- get bh
+    opts    <- get bh
+    subMap  <- get bh
+    fixMap  <- get bh
+
+    return (InstalledInterface modu info docMap argMap
+            exps visExps opts subMap fixMap)
+
+
+instance Binary DocOption where
+    put_ bh OptHide = do
+            putByte bh 0
+    put_ bh OptPrune = do
+            putByte bh 1
+    put_ bh OptIgnoreExports = do
+            putByte bh 2
+    put_ bh OptNotHome = do
+            putByte bh 3
+    put_ bh OptShowExtensions = do
+            putByte bh 4
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do
+                    return OptHide
+              1 -> do
+                    return OptPrune
+              2 -> do
+                    return OptIgnoreExports
+              3 -> do
+                    return OptNotHome
+              4 -> do
+                    return OptShowExtensions
+              _ -> fail "invalid binary data found"
+
+
+instance Binary Example where
+    put_ bh (Example expression result) = do
+        put_ bh expression
+        put_ bh result
+    get bh = do
+        expression <- get bh
+        result <- get bh
+        return (Example expression result)
+
+instance Binary Hyperlink where
+    put_ bh (Hyperlink url label) = do
+        put_ bh url
+        put_ bh label
+    get bh = do
+        url <- get bh
+        label <- get bh
+        return (Hyperlink url label)
+
+instance Binary Picture where
+    put_ bh (Picture uri title) = do
+        put_ bh uri
+        put_ bh title
+    get bh = do
+        uri <- get bh
+        title <- get bh
+        return (Picture uri title)
+
+instance Binary a => Binary (Header a) where
+    put_ bh (Header l t) = do
+        put_ bh l
+        put_ bh t
+    get bh = do
+        l <- get bh
+        t <- get bh
+        return (Header l t)
+
+{-* Generated by DrIFT : Look, but Don't Touch. *-}
+instance (Binary mod, Binary id) => Binary (DocH mod id) where
+    put_ bh DocEmpty = do
+            putByte bh 0
+    put_ bh (DocAppend aa ab) = do
+            putByte bh 1
+            put_ bh aa
+            put_ bh ab
+    put_ bh (DocString ac) = do
+            putByte bh 2
+            put_ bh ac
+    put_ bh (DocParagraph ad) = do
+            putByte bh 3
+            put_ bh ad
+    put_ bh (DocIdentifier ae) = do
+            putByte bh 4
+            put_ bh ae
+    put_ bh (DocModule af) = do
+            putByte bh 5
+            put_ bh af
+    put_ bh (DocEmphasis ag) = do
+            putByte bh 6
+            put_ bh ag
+    put_ bh (DocMonospaced ah) = do
+            putByte bh 7
+            put_ bh ah
+    put_ bh (DocUnorderedList ai) = do
+            putByte bh 8
+            put_ bh ai
+    put_ bh (DocOrderedList aj) = do
+            putByte bh 9
+            put_ bh aj
+    put_ bh (DocDefList ak) = do
+            putByte bh 10
+            put_ bh ak
+    put_ bh (DocCodeBlock al) = do
+            putByte bh 11
+            put_ bh al
+    put_ bh (DocHyperlink am) = do
+            putByte bh 12
+            put_ bh am
+    put_ bh (DocPic x) = do
+            putByte bh 13
+            put_ bh x
+    put_ bh (DocAName an) = do
+            putByte bh 14
+            put_ bh an
+    put_ bh (DocExamples ao) = do
+            putByte bh 15
+            put_ bh ao
+    put_ bh (DocIdentifierUnchecked x) = do
+            putByte bh 16
+            put_ bh x
+    put_ bh (DocWarning ag) = do
+            putByte bh 17
+            put_ bh ag
+    put_ bh (DocProperty x) = do
+            putByte bh 18
+            put_ bh x
+    put_ bh (DocBold x) = do
+            putByte bh 19
+            put_ bh x
+    put_ bh (DocHeader aa) = do
+            putByte bh 20
+            put_ bh aa
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do
+                    return DocEmpty
+              1 -> do
+                    aa <- get bh
+                    ab <- get bh
+                    return (DocAppend aa ab)
+              2 -> do
+                    ac <- get bh
+                    return (DocString ac)
+              3 -> do
+                    ad <- get bh
+                    return (DocParagraph ad)
+              4 -> do
+                    ae <- get bh
+                    return (DocIdentifier ae)
+              5 -> do
+                    af <- get bh
+                    return (DocModule af)
+              6 -> do
+                    ag <- get bh
+                    return (DocEmphasis ag)
+              7 -> do
+                    ah <- get bh
+                    return (DocMonospaced ah)
+              8 -> do
+                    ai <- get bh
+                    return (DocUnorderedList ai)
+              9 -> do
+                    aj <- get bh
+                    return (DocOrderedList aj)
+              10 -> do
+                    ak <- get bh
+                    return (DocDefList ak)
+              11 -> do
+                    al <- get bh
+                    return (DocCodeBlock al)
+              12 -> do
+                    am <- get bh
+                    return (DocHyperlink am)
+              13 -> do
+                    x <- get bh
+                    return (DocPic x)
+              14 -> do
+                    an <- get bh
+                    return (DocAName an)
+              15 -> do
+                    ao <- get bh
+                    return (DocExamples ao)
+              16 -> do
+                    x <- get bh
+                    return (DocIdentifierUnchecked x)
+              17 -> do
+                    ag <- get bh
+                    return (DocWarning ag)
+              18 -> do
+                    x <- get bh
+                    return (DocProperty x)
+              19 -> do
+                    x <- get bh
+                    return (DocBold x)
+              20 -> do
+                    aa <- get bh
+                    return (DocHeader aa)
+              _ -> error "invalid binary data found in the interface file"
+
+
+instance Binary name => Binary (HaddockModInfo name) where
+  put_ bh hmi = do
+    put_ bh (hmi_description hmi)
+    put_ bh (hmi_copyright   hmi)
+    put_ bh (hmi_license     hmi)
+    put_ bh (hmi_maintainer  hmi)
+    put_ bh (hmi_stability   hmi)
+    put_ bh (hmi_portability hmi)
+    put_ bh (hmi_safety      hmi)
+    put_ bh (fromEnum <$> hmi_language hmi)
+    put_ bh (map fromEnum $ hmi_extensions hmi)
+
+  get bh = do
+    descr <- get bh
+    copyr <- get bh
+    licen <- get bh
+    maint <- get bh
+    stabi <- get bh
+    porta <- get bh
+    safet <- get bh
+    langu <- fmap toEnum <$> get bh
+    exten <- map toEnum <$> get bh
+    return (HaddockModInfo descr copyr licen maint stabi porta safet langu exten)
+
+instance Binary DocName where
+  put_ bh (Documented name modu) = do
+    putByte bh 0
+    put_ bh name
+    put_ bh modu
+  put_ bh (Undocumented name) = do
+    putByte bh 1
+    put_ bh name
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> do
+        name <- get bh
+        modu <- get bh
+        return (Documented name modu)
+      1 -> do
+        name <- get bh
+        return (Undocumented name)
+      _ -> error "get DocName: Bad h"
diff --git a/haddock-api/src/Haddock/ModuleTree.hs b/haddock-api/src/Haddock/ModuleTree.hs
new file mode 100644
index 00000000..2a7fbfcc
--- /dev/null
+++ b/haddock-api/src/Haddock/ModuleTree.hs
@@ -0,0 +1,56 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.ModuleTree
+-- Copyright   :  (c) Simon Marlow 2003-2006,
+--                    David Waern  2006
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
+
+
+import Haddock.Types ( Doc )
+
+import GHC           ( Name )
+import Module        ( Module, moduleNameString, moduleName, modulePackageId,
+                       packageIdString )
+
+
+data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree]
+
+
+mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree]
+mkModuleTree showPkgs mods =
+  foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]
+  where
+    modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_))
+                | otherwise = Nothing
+    fn (mod_,pkg,short) = addToTrees mod_ pkg short
+
+
+addToTrees :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] -> [ModuleTree]
+addToTrees [] _ _ ts = ts
+addToTrees ss pkg short [] = mkSubTree ss pkg short
+addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts)
+  | s1 >  s2  = t : addToTrees (s1:ss) pkg short ts
+  | s1 == s2  = Node s2 (leaf || null ss) this_pkg this_short (addToTrees ss pkg short subs) : ts
+  | otherwise = mkSubTree (s1:ss) pkg short ++ t : ts
+ where
+  this_pkg = if null ss then pkg else node_pkg
+  this_short = if null ss then short else node_short
+
+
+mkSubTree :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree]
+mkSubTree []     _   _     = []
+mkSubTree [s]    pkg short = [Node s True pkg short []]
+mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)]
+
+
+splitModule :: Module -> [String]
+splitModule mdl = split (moduleNameString (moduleName mdl))
+  where split mod0 = case break (== '.') mod0 of
+          (s1, '.':s2) -> s1 : split s2
+          (s1, _)      -> [s1]
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
new file mode 100644
index 00000000..b166de46
--- /dev/null
+++ b/haddock-api/src/Haddock/Options.hs
@@ -0,0 +1,287 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Options
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Definition of the command line interface of Haddock.
+-----------------------------------------------------------------------------
+module Haddock.Options (
+  parseHaddockOpts,
+  Flag(..),
+  getUsage,
+  optTitle,
+  outputDir,
+  optContentsUrl,
+  optIndexUrl,
+  optCssFile,
+  sourceUrls,
+  wikiUrls,
+  optDumpInterfaceFile,
+  optLaTeXStyle,
+  qualification,
+  verbosity,
+  ghcFlags,
+  readIfaceArgs
+) where
+
+
+import Distribution.Verbosity
+import Haddock.Utils
+import Haddock.Types
+import System.Console.GetOpt
+import qualified Data.Char as Char
+
+
+data Flag
+  = Flag_BuiltInThemes
+  | Flag_CSS String
+--  | Flag_DocBook
+  | Flag_ReadInterface String
+  | Flag_DumpInterface String
+  | Flag_Heading String
+  | Flag_Html
+  | Flag_Hoogle
+  | Flag_Lib String
+  | Flag_OutputDir FilePath
+  | Flag_Prologue FilePath
+  | Flag_SourceBaseURL    String
+  | Flag_SourceModuleURL  String
+  | Flag_SourceEntityURL  String
+  | Flag_SourceLEntityURL String
+  | Flag_WikiBaseURL   String
+  | Flag_WikiModuleURL String
+  | Flag_WikiEntityURL String
+  | Flag_LaTeX
+  | Flag_LaTeXStyle String
+  | Flag_Help
+  | Flag_Verbosity String
+  | Flag_Version
+  | Flag_CompatibleInterfaceVersions
+  | Flag_InterfaceVersion
+  | Flag_UseContents String
+  | Flag_GenContents
+  | Flag_UseIndex String
+  | Flag_GenIndex
+  | Flag_IgnoreAllExports
+  | Flag_HideModule String
+  | Flag_ShowExtensions String
+  | Flag_OptGhc String
+  | Flag_GhcLibDir String
+  | Flag_GhcVersion
+  | Flag_PrintGhcPath
+  | Flag_PrintGhcLibDir
+  | Flag_NoWarnings
+  | Flag_UseUnicode
+  | Flag_NoTmpCompDir
+  | Flag_Qualification String
+  | Flag_PrettyHtml
+  | Flag_PrintMissingDocs
+  deriving (Eq)
+
+
+options :: Bool -> [OptDescr Flag]
+options backwardsCompat =
+  [
+    Option ['B']  []     (ReqArg Flag_GhcLibDir "DIR")
+      "path to a GHC lib dir, to override the default path",
+    Option ['o']  ["odir"]     (ReqArg Flag_OutputDir "DIR")
+      "directory in which to put the output files",
+    Option ['l']  ["lib"]         (ReqArg Flag_Lib "DIR")
+      "location of Haddock's auxiliary files",
+    Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE")
+      "read an interface from FILE",
+    Option ['D']  ["dump-interface"] (ReqArg Flag_DumpInterface "FILE")
+      "write the resulting interface to FILE",
+--    Option ['S']  ["docbook"]  (NoArg Flag_DocBook)
+--  "output in DocBook XML",
+    Option ['h']  ["html"]     (NoArg Flag_Html)
+      "output in HTML (XHTML 1.0)",
+    Option []  ["latex"]  (NoArg Flag_LaTeX) "use experimental LaTeX rendering",
+    Option []  ["latex-style"]  (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE",
+    Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
+    Option []  ["hoogle"]     (NoArg Flag_Hoogle)
+      "output for Hoogle",
+    Option []  ["source-base"]   (ReqArg Flag_SourceBaseURL "URL")
+      "URL for a source code link on the contents\nand index pages",
+    Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
+      (ReqArg Flag_SourceModuleURL "URL")
+      "URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)",
+    Option []  ["source-entity"]  (ReqArg Flag_SourceEntityURL "URL")
+      "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
+    Option []  ["source-entity-line"] (ReqArg Flag_SourceLEntityURL "URL")
+      "URL for a source code link for each entity.\nUsed if name links are unavailable, eg. for TH splices.",
+    Option []  ["comments-base"]   (ReqArg Flag_WikiBaseURL "URL")
+      "URL for a comments link on the contents\nand index pages",
+    Option []  ["comments-module"]  (ReqArg Flag_WikiModuleURL "URL")
+      "URL for a comments link for each module\n(using the %{MODULE} var)",
+    Option []  ["comments-entity"]  (ReqArg Flag_WikiEntityURL "URL")
+      "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
+    Option ['c']  ["css", "theme"] (ReqArg Flag_CSS "PATH")
+      "the CSS file or theme directory to use for HTML output",
+    Option []  ["built-in-themes"] (NoArg Flag_BuiltInThemes)
+      "include all the built-in haddock themes",
+    Option ['p']  ["prologue"] (ReqArg Flag_Prologue "FILE")
+      "file containing prologue text",
+    Option ['t']  ["title"]    (ReqArg Flag_Heading "TITLE")
+      "page heading",
+    Option ['q']  ["qual"] (ReqArg Flag_Qualification "QUAL")
+      "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'",
+    Option ['?']  ["help"]  (NoArg Flag_Help)
+      "display this help and exit",
+    Option ['V']  ["version"]  (NoArg Flag_Version)
+      "output version information and exit",
+    Option []  ["compatible-interface-versions"]  (NoArg Flag_CompatibleInterfaceVersions)
+      "output compatible interface file versions and exit",
+    Option []  ["interface-version"]  (NoArg Flag_InterfaceVersion)
+      "output interface file version and exit",
+    Option ['v']  ["verbosity"]  (ReqArg Flag_Verbosity "VERBOSITY")
+      "set verbosity level",
+    Option [] ["use-contents"] (ReqArg Flag_UseContents "URL")
+      "use a separately-generated HTML contents page",
+    Option [] ["gen-contents"] (NoArg Flag_GenContents)
+      "generate an HTML contents from specified\ninterfaces",
+    Option [] ["use-index"] (ReqArg Flag_UseIndex "URL")
+      "use a separately-generated HTML index",
+    Option [] ["gen-index"] (NoArg Flag_GenIndex)
+      "generate an HTML index from specified\ninterfaces",
+    Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports)
+      "behave as if all modules have the\nignore-exports atribute",
+    Option [] ["hide"] (ReqArg Flag_HideModule "MODULE")
+      "behave as if MODULE has the hide attribute",
+    Option [] ["show-extensions"] (ReqArg Flag_ShowExtensions "MODULE")
+      "behave as if MODULE has the show-extensions attribute",
+    Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION")
+      "option to be forwarded to GHC",
+    Option []  ["ghc-version"]  (NoArg Flag_GhcVersion)
+      "output GHC version in numeric format",
+    Option []  ["print-ghc-path"]  (NoArg Flag_PrintGhcPath)
+      "output path to GHC binary",
+    Option []  ["print-ghc-libdir"]  (NoArg Flag_PrintGhcLibDir)
+      "output GHC lib dir",
+    Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings",
+    Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir)
+      "do not re-direct compilation output to a temporary directory",
+    Option [] ["pretty-html"] (NoArg Flag_PrettyHtml)
+      "generate html with newlines and indenting (for use with --html)",
+    Option [] ["print-missing-docs"] (NoArg Flag_PrintMissingDocs)
+      "print information about any undocumented entities"
+  ]
+
+
+getUsage :: IO String
+getUsage = do
+  prog <- getProgramName
+  return $ usageInfo (usageHeader prog) (options False)
+  where
+    usageHeader :: String -> String
+    usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n"
+
+
+parseHaddockOpts :: [String] -> IO ([Flag], [String])
+parseHaddockOpts params =
+  case getOpt Permute (options True) params  of
+    (flags, args, []) -> return (flags, args)
+    (_, _, errors)    -> do
+      usage <- getUsage
+      throwE (concat errors ++ usage)
+
+
+optTitle :: [Flag] -> Maybe String
+optTitle flags =
+  case [str | Flag_Heading str <- flags] of
+    [] -> Nothing
+    (t:_) -> Just t
+
+
+outputDir :: [Flag] -> FilePath
+outputDir flags =
+  case [ path | Flag_OutputDir path <- flags ] of
+    []    -> "."
+    paths -> last paths
+
+
+optContentsUrl :: [Flag] -> Maybe String
+optContentsUrl flags = optLast [ url | Flag_UseContents url <- flags ]
+
+
+optIndexUrl :: [Flag] -> Maybe String
+optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
+
+
+optCssFile :: [Flag] -> Maybe FilePath
+optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
+
+
+sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String)
+sourceUrls flags =
+  (optLast [str | Flag_SourceBaseURL    str <- flags]
+  ,optLast [str | Flag_SourceModuleURL  str <- flags]
+  ,optLast [str | Flag_SourceEntityURL  str <- flags]
+  ,optLast [str | Flag_SourceLEntityURL str <- flags])
+
+
+wikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
+wikiUrls flags =
+  (optLast [str | Flag_WikiBaseURL   str <- flags]
+  ,optLast [str | Flag_WikiModuleURL str <- flags]
+  ,optLast [str | Flag_WikiEntityURL str <- flags])
+
+
+optDumpInterfaceFile :: [Flag] -> Maybe FilePath
+optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ]
+
+
+optLaTeXStyle :: [Flag] -> Maybe String
+optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
+
+
+qualification :: [Flag] -> Either String QualOption
+qualification flags =
+  case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of
+      []             -> Right OptNoQual
+      ["none"]       -> Right OptNoQual
+      ["full"]       -> Right OptFullQual
+      ["local"]      -> Right OptLocalQual
+      ["relative"]   -> Right OptRelativeQual
+      ["aliased"]    -> Right OptAliasedQual
+      [arg]          -> Left $ "unknown qualification type " ++ show arg
+      _:_            -> Left "qualification option given multiple times"
+
+
+verbosity :: [Flag] -> Verbosity
+verbosity flags =
+  case [ str | Flag_Verbosity str <- flags ] of
+    []  -> normal
+    x:_ -> case parseVerbosity x of
+      Left e -> throwE e
+      Right v -> v
+
+
+ghcFlags :: [Flag] -> [String]
+ghcFlags flags = [ option | Flag_OptGhc option <- flags ]
+
+
+readIfaceArgs :: [Flag] -> [(DocPaths, FilePath)]
+readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ]
+  where
+    parseIfaceOption :: String -> (DocPaths, FilePath)
+    parseIfaceOption str =
+      case break (==',') str of
+        (fpath, ',':rest) ->
+          case break (==',') rest of
+            (src, ',':file) -> ((fpath, Just src), file)
+            (file, _) -> ((fpath, Nothing), file)
+        (file, _) -> (("", Nothing), file)
+
+
+-- | Like 'listToMaybe' but returns the last element instead of the first.
+optLast :: [a] -> Maybe a
+optLast [] = Nothing
+optLast xs = Just (last xs)
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
new file mode 100644
index 00000000..ea4b7a3f
--- /dev/null
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving
+             , FlexibleInstances, UndecidableInstances
+             , IncoherentInstances #-}
+{-# LANGUAGE LambdaCase #-}
+-- |
+-- Module      :  Haddock.Parser
+-- Copyright   :  (c) Mateusz Kowalczyk 2013,
+--                    Simon Hengel      2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+
+module Haddock.Parser ( parseParas
+                      , parseString
+                      , parseIdent
+                      ) where
+
+import qualified Documentation.Haddock.Parser as P
+import DynFlags (DynFlags)
+import FastString (mkFastString)
+import Documentation.Haddock.Types
+import Lexer (mkPState, unP, ParseResult(POk))
+import Parser (parseIdentifier)
+import RdrName (RdrName)
+import SrcLoc (mkRealSrcLoc, unLoc)
+import StringBuffer (stringToStringBuffer)
+
+parseParas :: DynFlags -> String -> DocH mod RdrName
+parseParas d = P.overIdentifier (parseIdent d) . P.parseParas
+
+parseString :: DynFlags -> String -> DocH mod RdrName
+parseString d = P.overIdentifier (parseIdent d) . P.parseString
+
+parseIdent :: DynFlags -> String -> Maybe RdrName
+parseIdent dflags str0 =
+  let buffer = stringToStringBuffer str0
+      realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
+      pstate = mkPState dflags buffer realSrcLc
+  in case unP parseIdentifier pstate of
+    POk _ name -> Just (unLoc name)
+    _ -> Nothing
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
new file mode 100644
index 00000000..85b3a592
--- /dev/null
+++ b/haddock-api/src/Haddock/Types.hs
@@ -0,0 +1,552 @@
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Types
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2009,
+--                    Mateusz Kowalczyk 2013
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskellorg
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Types that are commonly used through-out Haddock. Some of the most
+-- important types are defined here, like 'Interface' and 'DocName'.
+-----------------------------------------------------------------------------
+module Haddock.Types (
+  module Haddock.Types
+  , HsDocString, LHsDocString
+  , Fixity(..)
+  , module Documentation.Haddock.Types
+ ) where
+
+import Control.Exception
+import Control.Arrow hiding ((<+>))
+import Control.DeepSeq
+import Data.Typeable
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Documentation.Haddock.Types
+import BasicTypes (Fixity(..))
+import GHC hiding (NoLink)
+import DynFlags (ExtensionFlag, Language)
+import OccName
+import Outputable
+import Control.Applicative (Applicative(..))
+import Control.Monad (ap)
+
+-----------------------------------------------------------------------------
+-- * Convenient synonyms
+-----------------------------------------------------------------------------
+
+
+type IfaceMap      = Map Module Interface
+type InstIfaceMap  = Map Module InstalledInterface  -- TODO: rename
+type DocMap a      = Map Name (Doc a)
+type ArgMap a      = Map Name (Map Int (Doc a))
+type SubMap        = Map Name [Name]
+type DeclMap       = Map Name [LHsDecl Name]
+type InstMap       = Map SrcSpan Name
+type FixMap        = Map Name Fixity
+type SrcMap        = Map PackageId FilePath
+type DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources
+
+
+-----------------------------------------------------------------------------
+-- * Interface
+-----------------------------------------------------------------------------
+
+
+-- | 'Interface' holds all information used to render a single Haddock page.
+-- It represents the /interface/ of a module. The core business of Haddock
+-- lies in creating this structure. Note that the record contains some fields
+-- that are only used to create the final record, and that are not used by the
+-- backends.
+data Interface = Interface
+  {
+    -- | The module behind this interface.
+    ifaceMod             :: !Module
+
+    -- | Original file name of the module.
+  , ifaceOrigFilename    :: !FilePath
+
+    -- | Textual information about the module.
+  , ifaceInfo            :: !(HaddockModInfo Name)
+
+    -- | Documentation header.
+  , ifaceDoc             :: !(Documentation Name)
+
+    -- | Documentation header with cross-reference information.
+  , ifaceRnDoc           :: !(Documentation DocName)
+
+    -- | Haddock options for this module (prune, ignore-exports, etc).
+  , ifaceOptions         :: ![DocOption]
+
+    -- | Declarations originating from the module. Excludes declarations without
+    -- names (instances and stand-alone documentation comments). Includes
+    -- names of subordinate declarations mapped to their parent declarations.
+  , ifaceDeclMap         :: !(Map Name [LHsDecl Name])
+
+    -- | Documentation of declarations originating from the module (including
+    -- subordinates).
+  , ifaceDocMap          :: !(DocMap Name)
+  , ifaceArgMap          :: !(ArgMap Name)
+
+    -- | Documentation of declarations originating from the module (including
+    -- subordinates).
+  , ifaceRnDocMap        :: !(DocMap DocName)
+  , ifaceRnArgMap        :: !(ArgMap DocName)
+
+  , ifaceSubMap          :: !(Map Name [Name])
+  , ifaceFixMap          :: !(Map Name Fixity)
+
+  , ifaceExportItems     :: ![ExportItem Name]
+  , ifaceRnExportItems   :: ![ExportItem DocName]
+
+    -- | All names exported by the module.
+  , ifaceExports         :: ![Name]
+
+    -- | All \"visible\" names exported by the module.
+    -- A visible name is a name that will show up in the documentation of the
+    -- module.
+  , ifaceVisibleExports  :: ![Name]
+
+    -- | Aliases of module imports as in @import A.B.C as C@.
+  , ifaceModuleAliases   :: !AliasMap
+
+    -- | Instances exported by the module.
+  , ifaceInstances       :: ![ClsInst]
+  , ifaceFamInstances    :: ![FamInst]
+
+    -- | The number of haddockable and haddocked items in the module, as a
+    -- tuple. Haddockable items are the exports and the module itself.
+  , ifaceHaddockCoverage :: !(Int, Int)
+
+    -- | Warnings for things defined in this module.
+  , ifaceWarningMap :: !WarningMap
+  }
+
+type WarningMap = DocMap Name
+
+
+-- | A subset of the fields of 'Interface' that we store in the interface
+-- files.
+data InstalledInterface = InstalledInterface
+  {
+    -- | The module represented by this interface.
+    instMod            :: Module
+
+    -- | Textual information about the module.
+  , instInfo           :: HaddockModInfo Name
+
+    -- | Documentation of declarations originating from the module (including
+    -- subordinates).
+  , instDocMap         :: DocMap Name
+
+  , instArgMap         :: ArgMap Name
+
+    -- | All names exported by this module.
+  , instExports        :: [Name]
+
+    -- | All \"visible\" names exported by the module.
+    -- A visible name is a name that will show up in the documentation of the
+    -- module.
+  , instVisibleExports :: [Name]
+
+    -- | Haddock options for this module (prune, ignore-exports, etc).
+  , instOptions        :: [DocOption]
+
+  , instSubMap         :: Map Name [Name]
+  , instFixMap         :: Map Name Fixity
+  }
+
+
+-- | Convert an 'Interface' to an 'InstalledInterface'
+toInstalledIface :: Interface -> InstalledInterface
+toInstalledIface interface = InstalledInterface
+  { instMod            = ifaceMod            interface
+  , instInfo           = ifaceInfo           interface
+  , instDocMap         = ifaceDocMap         interface
+  , instArgMap         = ifaceArgMap         interface
+  , instExports        = ifaceExports        interface
+  , instVisibleExports = ifaceVisibleExports interface
+  , instOptions        = ifaceOptions        interface
+  , instSubMap         = ifaceSubMap         interface
+  , instFixMap         = ifaceFixMap         interface
+  }
+
+
+-----------------------------------------------------------------------------
+-- * Export items & declarations
+-----------------------------------------------------------------------------
+
+
+data ExportItem name
+
+  -- | An exported declaration.
+  = ExportDecl
+      {
+        -- | A declaration.
+        expItemDecl :: !(LHsDecl name)
+
+        -- | Maybe a doc comment, and possibly docs for arguments (if this
+        -- decl is a function or type-synonym).
+      , expItemMbDoc :: !(DocForDecl name)
+
+        -- | Subordinate names, possibly with documentation.
+      , expItemSubDocs :: ![(name, DocForDecl name)]
+
+        -- | Instances relevant to this declaration, possibly with
+        -- documentation.
+      , expItemInstances :: ![DocInstance name]
+
+        -- | Fixity decls relevant to this declaration (including subordinates).
+      , expItemFixities :: ![(name, Fixity)]
+
+        -- | Whether the ExportItem is from a TH splice or not, for generating
+        -- the appropriate type of Source link.
+      , expItemSpliced :: !Bool
+      }
+
+  -- | An exported entity for which we have no documentation (perhaps because it
+  -- resides in another package).
+  | ExportNoDecl
+      { expItemName :: !name
+
+        -- | Subordinate names.
+      , expItemSubs :: ![name]
+      }
+
+  -- | A section heading.
+  | ExportGroup
+      {
+        -- | Section level (1, 2, 3, ...).
+        expItemSectionLevel :: !Int
+
+        -- | Section id (for hyperlinks).
+      , expItemSectionId :: !String
+
+        -- | Section heading text.
+      , expItemSectionText :: !(Doc name)
+      }
+
+  -- | Some documentation.
+  | ExportDoc !(Doc name)
+
+  -- | A cross-reference to another module.
+  | ExportModule !Module
+
+data Documentation name = Documentation
+  { documentationDoc :: Maybe (Doc name)
+  , documentationWarning :: !(Maybe (Doc name))
+  } deriving Functor
+
+
+-- | Arguments and result are indexed by Int, zero-based from the left,
+-- because that's the easiest to use when recursing over types.
+type FnArgsDoc name = Map Int (Doc name)
+type DocForDecl name = (Documentation name, FnArgsDoc name)
+
+
+noDocForDecl :: DocForDecl name
+noDocForDecl = (Documentation Nothing Nothing, Map.empty)
+
+
+unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
+unrenameDocForDecl (doc, fnArgsDoc) =
+    (fmap getName doc, (fmap . fmap) getName fnArgsDoc)
+
+
+-----------------------------------------------------------------------------
+-- * Cross-referencing
+-----------------------------------------------------------------------------
+
+
+-- | Type of environment used to cross-reference identifiers in the syntax.
+type LinkEnv = Map Name Module
+
+
+-- | Extends 'Name' with cross-reference information.
+data DocName
+  = Documented Name Module
+     -- ^ This thing is part of the (existing or resulting)
+     -- documentation. The 'Module' is the preferred place
+     -- in the documentation to refer to.
+  | Undocumented Name
+     -- ^ This thing is not part of the (existing or resulting)
+     -- documentation, as far as Haddock knows.
+  deriving Eq
+
+
+instance NamedThing DocName where
+  getName (Documented name _) = name
+  getName (Undocumented name) = name
+
+
+-----------------------------------------------------------------------------
+-- * Instances
+-----------------------------------------------------------------------------
+
+-- | The three types of instances
+data InstType name
+  = ClassInst [HsType name]         -- ^ Context
+  | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
+  | DataInst (TyClDecl name)        -- ^ Data constructors
+
+instance OutputableBndr a => Outputable (InstType a) where
+  ppr (ClassInst a) = text "ClassInst" <+> ppr a
+  ppr (TypeInst  a) = text "TypeInst"  <+> ppr a
+  ppr (DataInst  a) = text "DataInst"  <+> ppr a
+
+-- | An instance head that may have documentation.
+type DocInstance name = (InstHead name, Maybe (Doc name))
+
+-- | The head of an instance. Consists of a class name, a list of kind
+-- parameters, a list of type parameters and an instance type
+type InstHead name = (name, [HsType name], [HsType name], InstType name)
+
+-----------------------------------------------------------------------------
+-- * Documentation comments
+-----------------------------------------------------------------------------
+
+
+type LDoc id = Located (Doc id)
+
+type Doc id = DocH (ModuleName, OccName) id
+
+instance (NFData a, NFData mod)
+         => NFData (DocH mod a) where
+  rnf doc = case doc of
+    DocEmpty                  -> ()
+    DocAppend a b             -> a `deepseq` b `deepseq` ()
+    DocString a               -> a `deepseq` ()
+    DocParagraph a            -> a `deepseq` ()
+    DocIdentifier a           -> a `deepseq` ()
+    DocIdentifierUnchecked a  -> a `deepseq` ()
+    DocModule a               -> a `deepseq` ()
+    DocWarning a              -> a `deepseq` ()
+    DocEmphasis a             -> a `deepseq` ()
+    DocBold a                 -> a `deepseq` ()
+    DocMonospaced a           -> a `deepseq` ()
+    DocUnorderedList a        -> a `deepseq` ()
+    DocOrderedList a          -> a `deepseq` ()
+    DocDefList a              -> a `deepseq` ()
+    DocCodeBlock a            -> a `deepseq` ()
+    DocHyperlink a            -> a `deepseq` ()
+    DocPic a                  -> a `deepseq` ()
+    DocAName a                -> a `deepseq` ()
+    DocProperty a             -> a `deepseq` ()
+    DocExamples a             -> a `deepseq` ()
+    DocHeader a               -> a `deepseq` ()
+
+
+instance NFData Name
+instance NFData OccName
+instance NFData ModuleName
+
+instance NFData id => NFData (Header id) where
+  rnf (Header a b) = a `deepseq` b `deepseq` ()
+
+instance NFData Hyperlink where
+  rnf (Hyperlink a b) = a `deepseq` b `deepseq` ()
+
+instance NFData Picture where
+  rnf (Picture a b) = a `deepseq` b `deepseq` ()
+
+instance NFData Example where
+  rnf (Example a b) = a `deepseq` b `deepseq` ()
+
+
+exampleToString :: Example -> String
+exampleToString (Example expression result) =
+    ">>> " ++ expression ++ "\n" ++  unlines result
+
+
+data DocMarkup id a = Markup
+  { markupEmpty                :: a
+  , markupString               :: String -> a
+  , markupParagraph            :: a -> a
+  , markupAppend               :: a -> a -> a
+  , markupIdentifier           :: id -> a
+  , markupIdentifierUnchecked  :: (ModuleName, OccName) -> a
+  , markupModule               :: String -> a
+  , markupWarning              :: a -> a
+  , markupEmphasis             :: a -> a
+  , markupBold                 :: a -> a
+  , markupMonospaced           :: a -> a
+  , markupUnorderedList        :: [a] -> a
+  , markupOrderedList          :: [a] -> a
+  , markupDefList              :: [(a,a)] -> a
+  , markupCodeBlock            :: a -> a
+  , markupHyperlink            :: Hyperlink -> a
+  , markupAName                :: String -> a
+  , markupPic                  :: Picture -> a
+  , markupProperty             :: String -> a
+  , markupExample              :: [Example] -> a
+  , markupHeader               :: Header a -> a
+  }
+
+
+data HaddockModInfo name = HaddockModInfo
+  { hmi_description :: Maybe (Doc name)
+  , hmi_copyright   :: Maybe String
+  , hmi_license     :: Maybe String
+  , hmi_maintainer  :: Maybe String
+  , hmi_stability   :: Maybe String
+  , hmi_portability :: Maybe String
+  , hmi_safety      :: Maybe String
+  , hmi_language    :: Maybe Language
+  , hmi_extensions  :: [ExtensionFlag]
+  }
+
+
+emptyHaddockModInfo :: HaddockModInfo a
+emptyHaddockModInfo = HaddockModInfo
+  { hmi_description = Nothing
+  , hmi_copyright   = Nothing
+  , hmi_license     = Nothing
+  , hmi_maintainer  = Nothing
+  , hmi_stability   = Nothing
+  , hmi_portability = Nothing
+  , hmi_safety      = Nothing
+  , hmi_language    = Nothing
+  , hmi_extensions  = []
+  }
+
+
+-----------------------------------------------------------------------------
+-- * Options
+-----------------------------------------------------------------------------
+
+
+{-! for DocOption derive: Binary !-}
+-- | Source-level options for controlling the documentation.
+data DocOption
+  = OptHide            -- ^ This module should not appear in the docs.
+  | OptPrune
+  | OptIgnoreExports   -- ^ Pretend everything is exported.
+  | OptNotHome         -- ^ Not the best place to get docs for things
+                       -- exported by this module.
+  | OptShowExtensions  -- ^ Render enabled extensions for this module.
+  deriving (Eq, Show)
+
+
+-- | Option controlling how to qualify names
+data QualOption
+  = OptNoQual         -- ^ Never qualify any names.
+  | OptFullQual       -- ^ Qualify all names fully.
+  | OptLocalQual      -- ^ Qualify all imported names fully.
+  | OptRelativeQual   -- ^ Like local, but strip module prefix
+                      --   from modules in the same hierarchy.
+  | OptAliasedQual    -- ^ Uses aliases of module names
+                      --   as suggested by module import renamings.
+                      --   However, we are unfortunately not able
+                      --   to maintain the original qualifications.
+                      --   Image a re-export of a whole module,
+                      --   how could the re-exported identifiers be qualified?
+
+type AliasMap = Map Module ModuleName
+
+data Qualification
+  = NoQual
+  | FullQual
+  | LocalQual Module
+  | RelativeQual Module
+  | AliasedQual AliasMap Module
+       -- ^ @Module@ contains the current module.
+       --   This way we can distinguish imported and local identifiers.
+
+makeContentsQual :: QualOption -> Qualification
+makeContentsQual qual =
+  case qual of
+    OptNoQual -> NoQual
+    _         -> FullQual
+
+makeModuleQual :: QualOption -> AliasMap -> Module -> Qualification
+makeModuleQual qual aliases mdl =
+  case qual of
+    OptLocalQual      -> LocalQual mdl
+    OptRelativeQual   -> RelativeQual mdl
+    OptAliasedQual    -> AliasedQual aliases mdl
+    OptFullQual       -> FullQual
+    OptNoQual         -> NoQual
+
+
+-----------------------------------------------------------------------------
+-- * Error handling
+-----------------------------------------------------------------------------
+
+
+-- A monad which collects error messages, locally defined to avoid a dep on mtl
+
+
+type ErrMsg = String
+newtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) }
+
+
+instance Functor ErrMsgM where
+        fmap f (Writer (a, msgs)) = Writer (f a, msgs)
+
+instance Applicative ErrMsgM where
+    pure = return
+    (<*>) = ap
+
+instance Monad ErrMsgM where
+        return a = Writer (a, [])
+        m >>= k  = Writer $ let
+                (a, w)  = runWriter m
+                (b, w') = runWriter (k a)
+                in (b, w ++ w')
+
+
+tell :: [ErrMsg] -> ErrMsgM ()
+tell w = Writer ((), w)
+
+
+-- Exceptions
+
+
+-- | Haddock's own exception type.
+data HaddockException = HaddockException String deriving Typeable
+
+
+instance Show HaddockException where
+  show (HaddockException str) = str
+
+
+throwE :: String -> a
+instance Exception HaddockException
+throwE str = throw (HaddockException str)
+
+
+-- In "Haddock.Interface.Create", we need to gather
+-- @Haddock.Types.ErrMsg@s a lot, like @ErrMsgM@ does,
+-- but we can't just use @GhcT ErrMsgM@ because GhcT requires the
+-- transformed monad to be MonadIO.
+newtype ErrMsgGhc a = WriterGhc { runWriterGhc :: Ghc (a, [ErrMsg]) }
+--instance MonadIO ErrMsgGhc where
+--  liftIO = WriterGhc . fmap (\a->(a,[])) liftIO
+--er, implementing GhcMonad involves annoying ExceptionMonad and
+--WarnLogMonad classes, so don't bother.
+liftGhcToErrMsgGhc :: Ghc a -> ErrMsgGhc a
+liftGhcToErrMsgGhc = WriterGhc . fmap (\a->(a,[]))
+liftErrMsg :: ErrMsgM a -> ErrMsgGhc a
+liftErrMsg = WriterGhc . return . runWriter
+--  for now, use (liftErrMsg . tell) for this
+--tell :: [ErrMsg] -> ErrMsgGhc ()
+--tell msgs = WriterGhc $ return ( (), msgs )
+
+
+instance Functor ErrMsgGhc where
+  fmap f (WriterGhc x) = WriterGhc (fmap (first f) x)
+
+instance Applicative ErrMsgGhc where
+    pure = return
+    (<*>) = ap
+
+instance Monad ErrMsgGhc where
+  return a = WriterGhc (return (a, []))
+  m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
+               fmap (second (msgs1 ++)) (runWriterGhc (k a))
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
new file mode 100644
index 00000000..ee7bfd0a
--- /dev/null
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -0,0 +1,480 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Utils
+-- Copyright   :  (c) The University of Glasgow 2001-2002,
+--                    Simon Marlow 2003-2006,
+--                    David Waern  2006-2009
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Utils (
+
+  -- * Misc utilities
+  restrictTo, emptyHsQTvs,
+  toDescription, toInstalledDescription,
+
+  -- * Filename utilities
+  moduleHtmlFile, moduleHtmlFile',
+  contentsHtmlFile, indexHtmlFile,
+  frameIndexHtmlFile,
+  moduleIndexFrameName, mainFrameName, synopsisFrameName,
+  subIndexHtmlFile,
+  jsFile, framesFile,
+
+  -- * Anchor and URL utilities
+  moduleNameUrl, moduleNameUrl', moduleUrl,
+  nameAnchorId,
+  makeAnchorId,
+
+  -- * Miscellaneous utilities
+  getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
+
+  -- * HTML cross reference mapping
+  html_xrefs_ref, html_xrefs_ref',
+
+  -- * Doc markup
+  markup,
+  idMarkup,
+
+  -- * List utilities
+  replace,
+  spanWith,
+
+  -- * MTL stuff
+  MonadIO(..),
+
+  -- * Logging
+  parseVerbosity,
+  out,
+
+  -- * System tools
+  getProcessID
+ ) where
+
+
+import Haddock.Types
+import Haddock.GhcUtils
+
+import GHC
+import Name
+
+import Control.Monad ( liftM )
+import Data.Char ( isAlpha, isAlphaNum, isAscii, ord, chr )
+import Numeric ( showIntAtBase )
+import Data.Map ( Map )
+import qualified Data.Map as Map hiding ( Map )
+import Data.IORef ( IORef, newIORef, readIORef )
+import Data.List ( isSuffixOf )
+import Data.Maybe ( mapMaybe )
+import System.Environment ( getProgName )
+import System.Exit
+import System.IO ( hPutStr, stderr )
+import System.IO.Unsafe ( unsafePerformIO )
+import qualified System.FilePath.Posix as HtmlPath
+import Distribution.Verbosity
+import Distribution.ReadE
+
+#ifndef mingw32_HOST_OS
+import qualified System.Posix.Internals
+#endif
+
+import MonadUtils ( MonadIO(..) )
+
+
+--------------------------------------------------------------------------------
+-- * Logging
+--------------------------------------------------------------------------------
+
+
+parseVerbosity :: String -> Either String Verbosity
+parseVerbosity = runReadE flagToVerbosity
+
+
+-- | Print a message to stdout, if it is not too verbose
+out :: MonadIO m
+    => Verbosity -- ^ program verbosity
+    -> Verbosity -- ^ message verbosity
+    -> String -> m ()
+out progVerbosity msgVerbosity msg
+  | msgVerbosity <= progVerbosity = liftIO $ putStrLn msg
+  | otherwise = return ()
+
+
+--------------------------------------------------------------------------------
+-- * Some Utilities
+--------------------------------------------------------------------------------
+
+
+-- | Extract a module's short description.
+toDescription :: Interface -> Maybe (Doc Name)
+toDescription = hmi_description . ifaceInfo
+
+
+-- | Extract a module's short description.
+toInstalledDescription :: InstalledInterface -> Maybe (Doc Name)
+toInstalledDescription = hmi_description . instInfo
+
+
+--------------------------------------------------------------------------------
+-- * Making abstract declarations
+--------------------------------------------------------------------------------
+
+
+restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name
+restrictTo names (L loc decl) = L loc $ case decl of
+  TyClD d | isDataDecl d  ->
+    TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
+  TyClD d | isClassDecl d ->
+    TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
+               tcdATs = restrictATs names (tcdATs d) })
+  _ -> decl
+
+restrictDataDefn :: [Name] -> HsDataDefn Name -> HsDataDefn Name
+restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
+  | DataType <- new_or_data
+  = defn { dd_cons = restrictCons names cons }
+  | otherwise    -- Newtype
+  = case restrictCons names cons of
+      []    -> defn { dd_ND = DataType, dd_cons = [] }
+      [con] -> defn { dd_cons = [con] }
+      _ -> error "Should not happen"
+
+restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
+restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
+  where
+    keep d | unLoc (con_name d) `elem` names =
+      case con_details d of
+        PrefixCon _ -> Just d
+        RecCon fields
+          | all field_avail fields -> Just d
+          | otherwise -> Just (d { con_details = PrefixCon (field_types fields) })
+          -- if we have *all* the field names available, then
+          -- keep the record declaration.  Otherwise degrade to
+          -- a constructor declaration.  This isn't quite right, but
+          -- it's the best we can do.
+        InfixCon _ _ -> Just d
+      where
+        field_avail (ConDeclField n _ _) = unLoc n `elem` names
+        field_types flds = [ t | ConDeclField _ t _ <- flds ]
+
+    keep _ = Nothing
+
+
+restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]
+restrictDecls names = mapMaybe (filterLSigNames (`elem` names))
+
+
+restrictATs :: [Name] -> [LFamilyDecl Name] -> [LFamilyDecl Name]
+restrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ]
+
+emptyHsQTvs :: LHsTyVarBndrs Name
+-- This function is here, rather than in HsTypes, because it *renamed*, but
+-- does not necessarily have all the rigt kind variables.  It is used
+-- in Haddock just for printing, so it doesn't matter
+emptyHsQTvs = HsQTvs { hsq_kvs = error "haddock:emptyHsQTvs", hsq_tvs = [] }
+
+
+--------------------------------------------------------------------------------
+-- * Filename mangling functions stolen from s main/DriverUtil.lhs.
+--------------------------------------------------------------------------------
+
+
+baseName :: ModuleName -> FilePath
+baseName = map (\c -> if c == '.' then '-' else c) . moduleNameString
+
+
+moduleHtmlFile :: Module -> FilePath
+moduleHtmlFile mdl =
+  case Map.lookup mdl html_xrefs of
+    Nothing  -> baseName mdl' ++ ".html"
+    Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl' ++ ".html"]
+  where
+   mdl' = moduleName mdl
+
+
+moduleHtmlFile' :: ModuleName -> FilePath
+moduleHtmlFile' mdl =
+  case Map.lookup mdl html_xrefs' of
+    Nothing  -> baseName mdl ++ ".html"
+    Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl ++ ".html"]
+
+
+contentsHtmlFile, indexHtmlFile :: String
+contentsHtmlFile = "index.html"
+indexHtmlFile = "doc-index.html"
+
+
+-- | The name of the module index file to be displayed inside a frame.
+-- Modules are display in full, but without indentation.  Clicking opens in
+-- the main window.
+frameIndexHtmlFile :: String
+frameIndexHtmlFile = "index-frames.html"
+
+
+moduleIndexFrameName, mainFrameName, synopsisFrameName :: String
+moduleIndexFrameName = "modules"
+mainFrameName = "main"
+synopsisFrameName = "synopsis"
+
+
+subIndexHtmlFile :: String -> String
+subIndexHtmlFile ls = "doc-index-" ++ b ++ ".html"
+   where b | all isAlpha ls = ls
+           | otherwise = concatMap (show . ord) ls
+
+
+-------------------------------------------------------------------------------
+-- * Anchor and URL utilities
+--
+-- NB: Anchor IDs, used as the destination of a link within a document must
+-- conform to XML's NAME production. That, taken with XHTML and HTML 4.01's
+-- various needs and compatibility constraints, means these IDs have to match:
+--      [A-Za-z][A-Za-z0-9:_.-]*
+-- Such IDs do not need to be escaped in any way when used as the fragment part
+-- of a URL. Indeed, %-escaping them can lead to compatibility issues as it
+-- isn't clear if such fragment identifiers should, or should not be unescaped
+-- before being matched with IDs in the target document.
+-------------------------------------------------------------------------------
+
+
+moduleUrl :: Module -> String
+moduleUrl = moduleHtmlFile
+
+
+moduleNameUrl :: Module -> OccName -> String
+moduleNameUrl mdl n = moduleUrl mdl ++ '#' : nameAnchorId n
+
+
+moduleNameUrl' :: ModuleName -> OccName -> String
+moduleNameUrl' mdl n = moduleHtmlFile' mdl ++ '#' : nameAnchorId n
+
+
+nameAnchorId :: OccName -> String
+nameAnchorId name = makeAnchorId (prefix : ':' : occNameString name)
+ where prefix | isValOcc name = 'v'
+              | otherwise     = 't'
+
+
+-- | Takes an arbitrary string and makes it a valid anchor ID. The mapping is
+-- identity preserving.
+makeAnchorId :: String -> String
+makeAnchorId [] = []
+makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
+  where
+    escape p c | p c = [c]
+               | otherwise = '-' : show (ord c) ++ "-"
+    isLegal ':' = True
+    isLegal '_' = True
+    isLegal '.' = True
+    isLegal c = isAscii c && isAlphaNum c
+       -- NB: '-' is legal in IDs, but we use it as the escape char
+
+
+-------------------------------------------------------------------------------
+-- * Files we need to copy from our $libdir
+-------------------------------------------------------------------------------
+
+
+jsFile, framesFile :: String
+jsFile    = "haddock-util.js"
+framesFile = "frames.html"
+
+
+-------------------------------------------------------------------------------
+-- * Misc.
+-------------------------------------------------------------------------------
+
+
+getProgramName :: IO String
+getProgramName = liftM (`withoutSuffix` ".bin") getProgName
+   where str `withoutSuffix` suff
+            | suff `isSuffixOf` str = take (length str - length suff) str
+            | otherwise             = str
+
+
+bye :: String -> IO a
+bye s = putStr s >> exitSuccess
+
+
+die :: String -> IO a
+die s = hPutStr stderr s >> exitWith (ExitFailure 1)
+
+
+dieMsg :: String -> IO a
+dieMsg s = getProgramName >>= \prog -> die (prog ++ ": " ++ s)
+
+
+noDieMsg :: String -> IO ()
+noDieMsg s = getProgramName >>= \prog -> hPutStr stderr (prog ++ ": " ++ s)
+
+
+mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)]
+mapSnd _ [] = []
+mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs
+
+
+mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
+mapMaybeM _ Nothing = return Nothing
+mapMaybeM f (Just a) = liftM Just (f a)
+
+
+escapeStr :: String -> String
+escapeStr = escapeURIString isUnreserved
+
+
+-- Following few functions are copy'n'pasted from Network.URI module
+-- to avoid depending on the network lib, since doing so gives a
+-- circular build dependency between haddock and network
+-- (at least if you want to build network with haddock docs)
+escapeURIChar :: (Char -> Bool) -> Char -> String
+escapeURIChar p c
+    | p c       = [c]
+    | otherwise = '%' : myShowHex (ord c) ""
+    where
+        myShowHex :: Int -> ShowS
+        myShowHex n r =  case showIntAtBase 16 toChrHex n r of
+            []  -> "00"
+            [a] -> ['0',a]
+            cs  -> cs
+        toChrHex d
+            | d < 10    = chr (ord '0' + fromIntegral d)
+            | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+
+
+escapeURIString :: (Char -> Bool) -> String -> String
+escapeURIString = concatMap . escapeURIChar
+
+
+isUnreserved :: Char -> Bool
+isUnreserved c = isAlphaNumChar c || (c `elem` "-_.~")
+
+
+isAlphaChar, isDigitChar, isAlphaNumChar :: Char -> Bool
+isAlphaChar c    = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')
+isDigitChar c    = c >= '0' && c <= '9'
+isAlphaNumChar c = isAlphaChar c || isDigitChar c
+
+
+-----------------------------------------------------------------------------
+-- * HTML cross references
+--
+-- For each module, we need to know where its HTML documentation lives
+-- so that we can point hyperlinks to it.  It is extremely
+-- inconvenient to plumb this information to all the places that need
+-- it (basically every function in HaddockHtml), and furthermore the
+-- mapping is constant for any single run of Haddock.  So for the time
+-- being I'm going to use a write-once global variable.
+-----------------------------------------------------------------------------
+
+
+{-# NOINLINE html_xrefs_ref #-}
+html_xrefs_ref :: IORef (Map Module FilePath)
+html_xrefs_ref = unsafePerformIO (newIORef (error "module_map"))
+
+
+{-# NOINLINE html_xrefs_ref' #-}
+html_xrefs_ref' :: IORef (Map ModuleName FilePath)
+html_xrefs_ref' = unsafePerformIO (newIORef (error "module_map"))
+
+
+{-# NOINLINE html_xrefs #-}
+html_xrefs :: Map Module FilePath
+html_xrefs = unsafePerformIO (readIORef html_xrefs_ref)
+
+
+{-# NOINLINE html_xrefs' #-}
+html_xrefs' :: Map ModuleName FilePath
+html_xrefs' = unsafePerformIO (readIORef html_xrefs_ref')
+
+
+-----------------------------------------------------------------------------
+-- * List utils
+-----------------------------------------------------------------------------
+
+
+replace :: Eq a => a -> a -> [a] -> [a]
+replace a b = map (\x -> if x == a then b else x)
+
+
+spanWith :: (a -> Maybe b) -> [a] -> ([b],[a])
+spanWith _ [] = ([],[])
+spanWith p xs@(a:as)
+  | Just b <- p a = let (bs,cs) = spanWith p as in (b:bs,cs)
+  | otherwise     = ([],xs)
+
+
+-----------------------------------------------------------------------------
+-- * Put here temporarily
+-----------------------------------------------------------------------------
+
+
+markup :: DocMarkup id a -> Doc id -> a
+markup m DocEmpty                    = markupEmpty m
+markup m (DocAppend d1 d2)           = markupAppend m (markup m d1) (markup m d2)
+markup m (DocString s)               = markupString m s
+markup m (DocParagraph d)            = markupParagraph m (markup m d)
+markup m (DocIdentifier x)           = markupIdentifier m x
+markup m (DocIdentifierUnchecked x)  = markupIdentifierUnchecked m x
+markup m (DocModule mod0)            = markupModule m mod0
+markup m (DocWarning d)              = markupWarning m (markup m d)
+markup m (DocEmphasis d)             = markupEmphasis m (markup m d)
+markup m (DocBold d)                 = markupBold m (markup m d)
+markup m (DocMonospaced d)           = markupMonospaced m (markup m d)
+markup m (DocUnorderedList ds)       = markupUnorderedList m (map (markup m) ds)
+markup m (DocOrderedList ds)         = markupOrderedList m (map (markup m) ds)
+markup m (DocDefList ds)             = markupDefList m (map (markupPair m) ds)
+markup m (DocCodeBlock d)            = markupCodeBlock m (markup m d)
+markup m (DocHyperlink l)            = markupHyperlink m l
+markup m (DocAName ref)              = markupAName m ref
+markup m (DocPic img)                = markupPic m img
+markup m (DocProperty p)             = markupProperty m p
+markup m (DocExamples e)             = markupExample m e
+markup m (DocHeader (Header l t))    = markupHeader m (Header l (markup m t))
+
+
+markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a)
+markupPair m (a,b) = (markup m a, markup m b)
+
+
+-- | The identity markup
+idMarkup :: DocMarkup a (Doc a)
+idMarkup = Markup {
+  markupEmpty                = DocEmpty,
+  markupString               = DocString,
+  markupParagraph            = DocParagraph,
+  markupAppend               = DocAppend,
+  markupIdentifier           = DocIdentifier,
+  markupIdentifierUnchecked  = DocIdentifierUnchecked,
+  markupModule               = DocModule,
+  markupWarning              = DocWarning,
+  markupEmphasis             = DocEmphasis,
+  markupBold                 = DocBold,
+  markupMonospaced           = DocMonospaced,
+  markupUnorderedList        = DocUnorderedList,
+  markupOrderedList          = DocOrderedList,
+  markupDefList              = DocDefList,
+  markupCodeBlock            = DocCodeBlock,
+  markupHyperlink            = DocHyperlink,
+  markupAName                = DocAName,
+  markupPic                  = DocPic,
+  markupProperty             = DocProperty,
+  markupExample              = DocExamples,
+  markupHeader               = DocHeader
+  }
+
+
+-----------------------------------------------------------------------------
+-- * System tools
+-----------------------------------------------------------------------------
+
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
+#else
+getProcessID :: IO Int
+getProcessID = fmap fromIntegral System.Posix.Internals.c_getpid
+#endif
diff --git a/haddock-api/src/Haddock/Version.hs b/haddock-api/src/Haddock/Version.hs
new file mode 100644
index 00000000..2ef3a257
--- /dev/null
+++ b/haddock-api/src/Haddock/Version.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Haddock.Version
+-- Copyright   :  (c) Simon Marlow 2003
+-- License     :  BSD-like
+--
+-- Maintainer  :  haddock@projects.haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Haddock.Version ( 
+  projectName, projectVersion, projectUrl
+) where
+
+#ifdef IN_GHC_TREE
+import Paths_haddock ( version )
+#else
+import Paths_haddock_api ( version )
+#endif
+import Data.Version  ( showVersion )
+
+projectName :: String
+projectName = "Haddock"
+
+projectUrl :: String
+projectUrl  = "http://www.haskell.org/haddock/"
+
+projectVersion :: String
+projectVersion = showVersion version