Merge pull request #1317 from bgamari/wip/ghc-head-merge

Merge ghc-8.10 into ghc-head

5 files changed, 127 insertions, 94 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6a879a0d..de37e42a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -32,6 +32,7 @@ import Haddock.Doc (combineDocumentation)
 import           Data.List             ( intersperse, sort )
 import qualified Data.Map as Map
 import           Data.Maybe
+import           Data.Void             ( absurd )
 import           Text.XHtml hiding     ( name, title, p, quote )
 
 import GHC.Core.Type ( Specificity(..) )
@@ -75,14 +76,14 @@ ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsSigType DocNameI -> [(DocName, Fixity)] ->
              Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppLFunSig summary links loc doc lnames lty fixities splice unicode pkg qual =
-  ppFunSig summary links loc doc (map unLoc lnames) lty fixities
+  ppFunSig summary links loc noHtml doc (map unLoc lnames) lty fixities
            splice unicode pkg qual
 
-ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+ppFunSig :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
             [DocName] -> LHsSigType DocNameI -> [(DocName, Fixity)] ->
             Splice -> Unicode -> Maybe Package -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ fixities splice unicode pkg qual =
-  ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
+ppFunSig summary links loc leader doc docnames typ fixities splice unicode pkg qual =
+  ppSigLike summary links loc leader doc docnames fixities (unLoc typ, pp_typ)
             splice unicode pkg qual HideEmptyContexts
   where
     pp_typ = ppLSigType unicode qual HideEmptyContexts typ
@@ -133,8 +134,8 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
     curname = getName <$> listToMaybe docnames
 
 
--- This splits up a type signature along `->` and adds docs (when they exist) to
--- the arguments.
+-- | This splits up a type signature along @->@ and adds docs (when they exist)
+-- to the arguments.
 --
 -- If one passes in a list of the available subdocs, any top-level `HsRecTy`
 -- found will be expanded out into their fields.
@@ -152,7 +153,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_sig_args 0 sep
         HsOuterExplicit{hso_bndrs = bndrs} -> do_largs n (leader' bndrs) ltype
         HsOuterImplicit{}                  -> do_largs n leader          ltype
       where
-        leader' bndrs = leader <+> ppForAll (mkHsForAllInvisTeleI bndrs) unicode qual
+        leader' bndrs = leader <+> ppForAllPart unicode qual (mkHsForAllInvisTeleI bndrs)
 
     argDoc n = Map.lookup n argDocs
 
@@ -163,7 +164,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_sig_args 0 sep
     do_args n leader (HsForAllTy _ tele ltype)
       = do_largs n leader' ltype
       where
-        leader' = leader <+> ppForAll tele unicode qual
+        leader' = leader <+> ppForAllPart unicode qual tele
 
     do_args n leader (HsQualTy _ lctxt ltype)
       | null (unLoc lctxt)
@@ -197,24 +198,6 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_sig_args 0 sep
     gadtOpen = toHtml "{"
 
 
-
-ppForAll :: HsForAllTelescope DocNameI -> Unicode -> Qualification
-         -> Html
-ppForAll tele unicode qual = case tele of
-  HsForAllVis { hsf_vis_bndrs = bndrs } ->
-    pp_bndrs bndrs (spaceHtml +++ arrow unicode)
-  HsForAllInvis { hsf_invis_bndrs = bndrs } ->
-    pp_bndrs bndrs dot
-  where
-    pp_bndrs :: [LHsTyVarBndr flag DocNameI] -> Html -> Html
-    pp_bndrs tvs forall_separator =
-      case [pp_ktv n k | L _ (KindedTyVar _ _ (L _ n) k) <- tvs] of
-        [] -> noHtml
-        ts -> forallSymbol unicode <+> hsep ts +++ forall_separator
-
-    pp_ktv n k = parens $
-      ppTyName (getName n) <+> dcolon unicode <+> ppLKind unicode qual k
-
 ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
 ppFixities [] _ = noHtml
 ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
@@ -248,7 +231,7 @@ ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppFor summary links loc doc (ForeignImport _ (L _ name) typ _) fixities
       splice unicode pkg qual
-  = ppFunSig summary links loc doc [name] typ fixities splice unicode pkg qual
+  = ppFunSig summary links loc noHtml doc [name] typ fixities splice unicode pkg qual
 ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
 
 
@@ -280,11 +263,6 @@ ppTypeSig summary nms pp_ty unicode =
   where
     htmlNames = intersperse (stringToHtml ", ") $ map (ppBinder summary) nms
 
-
-ppTyName :: Name -> Html
-ppTyName = ppName Prefix
-
-
 ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan
             -> [DocName] -> HsSigType DocNameI
             -> Html
@@ -528,7 +506,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
                 -- ToDo: add associated type defaults
 
-            [ ppFunSig summary links loc doc names typ
+            [ ppFunSig summary links loc noHtml doc names typ
                        [] splice unicode pkg qual
               | L _ (ClassOpSig _ False lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
@@ -550,7 +528,7 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)
             -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppClassDecl summary links instances fixities loc d subdocs
         decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
-                        , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
+                        , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = atsDefs })
             splice unicode pkg qual
   | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual
   | otherwise = classheader +++ docSection curname pkg qual d
@@ -571,24 +549,61 @@ ppClassDecl summary links instances fixities loc d subdocs
 
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
-    -- ToDo: add assocatied typ defaults
-    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode pkg 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 [name] typ
-                                      subfixs splice unicode pkg qual
-                           | L _ (ClassOpSig _ _ lnames typ) <- lsigs
-                           , name <- map unLoc lnames
-                           , let doc = lookupAnySubdoc name subdocs
-                                 subfixs = [ f | f@(n',_) <- fixities
-                                               , name == n' ]
-                           ]
-                           -- N.B. taking just the first name is ok. Signatures with multiple names
-                           -- are expanded so that each name gets its own signature.
+    -- Associated types
+    atBit = subAssociatedTypes
+      [ ppAssocType summary links doc at subfixs splice unicode pkg qual
+          <+>
+        subDefaults (maybeToList defTys)
+      | at <- ats
+      , let name = unLoc . fdLName $ unLoc at
+            doc = lookupAnySubdoc name subdocs
+            subfixs = filter ((== name) . fst) fixities
+            defTys = (declElem . ppDefaultAssocTy name) <$> lookupDAT name
+      ]
+
+    -- Default associated types
+    ppDefaultAssocTy n (vs,rhs) = hsep
+      [ keyword "type", ppAppNameTypeArgs n vs unicode qual, equals
+      , ppType unicode qual HideEmptyContexts (unLoc rhs)
+      ]
+
+    lookupDAT name = Map.lookup (getName name) defaultAssocTys
+    defaultAssocTys = Map.fromList
+      [ (getName name, (vs, typ))
+      | L _ (TyFamInstDecl (FamEqn { feqn_rhs = typ
+                                   , feqn_tycon = L _ name
+                                   , feqn_pats = vs })) <- atsDefs
+      ]
 
+    -- Methods
+    methodBit = subMethods
+      [ ppFunSig summary links loc noHtml doc [name] typ
+                 subfixs splice unicode pkg qual
+          <+>
+        subDefaults (maybeToList defSigs)
+      | ClassOpSig _ False lnames typ <- sigs
+      , name <- map unLoc lnames
+      , let doc = lookupAnySubdoc name subdocs
+            subfixs = filter ((== name)  . fst) fixities
+            defSigs = ppDefaultFunSig name <$> lookupDM name
+      ]
+      -- N.B. taking just the first name is ok. Signatures with multiple names
+      -- are expanded so that each name gets its own signature.
+
+    -- Default methods
+    ppDefaultFunSig n (t, d') = ppFunSig summary links loc (keyword "default")
+      d' [n] t [] splice unicode pkg qual
+
+    lookupDM name = Map.lookup (getOccString name) defaultMethods
+    defaultMethods = Map.fromList
+      [ (nameStr, (typ, doc))
+      | ClassOpSig _ True lnames typ <- sigs
+      , name <- map unLoc lnames
+      , let doc = noDocForDecl -- TODO: get docs for method defaults
+            nameStr = getOccString name
+      ]
+
+    -- Minimal complete definition
     minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
@@ -612,6 +627,7 @@ ppClassDecl summary links instances fixities loc d subdocs
       where wrap | p = parens | otherwise = id
     ppMinimal p (Parens x) = ppMinimal p (unLoc x)
 
+    -- Instances
     instancesBit = ppInstances links (OriginClass nm) instances
         splice unicode pkg qual
 
@@ -836,18 +852,16 @@ ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualificati
 ppShortConstrParts summary dataInst con unicode qual
   = case con of
       ConDeclH98{ con_args = det
-                , con_ex_tvs = vars
+                , con_ex_tvs = tyVars
+                , con_forall = L _ forall_
                 , con_mb_cxt = cxt
-                } -> let tyVars = map (getName . hsLTyVarNameI) vars
-                         context = unLoc (fromMaybe (noLoc []) cxt)
-                         forall_ = False
+                } -> let context = unLoc (fromMaybe (noLoc []) cxt)
                          header_ = ppConstrHdr forall_ tyVars context unicode qual
                      in case det of
 
         -- Prefix constructor, e.g. 'Just a'
         PrefixCon _ args ->
-          ( header_ +++
-              hsep (ppOcc : map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args)
+          ( header_ <+> hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts . hsScaledThing) args)
           , noHtml
           , noHtml
           )
@@ -863,7 +877,7 @@ ppShortConstrParts summary dataInst con unicode qual
 
         -- Infix constructor, e.g. 'a :| [a]'
         InfixCon arg1 arg2 ->
-          ( header_ +++ hsep [ ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1)
+          ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1)
                              , ppOccInfix
                              , ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg2)
                              ]
@@ -910,28 +924,27 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
 
     decl = case con of
       ConDeclH98{ con_args = det
-                , con_ex_tvs = vars
+                , con_ex_tvs = tyVars
+                , con_forall = L _ forall_
                 , con_mb_cxt = cxt
-                } -> let tyVars = map (getName . hsLTyVarNameI) vars
-                         context = unLoc (fromMaybe (noLoc []) cxt)
-                         forall_ = False
+                } -> let context = unLoc (fromMaybe (noLoc []) cxt)
                          header_ = ppConstrHdr forall_ tyVars context unicode qual
                      in case det of
         -- Prefix constructor, e.g. 'Just a'
         PrefixCon _ args
-          | hasArgDocs -> header_ +++ ppOcc <+> fixity
-          | otherwise -> hsep [ header_ +++ ppOcc
-                              , hsep (map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args)
+          | hasArgDocs -> header_ <+> ppOcc <+> fixity
+          | otherwise -> hsep [ header_ <+> ppOcc
+                              , hsep (map (ppLParendType unicode qual HideEmptyContexts . hsScaledThing) args)
                               , fixity
                               ]
 
         -- Record constructor, e.g. 'Identity { runIdentity :: a }'
-        RecCon _ -> header_ +++ ppOcc <+> fixity
+        RecCon _ -> header_ <+> ppOcc <+> fixity
 
         -- Infix constructor, e.g. 'a :| [a]'
         InfixCon arg1 arg2
-          | hasArgDocs -> header_ +++ ppOcc <+> fixity
-          | otherwise -> hsep [ header_ +++ ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1)
+          | hasArgDocs -> header_ <+> ppOcc <+> fixity
+          | otherwise -> hsep [ header_ <+> ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1)
                               , ppOccInfix
                               , ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg2)
                               , fixity
@@ -984,17 +997,17 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool               -- ^ print explicit foralls
-            -> [Name]             -- ^ type variables
-            -> HsContext DocNameI -- ^ context
-            -> Unicode -> Qualification -> Html
+ppConstrHdr
+  :: Bool                    -- ^ print explicit foralls
+  -> [LHsTyVarBndr Specificity DocNameI] -- ^ type variables
+  -> HsContext DocNameI      -- ^ context
+  -> Unicode -> Qualification
+  -> Html
 ppConstrHdr forall_ tvs ctxt unicode qual = ppForall +++ ppCtxt
   where
     ppForall
       | null tvs || not forall_ = noHtml
-      | otherwise = forallSymbol unicode
-                      <+> hsep (map (ppName Prefix) tvs)
-                      <+> toHtml ". "
+      | otherwise = ppForAllPart unicode qual (HsForAllInvis noExtField tvs)
 
     ppCtxt
       | null ctxt = noHtml
@@ -1240,11 +1253,11 @@ ppr_mono_ty (HsTupleTy _ con tys) u q _ =
 ppr_mono_ty (HsSumTy _ tys) u q _ =
   sumParens (map (ppLType u q HideEmptyContexts) tys)
 ppr_mono_ty (HsKindSig _ ty kind) u q e =
-  parens (ppr_mono_lty ty u q e <+> dcolon u <+> ppLKind u q kind)
+  ppr_mono_lty ty u q e <+> dcolon u <+> ppLKind u q kind
 ppr_mono_ty (HsListTy _ ty)       u q _ = brackets (ppr_mono_lty ty u q HideEmptyContexts)
 ppr_mono_ty (HsIParamTy _ (L _ n) ty) u q _ =
   ppIPName n <+> dcolon u <+> ppr_mono_lty ty u q HideEmptyContexts
-ppr_mono_ty (HsSpliceTy {})     _ _ _ = error "ppr_mono_ty HsSpliceTy"
+ppr_mono_ty (HsSpliceTy v _) _ _ _ = absurd v
 ppr_mono_ty (HsRecTy {})        _ _ _ = toHtml "{..}"
        -- Can now legally occur in ConDeclGADT, the output here is to provide a
        -- placeholder in the signature, which is followed by the field
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index ee90ad68..378d0559 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -19,7 +19,7 @@ module Haddock.Backends.Xhtml.DocMarkup (
   docElement, docSection, docSection_,
 ) where
 
-import Data.List
+import Data.List (intersperse)
 import Documentation.Haddock.Markup
 import Haddock.Backends.Xhtml.Names
 import Haddock.Backends.Xhtml.Utils
@@ -171,18 +171,18 @@ flatten x = [x]
 -- extract/append the underlying 'Doc' and convert it to 'Html'. For
 -- 'CollapsingHeader', we attach extra info to the generated 'Html'
 -- that allows us to expand/collapse the content.
-hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (ModuleName, OccName) id -> Html
+hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (Wrap (ModuleName, OccName)) id -> Html
 hackMarkup fmt' currPkg h' =
   let (html, ms) = hackMarkup' fmt' h'
   in html +++ renderMeta fmt' currPkg (metaConcat ms)
   where
-    hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id
+    hackMarkup' :: DocMarkup id Html -> Hack (Wrap (ModuleName, OccName)) id
                 -> (Html, [Meta])
     hackMarkup' fmt h = case h of
       UntouchedDoc d -> (markup fmt $ _doc d, [_meta d])
       CollapsingHeader (Header lvl titl) par n nm ->
         let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n
-            col' = collapseControl id_ "caption"
+            col' = collapseControl id_ "subheading"
             summary = thesummary ! [ theclass "hide-when-js-enabled" ] << "Expand"
             instTable contents = collapseDetails id_ DetailsClosed (summary +++ contents)
             lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]
@@ -206,7 +206,7 @@ renderMeta _ _ _ = noHtml
 -- | Goes through 'hackMarkup' to generate the 'Html' rather than
 -- skipping straight to 'markup': this allows us to employ XHtml
 -- specific hacks to the tree first.
-markupHacked :: DocMarkup id Html
+markupHacked :: DocMarkup (Wrap id) Html
              -> Maybe Package      -- this package
              -> Maybe String
              -> MDoc id
@@ -220,7 +220,7 @@ docToHtml :: Maybe String  -- ^ Name of the thing this doc is for. See
           -> Maybe Package -- ^ Current package
           -> Qualification -> MDoc DocName -> Html
 docToHtml n pkg qual = markupHacked fmt pkg n . cleanup
-  where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
+  where fmt = parHtmlMarkup qual True (ppWrappedDocName qual Raw)
 
 -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
 -- in links. This is used to generate the Contents box elements.
@@ -228,16 +228,16 @@ docToHtmlNoAnchors :: Maybe String  -- ^ See 'toHack'
                    -> Maybe Package -- ^ Current package
                    -> Qualification -> MDoc DocName -> Html
 docToHtmlNoAnchors n pkg qual = markupHacked fmt pkg n . cleanup
-  where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
+  where fmt = parHtmlMarkup qual False (ppWrappedDocName qual Raw)
 
 origDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html
 origDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
-  where fmt = parHtmlMarkup qual True (const $ ppName Raw)
+  where fmt = parHtmlMarkup qual True (const (ppWrappedName Raw))
 
 
 rdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html
 rdrDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
-  where fmt = parHtmlMarkup qual True (const ppRdrName)
+  where fmt = parHtmlMarkup qual True (const (ppRdrName . unwrap))
 
 
 docElement :: (Html -> Html) -> Html -> Html
@@ -273,7 +273,7 @@ cleanup = overDoc (markup fmtUnParagraphLists)
     unParagraph (DocParagraph d) = d
     unParagraph doc              = doc
 
-    fmtUnParagraphLists :: DocMarkup a (Doc a)
+    fmtUnParagraphLists :: DocMarkup (Wrap 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
index dd8b0b18..d61d6d9b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -35,6 +35,7 @@ module Haddock.Backends.Xhtml.Layout (
   subInstances, subOrphanInstances,
   subInstHead, subInstDetails, subFamInstDetails,
   subMethods,
+  subDefaults,
   subMinimal,
 
   topDeclElem, declElem,
@@ -259,6 +260,9 @@ instAnchorId iid = makeAnchorId $ "i:" ++ iid
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
 
+subDefaults :: [Html] -> Html
+subDefaults = divSubDecls "default" "" . subBlock
+
 subMinimal :: Html -> Html
 subMinimal = divSubDecls "minimal" "Minimal complete definition" . Just . declElem
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index 83279f70..8553cdfb 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -13,7 +13,8 @@
 module Haddock.Backends.Xhtml.Names (
   ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,
   ppBinder, ppBinderInfix, ppBinder',
-  ppModule, ppModuleRef, ppIPName, linkId, Notation(..)
+  ppModule, ppModuleRef, ppIPName, linkId, Notation(..),
+  ppWrappedDocName, ppWrappedName,
 ) where
 
 
@@ -24,7 +25,7 @@ import Haddock.Utils
 
 import Text.XHtml hiding ( name, p, quote )
 import qualified Data.Map as M
-import qualified Data.List as List
+import Data.List ( stripPrefix )
 
 import GHC hiding (LexicalFixity(..))
 import GHC.Types.Name
@@ -49,9 +50,11 @@ ppIPName :: HsIPName -> Html
 ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS
 
 
-ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html
-ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName
-
+ppUncheckedLink :: Qualification -> Wrap (ModuleName, OccName) -> Html
+ppUncheckedLink _ x = linkIdOcc' mdl (Just occ) << occHtml
+  where
+    (mdl, occ) = unwrap x
+    occHtml = toHtml (showWrapped (occNameString . snd) x) -- TODO: apply ppQualifyName
 
 -- The Bool indicates if it is to be rendered in infix notation
 ppLDocName :: Qualification -> Notation -> Located DocName -> Html
@@ -68,6 +71,19 @@ ppDocName qual notation insertAnchors docName =
           ppQualifyName qual notation name (nameModule name)
       | otherwise -> ppName notation name
 
+
+ppWrappedDocName :: Qualification -> Notation -> Bool -> Wrap DocName -> Html
+ppWrappedDocName qual notation insertAnchors docName = case docName of
+  Unadorned n -> ppDocName qual notation insertAnchors n
+  Parenthesized n -> ppDocName qual Prefix insertAnchors n
+  Backticked n -> ppDocName qual Infix insertAnchors n
+
+ppWrappedName :: Notation -> Wrap Name -> Html
+ppWrappedName notation docName = case docName of
+  Unadorned n -> ppName notation n
+  Parenthesized n -> ppName Prefix n
+  Backticked n -> ppName Infix n
+
 -- | Render a name depending on the selected qualification mode
 ppQualifyName :: Qualification -> Notation -> Name -> Module -> Html
 ppQualifyName qual notation name mdl =
@@ -79,7 +95,7 @@ ppQualifyName qual notation name mdl =
         then ppName notation name
         else ppFullQualName notation mdl name
     RelativeQual localmdl ->
-      case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
+      case stripPrefix (moduleString localmdl) (moduleString mdl) of
         -- local, A.x -> x
         Just []      -> ppName notation name
         -- sub-module, A.B.x -> B.x
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
index 10d6ab10..b1d64acd 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Themes.hs
@@ -58,7 +58,7 @@ standardTheme :: FilePath -> IO PossibleThemes
 standardTheme libDir = liftM (liftEither (take 1)) (defaultThemes libDir)
 
 
--- | Default themes that are part of Haddock; added with --default-themes
+-- | Default themes that are part of Haddock; added with @--built-in-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.