Forward port changes from stable.

8 files changed, 146 insertions, 144 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 9c5d57c3..55f6ac1d 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -48,11 +48,11 @@ ppHoogle dflags package version synopsis prologue ifaces odir = do
     hClose h
 
 ppModule :: DynFlags -> Interface -> [String]
-ppModule dflags iface
-               = "" : doc dflags (ifaceDoc iface) ++
-                 ["module " ++ moduleString (ifaceMod iface)] ++
-                 concatMap (ppExport dflags) (ifaceExportItems iface) ++
-                 concatMap (ppInstance dflags) (ifaceInstances iface)
+ppModule dflags iface =
+  "" : ppDocumentation dflags (ifaceDoc iface) ++
+  ["module " ++ moduleString (ifaceMod iface)] ++
+  concatMap (ppExport dflags) (ifaceExportItems iface) ++
+  concatMap (ppInstance dflags) (ifaceInstances iface)
 
 
 ---------------------------------------------------------------------
@@ -102,7 +102,7 @@ out dflags = f . unwords . map (dropWhile isSpace) . lines . showSDocUnqual dfla
 
 
 operator :: String -> String
-operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = "(" ++ x:xs ++ ")"
+operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")"
 operator x = x
 
 
@@ -110,7 +110,7 @@ operator x = x
 -- How to print each export
 
 ppExport :: DynFlags -> ExportItem Name -> [String]
-ppExport dflags (ExportDecl decl dc subdocs _) = doc dflags (fst dc) ++ f (unL decl)
+ppExport dflags (ExportDecl decl dc subdocs _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
     where
         f (TyClD d@TyDecl{})
             | isDataDecl d      = ppData dflags d subdocs
@@ -127,7 +127,7 @@ ppSig :: DynFlags -> Sig Name -> [String]
 ppSig dflags (TypeSig names sig)
     = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
     where
-        prettyNames = concat . intersperse ", " $ map (out dflags) names
+        prettyNames = intercalate ", " $ map (out dflags) names
         typ = case unL sig of
                    HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
                    x -> x
@@ -172,19 +172,19 @@ ppData dflags decl@(TyDecl { tcdTyDefn = defn }) subdocs
 ppData _ _ _ = panic "ppData"
 
 -- | for constructors, and named-fields...
-lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name)
-lookupCon subdocs (L _ name) = case lookup name subdocs of
-  Just (d, _) -> d
-  _ -> Nothing
+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 = doc dflags (lookupCon subdocs (con_name con))
+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
-                          [doc dflags (lookupCon subdocs (cd_fld_name r)) ++
+                          [lookupCon dflags subdocs (cd_fld_name r) ++
                            [out dflags (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
                           | r <- recs]
 
@@ -203,6 +203,10 @@ ppCtor dflags dat subdocs con = doc dflags (lookupCon subdocs (con_name con))
 ---------------------------------------------------------------------
 -- 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 ""
 
@@ -242,6 +246,7 @@ markupTag dflags = Markup {
   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"),
   markupMonospaced           = box (TagInline "tt"),
   markupPic                  = const $ str " ",
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index f03801bb..c187f104 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -157,9 +157,7 @@ ppLaTeXModule _title odir iface = do
        ]
 
       description
-          = case ifaceRnDoc iface of
-              Nothing -> empty
-              Just doc -> docToLaTeX doc
+          = (fromMaybe empty . documentationToLaTeX . ifaceRnDoc) iface
 
       body = processExports exports
   --
@@ -209,7 +207,7 @@ processExports (e : es) =
 
 isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
 isSimpleSig (ExportDecl (L _ (SigD (TypeSig lnames (L _ t))))
-                        (Nothing, argDocs) _ _)
+                        (Documentation Nothing Nothing, argDocs) _ _)
   | Map.null argDocs = Just (map unLoc lnames, t)
 isSimpleSig _ = Nothing
 
@@ -275,26 +273,25 @@ ppDecl :: LHsDecl DocName
        -> [(DocName, DocForDecl DocName)]
        -> LaTeX
 
-ppDecl (L loc decl) (mbDoc, fnArgsDoc) instances subdocs = case decl of
-  TyClD d@(TyFamily {})          -> ppTyFam False loc mbDoc d unicode
+ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
+  TyClD d@(TyFamily {})          -> ppTyFam False loc doc d unicode
   TyClD d@(TyDecl{ tcdTyDefn = defn })   
-      | isHsDataDefn defn        -> ppDataDecl instances subdocs loc mbDoc d unicode
-      | otherwise                -> ppTySyn loc (mbDoc, fnArgsDoc) d unicode
---    | Just _  <- tcdTyPats d     -> ppDataInst loc mbDoc d
+      | isHsDataDefn defn        -> ppDataDecl instances subdocs loc doc d unicode
+      | otherwise                -> ppTySyn loc (doc, fnArgsDoc) d unicode
 -- Family instances happen via FamInst now
 --  TyClD d@(TySynonym {})         
---    | Just _  <- tcdTyPats d    -> ppTyInst False loc mbDoc d unicode
+--    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
-  TyClD d@(ClassDecl {})         -> ppClassDecl instances loc mbDoc subdocs d unicode
-  SigD (TypeSig lnames (L _ t))  -> ppFunSig loc (mbDoc, fnArgsDoc) (map unLoc lnames) t unicode
-  ForD d                         -> ppFor loc (mbDoc, fnArgsDoc) d unicode
+  TyClD d@(ClassDecl {})         -> ppClassDecl instances loc doc subdocs d unicode
+  SigD (TypeSig lnames (L _ t))  -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode
+  ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
   InstD _                        -> empty
   _                              -> error "declaration not supported by ppDecl"
   where
     unicode = False
 
 
-ppTyFam :: Bool -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyFam :: Bool -> SrcSpan -> Documentation DocName ->
               TyClDecl DocName -> Bool -> LaTeX
 ppTyFam _ _ _ _ _ =
   error "type family declarations are currently not supported by --latex"
@@ -346,13 +343,13 @@ ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocName
 ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
                unicode
   | Map.null argDocs =
-      declWithDoc pref1 (fmap docToLaTeX doc)
+      declWithDoc pref1 (documentationToLaTeX doc)
   | otherwise        =
       declWithDoc pref2 $ Just $
         text "\\haddockbeginargs" $$
         do_args 0 sep0 typ $$
         text "\\end{tabulary}\\par" $$
-        maybe empty docToLaTeX doc
+        fromMaybe empty (documentationToLaTeX doc)
   where
      do_largs n leader (L _ t) = do_args n leader t
 
@@ -460,9 +457,9 @@ ppFds fds unicode =
 
 
 ppClassDecl :: [DocInstance DocName] -> SrcSpan
-            -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
+            -> Documentation DocName -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocName -> Bool -> LaTeX
-ppClassDecl instances loc mbDoc subdocs
+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)) $$
@@ -474,7 +471,7 @@ ppClassDecl instances loc mbDoc subdocs
 
     hdr = ppClassHdr False lctxt (unLoc lname) ltyvars lfds
 
-    body = catMaybes [fmap docToLaTeX mbDoc, body_]
+    body = catMaybes [documentationToLaTeX doc, body_]
 
     body_
       | null lsigs, null ats, null at_defs = Nothing
@@ -515,8 +512,8 @@ isUndocdInstance _ = Nothing
 -- an 'argBox'. The comment is printed to the right of the box in normal comment
 -- style.
 ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
-ppDocInstance unicode (instHead, mbDoc) =
-  declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX mbDoc)
+ppDocInstance unicode (instHead, doc) =
+  declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX doc)
 
 
 ppInstDecl :: Bool -> InstHead DocName -> LaTeX
@@ -542,9 +539,9 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
 
 ppDataDecl :: [DocInstance DocName] ->
               [(DocName, DocForDecl DocName)] ->
-              SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool ->
+              SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
               LaTeX
-ppDataDecl instances subdocs _loc mbDoc dataDecl unicode
+ppDataDecl instances subdocs _loc doc dataDecl unicode
 
    =  declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
                   (if null body then Nothing else Just (vcat body))
@@ -554,7 +551,7 @@ ppDataDecl instances subdocs _loc mbDoc dataDecl unicode
     cons      = td_cons (tcdTyDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
-    body = catMaybes [constrBit, fmap docToLaTeX mbDoc]
+    body = catMaybes [constrBit, documentationToLaTeX doc]
 
     (whereBit, leaders)
       | null cons = (empty,[])
@@ -634,8 +631,7 @@ ppSideBySideConstr subdocs unicode leader (L _ 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.
-    -- 'join' is in Maybe.
-    mbDoc = join $ fmap fst $ lookup (unLoc $ con_name con) subdocs
+    mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst
     mkFunTy a b = noLoc (HsFunTy a b)
 
 
@@ -645,7 +641,7 @@ ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
     <+> 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 = join $ fmap fst $ lookup name subdocs
+    mbDoc = lookup name subdocs >>= combineDocumentation . fst
 
 -- {-
 -- ppHsFullConstr :: HsConDecl -> LaTeX
@@ -997,6 +993,7 @@ parLatexMarkup ppId = Markup {
   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),
   markupMonospaced           = \p _ -> tt (p Mono),
   markupUnorderedList        = \p v -> itemizedList (map ($v) p) $$ text "",
@@ -1033,6 +1030,10 @@ 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
 
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 50aad789..c68b7cbc 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -66,7 +66,7 @@ ppHtml :: String
        -> Maybe String                 -- ^ The contents URL (--use-contents)
        -> Maybe String                 -- ^ The index URL (--use-index)
        -> Bool                         -- ^ Whether to use unicode in output (--use-unicode)
-       -> Qualification                -- ^ How to qualify names
+       -> QualOption                   -- ^ How to qualify names
        -> Bool                         -- ^ Output pretty html (newlines and indenting)
        -> IO ()
 
@@ -83,7 +83,7 @@ ppHtml doctitle maybe_package ifaces odir prologue
         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 qual
+        prologue debug (makeContentsQual qual)
 
   when (isNothing maybe_index_url) $
     ppHtmlIndex odir doctitle maybe_package
@@ -175,7 +175,7 @@ bodyHtml doctitle iface
         contentsButton maybe_contents_url,
         indexButton maybe_index_url])
             ! [theclass "links", identifier "page-menu"],
-      nonEmpty sectionName << doctitle
+      nonEmptySectionName << doctitle
       ],
     divContent << pageContent,
     divFooter << paragraph << (
@@ -431,7 +431,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
                           indexLinks nm entries
           many_entities ->
               td ! [ theclass "src" ] << toHtml str <-> td << spaceHtml </>
-                  aboves (map doAnnotatedEntity (zip [1..] many_entities))
+                  aboves (zipWith (curry doAnnotatedEntity) [1..] many_entities)
 
     doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable
     doAnnotatedEntity (j,(nm,entries))
@@ -461,18 +461,16 @@ ppHtmlIndex odir doctitle _maybe_package themes
 ppHtmlModule
         :: FilePath -> String -> Themes
         -> SourceURLs -> WikiURLs
-        -> Maybe String -> Maybe String -> Bool -> Qualification
+        -> 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 = case qual of
-          LocalQual Nothing    -> LocalQual (Just mdl)
-          RelativeQual Nothing -> RelativeQual (Just mdl)
-          _                     -> qual
+      real_qual = makeModuleQual qual aliases mdl
       html =
         headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
         bodyHtml doctitle (Just iface)
@@ -484,8 +482,7 @@ ppHtmlModule odir doctitle themes
 
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
-  ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode qual debug
-
+  ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode real_qual debug
 
 ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
   -> Interface -> Bool -> Qualification -> Bool -> IO ()
@@ -511,18 +508,16 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
 
     -- 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 _ doc _ _) = isJust (fst doc)
+    has_doc (ExportDecl _ (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
-          = case ifaceRnDoc iface of
-              Nothing -> noHtml
-              Just doc -> divDescription $
-                            sectionName << "Description" +++ docSection qual doc
+    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
@@ -539,7 +534,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
     maybe_doc_hdr
       = case exports of
           [] -> noHtml
-          ExportGroup _ _ _ : _ -> noHtml
+          ExportGroup {} : _ -> noHtml
           _ -> h1 << "Documentation"
 
     bdy =
@@ -617,7 +612,7 @@ ppModuleContents qual exports
 -- we need to assign a unique id to each section heading so we can hyperlink
 -- them from the contents:
 numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName]
-numberSectionHeadings exports = go 1 exports
+numberSectionHeadings = go 1
   where go :: Int -> [ExportItem DocName] -> [ExportItem DocName]
         go _ [] = []
         go n (ExportGroup lev _ doc : es)
@@ -638,7 +633,7 @@ processExport summary _ _ qual (ExportNoDecl y subs)
   = processDeclOneLiner summary $
       ppDocName qual y +++ parenList (map (ppDocName qual) subs)
 processExport summary _ _ qual (ExportDoc doc)
-  = nothingIf summary $ docSection qual doc
+  = nothingIf summary $ docSection_ qual doc
 processExport summary _ _ _ (ExportModule mdl)
   = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl
 
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index b5ad1a8f..59be34f7 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -26,16 +26,15 @@ import Haddock.Backends.Xhtml.Utils
 import Haddock.GhcUtils
 import Haddock.Types
 
-import           Control.Monad         ( join )
 import           Data.List             ( intersperse )
 import qualified Data.Map as Map
+import           Data.Maybe
 import           Text.XHtml hiding     ( name, title, p, quote )
 
 import GHC
 import Name
 
 
--- TODO: use DeclInfo DocName or something
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
           DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] ->
           Bool -> Qualification -> Html
@@ -68,14 +67,14 @@ ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
                -> DocForDecl DocName -> (Html, Html, Html) -> Bool -> Qualification -> Html
 ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) unicode qual
   | summary = pref1
-  | Map.null argDocs = topDeclElem links loc docnames pref1 +++ maybeDocSection qual doc
+  | Map.null argDocs = topDeclElem links loc docnames pref1 +++ docSection qual doc
   | otherwise = topDeclElem links loc docnames pref2 +++
-      subArguments qual (do_args 0 sep typ) +++ maybeDocSection qual doc
+      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 :: Int -> Html -> HsType DocName -> [SubDecl]
     do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
       = (leader <+>
           hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
@@ -95,7 +94,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
       = (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, []) : []
+      = [(leader <+> ppType unicode qual t, argDoc n, [])]
 
 
 ppTyVars :: LHsTyVarBndrs DocName -> [Html]
@@ -165,12 +164,12 @@ ppTyFamHeader summary associated decl unicode qual =
     Nothing   -> noHtml
 
 
-ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
+ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
               TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyFam summary associated links loc mbDoc decl unicode qual
+ppTyFam summary associated links loc doc decl unicode qual
 
   | summary   = ppTyFamHeader True associated decl unicode qual
-  | otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit
+  | otherwise = header_ +++ docSection qual doc +++ instancesBit
 
   where
     docname = tcdName decl
@@ -249,12 +248,12 @@ ppLContextNoArrow = ppContextNoArrow . unLoc
 
 ppContextNoArrow :: HsContext DocName -> Bool -> Qualification -> Html
 ppContextNoArrow []  _       _     = noHtml
-ppContextNoArrow cxt unicode qual = pp_hs_context (map unLoc cxt) unicode qual
+ppContextNoArrow cxt unicode qual = ppHsContext (map unLoc cxt) unicode qual
 
 
 ppContextNoLocs :: [HsType DocName] -> Bool -> Qualification -> Html
 ppContextNoLocs []  _       _     = noHtml
-ppContextNoLocs cxt unicode qual = pp_hs_context cxt unicode qual 
+ppContextNoLocs cxt unicode qual = ppHsContext cxt unicode qual
     <+> darrow unicode
 
 
@@ -262,10 +261,10 @@ ppContext :: HsContext DocName -> Bool -> Qualification -> Html
 ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
 
 
-pp_hs_context :: [HsType DocName] -> Bool -> Qualification-> Html
-pp_hs_context []  _       _     = noHtml
-pp_hs_context [p] unicode qual = ppType unicode qual p
-pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt)
+ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html
+ppHsContext []  _       _     = noHtml
+ppHsContext [p] unicode qual = ppType unicode qual p
+ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
 
 
 -------------------------------------------------------------------------------
@@ -279,8 +278,8 @@ ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
 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
+  <+> ppAppDocNameNames summ n (tyvarNames tvs)
+  <+> ppFds fds unicode qual
 
 
 ppFds :: [Located ([DocName], [DocName])] -> Bool -> Qualification -> Html
@@ -324,13 +323,13 @@ ppShortClassDecl _ _ _ _ _ _ _ = error "declaration type not supported by ppShor
 
 
 ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
-            -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
+            -> Documentation DocName -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppClassDecl summary links instances loc mbDoc subdocs
+ppClassDecl summary links instances loc d subdocs
         decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
                         , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats }) unicode qual
   | summary = ppShortClassDecl summary links decl loc subdocs unicode qual
-  | otherwise = classheader +++ maybeDocSection qual mbDoc
+  | otherwise = classheader +++ docSection qual d
                   +++ atBit +++ methodBit  +++ instancesBit
   where
     classheader
@@ -354,7 +353,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
                            -- there are different subdocs for different names in a single
                            -- type signature?
 
-    instancesBit = ppInstances instances nm unicode qual 
+    instancesBit = ppInstances instances nm unicode qual
 
 ppClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
@@ -371,11 +370,8 @@ ppInstances instances baseName unicode qual
         <+> ppAppNameTypes n ts unicode qual
 
 
-lookupAnySubdoc :: (Eq name1) =>
-                   name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
-lookupAnySubdoc n subdocs = case lookup n subdocs of
-  Nothing -> noDocForDecl
-  Just docs -> docs
+lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
+lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
 
 
 -------------------------------------------------------------------------------
@@ -388,7 +384,7 @@ ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool
                 -> Qualification -> Html
 ppShortDataDecl summary _links _loc dataDecl unicode qual
 
-  | [] <- cons = dataHeader 
+  | [] <- cons = dataHeader
 
   | [lcon] <- cons, ResTyH98 <- resTy,
     (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode qual
@@ -411,12 +407,12 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
 
 ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
               [(DocName, DocForDecl DocName)] ->
-              SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool ->
+              SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
               Qualification -> Html
-ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode qual
+ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
 
   | summary   = ppShortDataDecl summary links loc dataDecl unicode qual
-  | otherwise = header_ +++ maybeDocSection qual mbDoc +++ constrBit +++ instancesBit
+  | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
 
   where
     docname   = unLoc . tcdLName $ dataDecl
@@ -471,7 +467,7 @@ ppShortConstrParts summary con unicode qual = case con_res con of
     -- (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 '{',
+                            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)
@@ -479,29 +475,29 @@ ppShortConstrParts summary con unicode qual = case con_res con of
   where
     doRecordFields fields = shortSubDecls (map (ppShortField summary unicode qual) fields)
     doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
-                             ppForAll forall ltvs lcontext unicode qual,
+                             ppForAll forall_ ltvs lcontext unicode qual,
                              ppLType unicode qual (foldr mkFunTy resTy args) ]
 
-    header_  = ppConstrHdr forall tyVars context
+    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
+    forall_  = con_explicit con
     mkFunTy a b = noLoc (HsFunTy a b)
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
 ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool
             -> Qualification -> Html
-ppConstrHdr forall tvs ctxt unicode qual
+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
+    ppForall = case forall_ of
       Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> toHtml ". "
       Implicit -> noHtml
 
@@ -539,19 +535,18 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
     doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
     doGADTCon args resTy =
       ppBinder False occ <+> dcolon unicode
-        <+> hsep [ppForAll forall ltvs (con_cxt con) unicode qual,
+        <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
                   ppLType unicode qual (foldr mkFunTy resTy args) ]
 
-    header_ = ppConstrHdr forall tyVars context
+    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
+    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.
-    -- 'join' is in Maybe.
-    mbDoc = join $ fmap fst $ lookup (unLoc $ con_name con) subdocs
+    mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst
     mkFunTy a b = noLoc (HsFunTy a b)
 
 
@@ -563,7 +558,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
     [])
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
-    mbDoc = join $ fmap fst $ lookup name subdocs
+    mbDoc = lookup name subdocs >>= combineDocumentation . fst
 
 
 ppShortField :: Bool -> Bool -> Qualification -> ConDeclField DocName -> Html
@@ -609,13 +604,13 @@ tupleParens _              = parenList
 
 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
+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
@@ -657,7 +652,7 @@ ppForAll expl tvs cxt unicode qual
 
 
 ppr_mono_lty :: Int -> LHsType DocName -> Bool -> Qualification -> Html
-ppr_mono_lty ctxt_prec ty unicode qual = ppr_mono_ty ctxt_prec (unLoc ty) unicode qual
+ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
 
 ppr_mono_ty :: Int -> HsType DocName -> Bool -> Qualification -> Html
@@ -675,11 +670,7 @@ ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP
 ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsIParamTy n ty)   u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
-#if __GLASGOW_HASKELL__ == 612
-ppr_mono_ty _         (HsSpliceTyOut {})  _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
-#else
 ppr_mono_ty _         (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
-#endif
 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
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index f506d2b8..052116ee 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -15,7 +15,7 @@ module Haddock.Backends.Xhtml.DocMarkup (
   rdrDocToHtml,
   origDocToHtml,
 
-  docElement, docSection, maybeDocSection,
+  docElement, docSection, docSection_,
 ) where
 
 
@@ -39,6 +39,7 @@ parHtmlMarkup qual ppId = Markup {
   markupIdentifierUnchecked  = thecode . ppUncheckedLink qual,
   markupModule               = \m -> let (mdl,ref) = break (=='#') m
                                      in ppModuleRef (mkModuleName mdl) ref,
+  markupWarning              = thediv ! [theclass "warning"],
   markupEmphasis             = emphasize,
   markupMonospaced           = thecode,
   markupUnorderedList        = unordList,
@@ -84,12 +85,12 @@ docElement el content_ =
     else el ! [theclass "doc"] << content_
 
 
-docSection :: Qualification -> Doc DocName -> Html
-docSection qual = (docElement thediv <<) . docToHtml qual
+docSection :: Qualification -> Documentation DocName -> Html
+docSection qual = maybe noHtml (docSection_ qual) . combineDocumentation
 
 
-maybeDocSection :: Qualification -> Maybe (Doc DocName) -> Html
-maybeDocSection qual = maybe noHtml (docSection qual)
+docSection_ :: Qualification -> Doc DocName -> Html
+docSection_ qual = (docElement thediv <<) . docToHtml qual
 
 
 cleanup :: Doc a -> Doc a
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index bdd5ac78..3ddbd28b 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -18,6 +18,7 @@ module Haddock.Backends.Xhtml.Layout (
   divIndex, divAlphabet, divModuleList,
 
   sectionName,
+  nonEmptySectionName,
 
   shortDeclList,
   shortSubDecls,
@@ -66,6 +67,14 @@ 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
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index f07f42e0..2f2b82ed 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -25,6 +25,7 @@ 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
@@ -57,7 +58,10 @@ ppDocName qual docName =
   case docName of
     Documented name mdl ->
       linkIdOcc mdl (Just (nameOccName name)) << ppQualifyName qual name mdl
-    Undocumented name -> ppQualifyName qual name (nameModule name)
+    Undocumented name
+      | isExternalName name || isWiredInName name ->
+          ppQualifyName qual name (nameModule name)
+      | otherwise -> ppName name
 
 
 -- | Render a name depending on the selected qualification mode
@@ -66,28 +70,33 @@ ppQualifyName qual name mdl =
   case qual of
     NoQual   -> ppName name
     FullQual -> ppFullQualName mdl name
-    -- this is just in case, it should never happen
-    LocalQual Nothing -> ppQualifyName FullQual name mdl
-    LocalQual (Just localmdl)
-      | moduleString mdl == moduleString localmdl -> ppName name
-      | otherwise -> ppFullQualName mdl name
-    -- again, this never happens
-    RelativeQual Nothing -> ppQualifyName FullQual name mdl
-    RelativeQual (Just localmdl) ->
+    LocalQual localmdl ->
+      if moduleString mdl == moduleString localmdl
+        then ppName name
+        else ppFullQualName mdl name
+    RelativeQual localmdl ->
       case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
         -- local, A.x -> x
-        Just []      -> ppQualifyName NoQual name mdl
+        Just []      -> ppName name
         -- sub-module, A.B.x -> B.x
         Just ('.':m) -> toHtml $ m ++ '.' : getOccString name
         -- some module with same prefix, ABC.x -> ABC.x
-        Just _       -> ppQualifyName FullQual name mdl
+        Just _       -> ppFullQualName mdl name
         -- some other module, D.x -> D.x
-        Nothing      -> ppQualifyName FullQual name mdl
+        Nothing      -> ppFullQualName mdl name
+    AliasedQual aliases localmdl ->
+      case (moduleString mdl == moduleString localmdl,
+            M.lookup mdl aliases) of
+        (False, Just alias) -> ppQualName alias name
+        _ -> ppName name
 
 
 ppFullQualName :: Module -> Name -> Html
 ppFullQualName mdl name = toHtml $ moduleString mdl ++ '.' : getOccString name
 
+ppQualName :: ModuleName -> Name -> Html
+ppQualName mdlName name =
+  toHtml $ moduleNameString mdlName ++ '.' : getOccString name
 
 ppName :: Name -> Html
 ppName name = toHtml (getOccString name)
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index 7ba6d5f4..be1fcb9b 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -17,7 +17,7 @@ module Haddock.Backends.Xhtml.Utils (
   spliceURL,
   groupId,
 
-  (<+>), char, nonEmpty,
+  (<+>), char,
   keyword, punctuate,
 
   braces, brackets, pabrackets, parens, parenList, ubxParenList,
@@ -44,7 +44,7 @@ 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 url = run url
+spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
  where
   file = fromMaybe "" maybe_file
   mdl = case maybe_mod of
@@ -72,7 +72,7 @@ spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url
   run ('%':'N':rest) = name ++ run rest
   run ('%':'K':rest) = kind ++ run rest
   run ('%':'L':rest) = line ++ run rest
-  run ('%':'%':rest) = "%"  ++ 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
@@ -119,15 +119,6 @@ char :: Char -> Html
 char c = toHtml [c]
 
 
--- | 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"
-nonEmpty :: (Html -> Html) -> Html -> Html
-nonEmpty el content_ =
-  if isNoHtml content_
-    then el ! [theclass "empty"] << spaceHtml
-    else el << content_
-
-
 quote :: Html -> Html
 quote h = char '`' +++ h +++ '`'