3 files changed, 14 insertions, 39 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 45399963..ed8d4665 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -232,7 +232,7 @@ markupTag = Markup {
   markupEmpty         = str "",
   markupString        = str,
   markupAppend        = (++),
-  markupIdentifier    = box (TagInline "a") . str . out . head,
+  markupIdentifier    = box (TagInline "a") . str . out,
   markupModule        = box (TagInline "a") . str,
   markupEmphasis      = box (TagInline "i"),
   markupMonospaced    = box (TagInline "tt"),
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 5c21f0cf..fc313888 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -22,8 +22,8 @@ import qualified Pretty
 
 import GHC
 import OccName
-import Name                 ( isTyConName, nameOccName )
-import RdrName              ( rdrNameOcc, isRdrTc )
+import Name                 ( nameOccName )
+import RdrName              ( rdrNameOcc )
 import BasicTypes           ( ipNameName )
 import FastString           ( unpackFS, unpackLitString )
 
@@ -997,9 +997,8 @@ latexMonoMunge c   s = latexMunge c s
 -------------------------------------------------------------------------------
 
 
-parLatexMarkup :: (a -> LaTeX) -> (a -> Bool)
-               -> DocMarkup a (StringContext -> LaTeX)
-parLatexMarkup ppId isTyCon = 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),
@@ -1027,26 +1026,15 @@ parLatexMarkup ppId isTyCon = Markup {
         Verb  -> theid
         Mono  -> theid
         Plain -> text "\\haddockid" <> braces theid
-      where theid = ppId (choose id)
-
-    -- If an id can refer to multiple things, we give precedence to type
-    -- constructors.  This should ideally be done during renaming from RdrName
-    -- to Name, but since we will move this process from GHC into Haddock in
-    -- the future, we fix it here in the meantime.
-    -- TODO: mention this rule in the documentation.
-    choose [] = error "empty identifier list in HsDoc"
-    choose [x] = x
-    choose (x:y:_)
-      | isTyCon x = x
-      | otherwise = y
+      where theid = ppId id
 
 
 latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
-latexMarkup = parLatexMarkup ppVerbDocName (isTyConName . getName)
+latexMarkup = parLatexMarkup ppVerbDocName
 
 
 rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
-rdrLatexMarkup = parLatexMarkup ppVerbRdrName isRdrTc
+rdrLatexMarkup = parLatexMarkup ppVerbRdrName
 
 
 docToLaTeX :: Doc DocName -> LaTeX
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 93536834..05ce7dbb 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -28,17 +28,15 @@ import Haddock.Utils
 import Text.XHtml hiding ( name, title, p, quote )
 
 import GHC
-import Name
-import RdrName
 
 
-parHtmlMarkup :: (a -> Html) -> (a -> Bool) -> DocMarkup a Html
-parHtmlMarkup ppId isTyCon = Markup {
+parHtmlMarkup :: (a -> Html) -> DocMarkup a Html
+parHtmlMarkup ppId = Markup {
   markupEmpty         = noHtml,
   markupString        = toHtml,
   markupParagraph     = paragraph,
   markupAppend        = (+++),
-  markupIdentifier    = thecode . ppId . choose,
+  markupIdentifier    = thecode . ppId,
   markupModule        = \m -> let (mdl,ref) = break (=='#') m
                               in ppModuleRef (mkModuleNoPackage mdl) ref,
   markupEmphasis      = emphasize,
@@ -53,17 +51,6 @@ parHtmlMarkup ppId isTyCon = Markup {
   markupExample       = examplesToHtml
   }
   where
-    -- If an id can refer to multiple things, we give precedence to type
-    -- constructors.  This should ideally be done during renaming from RdrName
-    -- to Name, but since we will move this process from GHC into Haddock in
-    -- the future, we fix it here in the meantime.
-    -- TODO: mention this rule in the documentation.
-    choose [] = error "empty identifier list in HsDoc"
-    choose [x] = x
-    choose (x:y:_)
-      | isTyCon x = x
-      | otherwise = y
-
     examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
 
     exampleToHtml (Example expression result) = htmlExample
@@ -77,17 +64,17 @@ parHtmlMarkup ppId isTyCon = 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) (isTyConName . getName)
+  where fmt = parHtmlMarkup (ppDocName qual)
 
 
 origDocToHtml :: Doc Name -> Html
 origDocToHtml = markup fmt . cleanup
-  where fmt = parHtmlMarkup ppName isTyConName
+  where fmt = parHtmlMarkup ppName
 
 
 rdrDocToHtml :: Doc RdrName -> Html
 rdrDocToHtml = markup fmt . cleanup
-  where fmt = parHtmlMarkup ppRdrName isRdrTc
+  where fmt = parHtmlMarkup ppRdrName
 
 
 docElement :: (Html -> Html) -> Html -> Html