Allow doc comments to link to out-of-scope things (#78).

(A bug that should have been fixed long ago.)

11 files changed, 217 insertions, 148 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index ed8d4665..6e3e306a 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -228,22 +228,23 @@ str a = [Str a]
 
 markupTag :: Outputable o => DocMarkup o [Tag]
 markupTag = Markup {
-  markupParagraph     = box TagP,
-  markupEmpty         = str "",
-  markupString        = str,
-  markupAppend        = (++),
-  markupIdentifier    = box (TagInline "a") . str . out,
-  markupModule        = box (TagInline "a") . str,
-  markupEmphasis      = box (TagInline "i"),
-  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,
-  markupURL           = box (TagInline "a") . str,
-  markupAName         = const $ str "",
-  markupExample       = box TagPre . str . unlines . map exampleToString
+  markupParagraph            = box TagP,
+  markupEmpty                = str "",
+  markupString               = str,
+  markupAppend               = (++),
+  markupIdentifier           = box (TagInline "a") . str . out,
+  markupIdentifierUnchecked  = box (TagInline "a") . str . out . snd,
+  markupModule               = box (TagInline "a") . str,
+  markupEmphasis             = box (TagInline "i"),
+  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,
+  markupURL                  = box (TagInline "a") . str,
+  markupAName                = const $ str "",
+  markupExample              = box TagPre . str . unlines . map exampleToString
   }
 
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index fc313888..e0a530be 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -999,34 +999,35 @@ latexMonoMunge c   s = latexMunge c s
 
 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,
-  markupModule        = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
-  markupEmphasis      = \p v -> emph (p v),
-  markupMonospaced    = \p _ -> tt (p Mono),
-  markupUnorderedList = \p v -> itemizedList (map ($v) p) $$ text "",
-  markupPic           = \path _ -> parens (text "image: " <> text path),
-  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 "",
-  markupURL           = \u _ -> text "\\url" <> braces (text u),
-  markupAName         = \_ _ -> empty,
-  markupExample       = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
+  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),
+  markupEmphasis             = \p v -> emph (p v),
+  markupMonospaced           = \p _ -> tt (p Mono),
+  markupUnorderedList        = \p v -> itemizedList (map ($v) p) $$ text "",
+  markupPic                  = \path _ -> parens (text "image: " <> text path),
+  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 "",
+  markupURL                  = \u _ -> text "\\url" <> braces (text u),
+  markupAName                = \_ _ -> empty,
+  markupExample              = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
   }
   where
     fixString Plain s = latexFilter s
     fixString Verb  s = s
     fixString Mono  s = latexMonoFilter s
 
-    markupId id v =
+    markupId ppId_ id v =
       case v of
         Verb  -> theid
         Mono  -> theid
         Plain -> text "\\haddockid" <> braces theid
-      where theid = ppId id
+      where theid = ppId_ id
 
 
 latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 9ac4211a..52bde5b6 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -83,8 +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
+        prologue debug qual
 
   when (isNothing maybe_index_url) $
     ppHtmlIndex odir doctitle maybe_package
@@ -224,10 +223,11 @@ ppHtmlContents
    -> 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 = do
+  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do
   let tree = mkModuleTree showPkgs
          [(instMod iface, toInstalledDescription iface) | iface <- ifaces]
       html =
@@ -235,8 +235,8 @@ ppHtmlContents odir doctitle _maybe_package
         bodyHtml doctitle Nothing
           maybe_source_url maybe_wiki_url
           Nothing maybe_index_url << [
-            ppPrologue doctitle prologue,
-            ppModuleTree tree
+            ppPrologue qual doctitle prologue,
+            ppModuleTree qual tree
           ]
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
@@ -245,27 +245,27 @@ ppHtmlContents odir doctitle _maybe_package
   ppHtmlContentsFrame odir doctitle themes ifaces debug
 
 
-ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> Html
-ppPrologue _ Nothing = noHtml
-ppPrologue title (Just doc) =
-  divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml doc))
+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 :: [ModuleTree] -> Html
-ppModuleTree ts =
-  divModuleList << (sectionName << "Modules" +++ mkNodeList [] "n" ts)
+ppModuleTree :: Qualification -> [ModuleTree] -> Html
+ppModuleTree qual ts =
+  divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts)
 
 
-mkNodeList :: [String] -> String -> [ModuleTree] -> Html
-mkNodeList ss p ts = case ts of
+mkNodeList :: Qualification -> [String] -> String -> [ModuleTree] -> Html
+mkNodeList qual ss p ts = case ts of
   [] -> noHtml
-  _ -> unordList (zipWith (mkNode ss) ps ts)
+  _ -> unordList (zipWith (mkNode qual ss) ps ts)
   where
     ps = [ p ++ '.' : show i | i <- [(1::Int)..]]
 
 
-mkNode :: [String] -> String -> ModuleTree -> Html
-mkNode ss p (Node s leaf pkg short ts) =
+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
@@ -288,10 +288,10 @@ mkNode ss p (Node s leaf pkg short ts) =
 
     mdl = intercalate "." (reverse (s:ss))
 
-    shortDescr = maybe noHtml origDocToHtml short
+    shortDescr = maybe noHtml (origDocToHtml qual) short
     htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg
 
-    subtree = mkNodeList (s:ss) p ts ! collapseSection p True ""
+    subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
 
 
 -- | Turn a module tree into a flat list of full module names.  E.g.,
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 05ce7dbb..87d67b76 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -30,25 +30,26 @@ import Text.XHtml hiding ( name, title, p, quote )
 import GHC
 
 
-parHtmlMarkup :: (a -> Html) -> DocMarkup a Html
-parHtmlMarkup ppId = Markup {
-  markupEmpty         = noHtml,
-  markupString        = toHtml,
-  markupParagraph     = paragraph,
-  markupAppend        = (+++),
-  markupIdentifier    = thecode . ppId,
-  markupModule        = \m -> let (mdl,ref) = break (=='#') m
-                              in ppModuleRef (mkModuleNoPackage mdl) ref,
-  markupEmphasis      = emphasize,
-  markupMonospaced    = thecode,
-  markupUnorderedList = unordList,
-  markupOrderedList   = ordList,
-  markupDefList       = defList,
-  markupCodeBlock     = pre,
-  markupURL           = \url -> anchor ! [href url] << url,
-  markupAName         = \aname -> namedAnchor aname << "",
-  markupPic           = \path -> image ! [src path],
-  markupExample       = examplesToHtml
+parHtmlMarkup :: Qualification -> (a -> Html) -> DocMarkup a Html
+parHtmlMarkup qual ppId = Markup {
+  markupEmpty                = noHtml,
+  markupString               = toHtml,
+  markupParagraph            = paragraph,
+  markupAppend               = (+++),
+  markupIdentifier           = thecode . ppId,
+  markupIdentifierUnchecked  = thecode . ppUncheckedLink qual,
+  markupModule               = \m -> let (mdl,ref) = break (=='#') m
+                                     in ppModuleRef (mkModuleNoPackage mdl) ref,
+  markupEmphasis             = emphasize,
+  markupMonospaced           = thecode,
+  markupUnorderedList        = unordList,
+  markupOrderedList          = ordList,
+  markupDefList              = defList,
+  markupCodeBlock            = pre,
+  markupURL                  = \url -> anchor ! [href url] << url,
+  markupAName                = \aname -> namedAnchor aname << "",
+  markupPic                  = \path -> image ! [src path],
+  markupExample              = examplesToHtml
   }
   where
     examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
@@ -64,17 +65,17 @@ parHtmlMarkup ppId = Markup {
 -- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
 docToHtml :: Qualification -> Doc DocName -> Html
 docToHtml qual = markup fmt . cleanup
-  where fmt = parHtmlMarkup (ppDocName qual)
+  where fmt = parHtmlMarkup qual (ppDocName qual)
 
 
-origDocToHtml :: Doc Name -> Html
-origDocToHtml = markup fmt . cleanup
-  where fmt = parHtmlMarkup ppName
+origDocToHtml :: Qualification -> Doc Name -> Html
+origDocToHtml qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual ppName
 
 
-rdrDocToHtml :: Doc RdrName -> Html
-rdrDocToHtml = markup fmt . cleanup
-  where fmt = parHtmlMarkup ppRdrName
+rdrDocToHtml :: Qualification -> Doc RdrName -> Html
+rdrDocToHtml qual = markup fmt . cleanup
+  where fmt = parHtmlMarkup qual ppRdrName
 
 
 docElement :: (Html -> Html) -> Html -> Html
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index c5166d7f..19efea2e 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -11,7 +11,7 @@
 -- Portability :  portable
 -----------------------------------------------------------------------------
 module Haddock.Backends.Xhtml.Names (
-  ppName, ppDocName, ppLDocName, ppRdrName,
+  ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,
   ppBinder, ppBinder',
   ppModule, ppModuleRef,
   linkId
@@ -39,6 +39,10 @@ ppRdrName :: RdrName -> Html
 ppRdrName = ppOccName . rdrNameOcc
 
 
+ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html
+ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName
+
+
 ppLDocName :: Qualification -> Located DocName -> Html
 ppLDocName qual (L _ d) = ppDocName qual d
 
@@ -110,6 +114,14 @@ linkIdOcc mdl mbName = anchor ! [href url]
       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)
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 2c10146d..35ff8542 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -174,6 +174,7 @@ renameDoc d = case d of
   DocIdentifier x -> do
     x' <- rename x
     return (DocIdentifier x')
+  DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x)
   DocModule str -> return (DocModule str)
   DocEmphasis doc -> do
     doc' <- renameDoc doc
diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs
index 57704db7..0b5efe4b 100644
--- a/src/Haddock/Interface/Rn.hs
+++ b/src/Haddock/Interface/Rn.hs
@@ -4,7 +4,7 @@ import Haddock.Types
 
 import RnEnv       ( dataTcOccs )
 
-import RdrName     ( RdrName, gre_name, GlobalRdrEnv, lookupGRE_RdrName )
+import RdrName
 import Name        ( Name, isTyConName )
 import Outputable  ( ppr, showSDoc )
 
@@ -36,14 +36,20 @@ rnDoc gre = unId . do_rn
 
   DocIdentifier x -> do
     let choices = dataTcOccs x
-    let gres = concatMap (\rdrName ->
-                 map gre_name (lookupGRE_RdrName rdrName gre)) choices
-    return $ case gres of
-      []   -> DocMonospaced (DocString (showSDoc $ ppr x))  -- TODO: DocIdentifierRdrName
-      [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.
+    let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
+    return $
+      case names of
+        [] ->
+          case choices of
+            [] -> DocMonospaced (DocString (showSDoc $ ppr x))
+            [a] -> outOfScope a
+            a:b:_ | isRdrTc a -> outOfScope a | otherwise -> outOfScope 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.
+
+  DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x)
 
   DocModule str -> return (DocModule str)
 
@@ -81,3 +87,14 @@ rnDoc gre = unId . do_rn
   DocAName str -> return (DocAName str)
 
   DocExamples e -> return (DocExamples e)
+
+
+outOfScope :: RdrName -> Doc a
+outOfScope 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 (showSDoc $ ppr a))
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index c1b54b1b..1da46662 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -460,6 +460,9 @@ instance (Binary id) => Binary (Doc id) where
     put_ bh (DocExamples ao) = do
             putByte bh 15
             put_ bh ao
+    put_ bh (DocIdentifierUnchecked x) = do
+            putByte bh 16
+            put_ bh x
     get bh = do
             h <- getByte bh
             case h of
@@ -511,6 +514,9 @@ instance (Binary id) => Binary (Doc id) where
               15 -> do
                     ao <- get bh
                     return (DocExamples ao)
+              16 -> do
+                    x <- get bh
+                    return (DocIdentifierUnchecked x)
               _ -> fail "invalid binary data found"
 
 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 4989a067..fbaf89c5 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -26,6 +26,7 @@ import Data.Typeable
 import Data.Map (Map)
 import qualified Data.Map as Map
 import GHC hiding (NoLink)
+import OccName
 
 
 -----------------------------------------------------------------------------
@@ -276,7 +277,7 @@ data Doc id
   | DocString String
   | DocParagraph (Doc id)
   | DocIdentifier id
---  | DocIdentifierOutOfScope [RdrName]
+  | DocIdentifierUnchecked (ModuleName, OccName)
   | DocModule String
   | DocEmphasis (Doc id)
   | DocMonospaced (Doc id)
@@ -288,7 +289,7 @@ data Doc id
   | DocPic String
   | DocAName String
   | DocExamples [Example]
-  deriving (Eq, Show, Functor)
+  deriving (Eq, Functor)
 
 
 unrenameDoc :: Doc DocName -> Doc Name
@@ -307,22 +308,23 @@ exampleToString (Example expression result) =
 
 
 data DocMarkup id a = Markup
-  { markupEmpty         :: a
-  , markupString        :: String -> a
-  , markupParagraph     :: a -> a
-  , markupAppend        :: a -> a -> a
-  , markupIdentifier    :: id -> a
-  , markupModule        :: String -> a
-  , markupEmphasis      :: a -> a
-  , markupMonospaced    :: a -> a
-  , markupUnorderedList :: [a] -> a
-  , markupOrderedList   :: [a] -> a
-  , markupDefList       :: [(a,a)] -> a
-  , markupCodeBlock     :: a -> a
-  , markupURL           :: String -> a
-  , markupAName         :: String -> a
-  , markupPic           :: String -> a
-  , markupExample       :: [Example] -> a
+  { markupEmpty                :: a
+  , markupString               :: String -> a
+  , markupParagraph            :: a -> a
+  , markupAppend               :: a -> a -> a
+  , markupIdentifier           :: id -> a
+  , markupIdentifierUnchecked  :: (ModuleName, OccName) -> a
+  , markupModule               :: String -> a
+  , markupEmphasis             :: a -> a
+  , markupMonospaced           :: a -> a
+  , markupUnorderedList        :: [a] -> a
+  , markupOrderedList          :: [a] -> a
+  , markupDefList              :: [(a,a)] -> a
+  , markupCodeBlock            :: a -> a
+  , markupURL                  :: String -> a
+  , markupAName                :: String -> a
+  , markupPic                  :: String -> a
+  , markupExample              :: [Example] -> a
   }
 
 
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 478025d8..de97ef85 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -17,7 +17,7 @@ module Haddock.Utils (
   toDescription, toInstalledDescription,
 
   -- * Filename utilities
-  moduleHtmlFile,
+  moduleHtmlFile, moduleHtmlFile',
   contentsHtmlFile, indexHtmlFile,
   frameIndexHtmlFile,
   moduleIndexFrameName, mainFrameName, synopsisFrameName,
@@ -25,7 +25,7 @@ module Haddock.Utils (
   jsFile, framesFile,
 
   -- * Anchor and URL utilities
-  moduleNameUrl, moduleUrl,
+  moduleNameUrl, moduleNameUrl', moduleUrl,
   nameAnchorId,
   makeAnchorId,
 
@@ -33,7 +33,7 @@ module Haddock.Utils (
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
 
   -- * HTML cross reference mapping
-  html_xrefs_ref,
+  html_xrefs_ref, html_xrefs_ref',
 
   -- * Doc markup 
   markup,
@@ -172,15 +172,24 @@ restrictATs names ats = [ at | at <- ats , tcdName (unL at) `elem` names ]
 --------------------------------------------------------------------------------
 
 
+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  -> mdl' ++ ".html"
-    Just fp0 -> HtmlPath.joinPath [fp0, mdl' ++ ".html"]
+    Nothing  -> baseName mdl' ++ ".html"
+    Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl' ++ ".html"]
   where
-   mdl' = map (\c -> if c == '.' then '-' else c)
-              (moduleNameString (moduleName mdl))
+   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
@@ -229,6 +238,10 @@ 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'
@@ -353,11 +366,21 @@ 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
 -----------------------------------------------------------------------------
@@ -380,22 +403,23 @@ spanWith p xs@(a:as)
 
 
 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 (DocModule mod0)      = markupModule m mod0
-markup m (DocEmphasis d)       = markupEmphasis 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 (DocURL url)          = markupURL m url
-markup m (DocAName ref)        = markupAName m ref
-markup m (DocPic img)          = markupPic m img
-markup m (DocExamples e)       = markupExample m e
+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 (DocEmphasis d)             = markupEmphasis 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 (DocURL url)                = markupURL m url
+markup m (DocAName ref)              = markupAName m ref
+markup m (DocPic img)                = markupPic m img
+markup m (DocExamples e)             = markupExample m e
 
 
 markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a)
@@ -405,22 +429,23 @@ 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,
-  markupModule        = DocModule,
-  markupEmphasis      = DocEmphasis,
-  markupMonospaced    = DocMonospaced,
-  markupUnorderedList = DocUnorderedList,
-  markupOrderedList   = DocOrderedList,
-  markupDefList       = DocDefList,
-  markupCodeBlock     = DocCodeBlock,
-  markupURL           = DocURL,
-  markupAName         = DocAName,
-  markupPic           = DocPic,
-  markupExample       = DocExamples
+  markupEmpty                = DocEmpty,
+  markupString               = DocString,
+  markupParagraph            = DocParagraph,
+  markupAppend               = DocAppend,
+  markupIdentifier           = DocIdentifier,
+  markupIdentifierUnchecked  = DocIdentifierUnchecked,
+  markupModule               = DocModule,
+  markupEmphasis             = DocEmphasis,
+  markupMonospaced           = DocMonospaced,
+  markupUnorderedList        = DocUnorderedList,
+  markupOrderedList          = DocOrderedList,
+  markupDefList              = DocDefList,
+  markupCodeBlock            = DocCodeBlock,
+  markupURL                  = DocURL,
+  markupAName                = DocAName,
+  markupPic                  = DocPic,
+  markupExample              = DocExamples
   }
 
 
diff --git a/src/Main.hs b/src/Main.hs
index f78ace69..0a3c9ffc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -228,7 +228,7 @@ render flags ifaces installedIfaces srcMap = do
   when (Flag_GenContents `elem` flags) $ do
     ppHtmlContents odir title pkgStr
                    themes opt_index_url sourceUrls' opt_wiki_urls
-                   allVisibleIfaces True prologue pretty
+                   allVisibleIfaces True prologue pretty opt_qualification
     copyHtmlBits odir libDir themes
 
   when (Flag_Html `elem` flags) $ do
@@ -393,10 +393,13 @@ shortcutFlags flags = do
 
 
 updateHTMLXRefs :: [(DocPaths, InterfaceFile)] -> IO ()
-updateHTMLXRefs packages = writeIORef html_xrefs_ref (Map.fromList mapping)
+updateHTMLXRefs packages = do
+  writeIORef html_xrefs_ref (Map.fromList mapping)
+  writeIORef html_xrefs_ref' (Map.fromList mapping')
   where
     mapping = [ (instMod iface, html) | ((html, _), ifaces) <- packages
               , iface <- ifInstalledIfaces ifaces ]
+    mapping' = [ (moduleName m, html) | (m, html) <- mapping ]
 
 
 getPrologue :: [Flag] -> IO (Maybe (Doc RdrName))