Merge branch 'ghc-8.8' into ghc-8.10

10 files changed, 346 insertions, 263 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index b76d14b5..1f98ef9c 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -254,13 +254,14 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         -- docs for con_names on why it is a list to begin with.
         name = commaSeparate dflags . map unL $ getConNames con
 
-        tyVarArg (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
-        tyVarArg (KindedTyVar _ n lty) = HsKindSig noExtField (reL (HsTyVar noExtField NotPromoted n)) lty
-        tyVarArg _ = panic "ppCtor"
+        resType = let c  = HsTyVar noExtField NotPromoted (reL (tcdName dat))
+                      as = map (tyVarBndr2Type . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat)
+                  in apps (map reL (c : as))
 
-        resType = apps $ map reL $
-                        (HsTyVar noExtField NotPromoted (reL (tcdName dat))) :
-                        map (tyVarArg . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat)
+        tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn
+        tyVarBndr2Type (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
+        tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig noExtField (reL (HsTyVar noExtField NotPromoted n)) k
+        tyVarBndr2Type (XTyVarBndr _) = panic "haddock:ppCtor"
 
 ppCtor dflags _dat subdocs con@(ConDeclGADT { })
    = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
@@ -325,7 +326,7 @@ markupTag dflags = Markup {
   markupString               = str,
   markupAppend               = (++),
   markupIdentifier           = box (TagInline "a") . str . out dflags,
-  markupIdentifierUnchecked  = box (TagInline "a") . str . out dflags . snd,
+  markupIdentifierUnchecked  = box (TagInline "a") . str . showWrapped (out dflags . snd),
   markupModule               = box (TagInline "a") . str,
   markupWarning              = box (TagInline "i"),
   markupEmphasis             = box (TagInline "i"),
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 7571db9e..3f5483fe 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -7,7 +7,7 @@ module Haddock.Backends.Hyperlinker
 
 
 import Haddock.Types
-import Haddock.Utils (writeUtf8File)
+import Haddock.Utils (writeUtf8File, out, verbose, Verbosity)
 import Haddock.Backends.Hyperlinker.Renderer
 import Haddock.Backends.Hyperlinker.Parser
 import Haddock.Backends.Hyperlinker.Types
@@ -18,12 +18,13 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 
-import HieTypes       ( HieFile(..), HieASTs(..) )
+import HieTypes       ( HieFile(..), HieAST(..), HieASTs(..), NodeInfo(..) )
 import HieBin         ( readHieFile, hie_file_result)
 import Data.Map as M
 import FastString     ( mkFastString )
 import Module         ( Module, moduleName )
 import NameCache      ( initNameCache )
+import SrcLoc         ( mkRealSrcLoc, realSrcLocSpan )
 import UniqSupply     ( mkSplitUniqSupply )
 
 
@@ -32,27 +33,28 @@ import UniqSupply     ( mkSplitUniqSupply )
 -- Note that list of interfaces should also contain interfaces normally hidden
 -- when generating documentation. Otherwise this could lead to dead links in
 -- produced source.
-ppHyperlinkedSource :: FilePath -- ^ Output directory
+ppHyperlinkedSource :: Verbosity
+                    -> FilePath -- ^ Output directory
                     -> FilePath -- ^ Resource directory
                     -> Maybe FilePath -- ^ Custom CSS file path
                     -> Bool -- ^ Flag indicating whether to pretty-print HTML
                     -> M.Map Module SrcPath -- ^ Paths to sources
                     -> [Interface] -- ^ Interfaces for which we create source
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle pretty srcs' ifaces = do
+ppHyperlinkedSource verbosity outdir libdir mstyle pretty srcs' ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces
+    mapM_ (ppHyperlinkedModuleSource verbosity srcdir pretty srcs) ifaces
   where
     srcdir = outdir </> hypSrcDir
     srcs = (srcs', M.mapKeys moduleName srcs')
 
 -- | Generate hyperlinked source for particular interface.
-ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMaps -> Interface -> IO ()
-ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
+ppHyperlinkedModuleSource :: Verbosity -> FilePath -> Bool -> SrcMaps -> Interface -> IO ()
+ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile iface of
     Just hfp -> do
         -- Parse the GHC-produced HIE file
         u <- mkSplitUniqSupply 'a'
@@ -64,25 +66,38 @@ ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
                  <$> (readHieFile (initNameCache u []) hfp)
 
         -- Get the AST and tokens corresponding to the source file we want
-        let mast | M.size asts == 1 = snd <$> M.lookupMin asts
-                 | otherwise        = M.lookup (mkFastString file) asts
+        let fileFs = mkFastString file
+            mast | M.size asts == 1 = snd <$> M.lookupMin asts
+                 | otherwise        = M.lookup fileFs asts
+            ast = fromMaybe (emptyHieAst fileFs) mast
+            fullAst = recoverFullIfaceTypes df types ast
             tokens = parse df file rawSrc
 
+        -- Warn if we didn't find an AST, but there were still ASTs
+        if M.null asts
+          then pure ()
+          else out verbosity verbose $ unwords [ "couldn't find ast for"
+                                               , file, show (M.keys asts) ]
+
         -- Produce and write out the hyperlinked sources
-        case mast of
-          Just ast ->
-              let fullAst = recoverFullIfaceTypes df types ast
-              in writeUtf8File path . renderToString pretty . render' fullAst $ tokens
-          Nothing
-            | M.size asts == 0 -> return ()
-            | otherwise -> error $ unwords [ "couldn't find ast for"
-                                           , file, show (M.keys asts) ]
+        writeUtf8File path . renderToString pretty . render' fullAst $ tokens
     Nothing -> return ()
   where
     df = ifaceDynFlags iface
     render' = render (Just srcCssFile) (Just highlightScript) srcs
     path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
+    emptyNodeInfo = NodeInfo
+      { nodeAnnotations = mempty
+      , nodeType = []
+      , nodeIdentifiers = mempty
+      }
+    emptyHieAst fileFs = Node
+      { nodeInfo = emptyNodeInfo
+      , nodeSpan = realSrcLocSpan (mkRealSrcLoc fileFs 1 0)
+      , nodeChildren = []
+      }
+
 -- | Name of CSS file in output directory.
 srcCssFile :: FilePath
 srcCssFile = "style.css"
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index e9029ae6..0247d567 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -9,7 +9,7 @@ import qualified Data.ByteString as BS
 
 import BasicTypes          ( IntegralLit(..) )
 import DynFlags
-import ErrUtils            ( emptyMessages, pprLocErrMsg )
+import ErrUtils            ( pprLocErrMsg )
 import FastString          ( mkFastString )
 import Lexer               ( P(..), ParseResult(..), PState(..), Token(..)
                            , mkPStatePure, lexer, mkParserFlags', getErrorMessages, addFatalError )
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 67eb10b5..612f3f08 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -102,7 +102,7 @@ type PrintedType = String
 -- >       hieAst
 --
 -- However, this is very inefficient (both in time and space) because the
--- mutliple calls to 'recoverFullType' don't share intermediate results. This
+-- multiple calls to 'recoverFullType' don't share intermediate results. This
 -- function fixes that.
 recoverFullIfaceTypes
   :: DynFlags
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 6fd7969f..f2fb1041 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -103,6 +103,10 @@ haddockSty = "haddock.sty"
 
 type LaTeX = Pretty.Doc
 
+-- | Default way of rendering a 'LaTeX'. The width is 90 by default (since 100
+-- often overflows the line).
+latex2String :: LaTeX -> String
+latex2String = fullRender PageMode 90 1 txtPrinter ""
 
 ppLaTeXTop
    :: String
@@ -156,7 +160,7 @@ ppLaTeXModule _title odir iface = do
         text "\\haddockbeginheader",
         verb $ vcat [
            text "module" <+> text mdl_str <+> lparen,
-           text "    " <> fsep (punctuate (text ", ") $
+           text "    " <> fsep (punctuate (char ',') $
                                map exportListItem $
                                filter forSummary exports),
            text "  ) where"
@@ -171,7 +175,7 @@ ppLaTeXModule _title odir iface = do
 
       body = processExports exports
   --
-  writeUtf8File (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
+  writeUtf8File (odir </> moduleLaTeXFile mdl) (show tex)
 
 -- | Prints out an entry in a module export list.
 exportListItem :: ExportItem DocNameI -> LaTeX
@@ -287,7 +291,7 @@ ppDecl :: LHsDecl DocNameI                         -- ^ decl to print
        -> LaTeX
 
 ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
-  TyClD _ d@FamDecl {}         -> ppFamDecl doc instances d unicode
+  TyClD _ d@FamDecl {}         -> ppFamDecl False doc instances d unicode
   TyClD _ d@DataDecl {}        -> ppDataDecl pats instances subdocs (Just doc) d unicode
   TyClD _ d@SynDecl {}         -> ppTySyn (doc, fnArgsDoc) d unicode
 -- Family instances happen via FamInst now
@@ -295,7 +299,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
   TyClD _ d@ClassDecl{}          -> ppClassDecl instances doc subdocs d unicode
-  SigD _ (TypeSig _ lnames ty)   -> ppFunSig (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
+  SigD _ (TypeSig _ lnames ty)   -> ppFunSig Nothing (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
   SigD _ (PatSynSig _ lnames ty) -> ppLPatSig (doc, fnArgsDoc) (map unLoc lnames) ty unicode
   ForD _ d                       -> ppFor (doc, fnArgsDoc) d unicode
   InstD _ _                      -> empty
@@ -307,7 +311,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
 
 ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
 ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
-  ppFunSig doc [name] (hsSigTypeI typ) unicode
+  ppFunSig Nothing doc [name] (hsSigTypeI typ) unicode
 ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 --  error "foreign declarations are currently not supported by --latex"
 
@@ -317,13 +321,14 @@ ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 -------------------------------------------------------------------------------
 
 -- | Pretty-print a data\/type family declaration
-ppFamDecl :: Documentation DocName    -- ^ this decl's docs
+ppFamDecl :: Bool                     -- ^ is the family associated?
+          -> Documentation DocName    -- ^ this decl's docs
           -> [DocInstance DocNameI]   -- ^ relevant instances
           -> TyClDecl DocNameI        -- ^ family to print
           -> Bool                     -- ^ unicode
           -> LaTeX
-ppFamDecl doc instances decl unicode =
-  declWithDoc (ppFamHeader (tcdFam decl) unicode <+> whereBit)
+ppFamDecl associated doc instances decl unicode =
+  declWithDoc (ppFamHeader (tcdFam decl) unicode associated <+> whereBit)
               (if null body then Nothing else Just (vcat body))
   $$ instancesBit
   where
@@ -335,6 +340,7 @@ ppFamDecl doc instances decl unicode =
 
     familyEqns
       | FamilyDecl { fdInfo = ClosedTypeFamily (Just eqns) } <- tcdFam decl
+      , not (null eqns)
       = Just (text "\\haddockbeginargs" $$
               vcat [ decltt (ppFamDeclEqn eqn) <+> nl | L _ eqn <- eqns ] $$
               text "\\end{tabulary}\\par")
@@ -356,22 +362,26 @@ ppFamDecl doc instances decl unicode =
 
 -- | Print the LHS of a type\/data family declaration.
 ppFamHeader :: FamilyDecl DocNameI  -- ^ family header to print
-              -> Bool                 -- ^ unicode
-              -> LaTeX
-ppFamHeader (XFamilyDecl nec) _ = noExtCon nec
+            -> Bool                 -- ^ unicode
+            -> Bool                 -- ^ is the family associated?
+            -> LaTeX
+ppFamHeader (XFamilyDecl nec) _ _ = noExtCon nec
 ppFamHeader (FamilyDecl { fdLName = L _ name
                         , fdTyVars = tvs
                         , fdInfo = info
                         , fdResultSig = L _ result
                         , fdInjectivityAnn = injectivity })
-              unicode =
-  leader <+> keyword "family" <+> famName <+> famSig <+> injAnn
+              unicode associated =
+  famly leader <+> famName <+> famSig <+> injAnn
   where
     leader = case info of
       OpenTypeFamily     -> keyword "type"
       ClosedTypeFamily _ -> keyword "type"
       DataFamily         -> keyword "data"
 
+    famly | associated = id
+          | otherwise = (<+> keyword "family")
+
     famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs)
 
     famSig = case result of
@@ -414,17 +424,23 @@ ppTySyn _ _ _ = error "declaration not supported by ppTySyn"
 -------------------------------------------------------------------------------
 
 
-ppFunSig :: DocForDecl DocName -> [DocName] -> LHsType DocNameI
-         -> Bool -> LaTeX
-ppFunSig doc docnames (L _ typ) unicode =
+ppFunSig
+  :: Maybe LaTeX         -- ^ a prefix to put right before the signature
+  -> DocForDecl DocName  -- ^ documentation
+  -> [DocName]           -- ^ pattern names in the pattern signature
+  -> LHsType DocNameI    -- ^ type of the pattern synonym
+  -> Bool                -- ^ unicode
+  -> LaTeX
+ppFunSig leader doc docnames (L _ typ) unicode =
   ppTypeOrFunSig typ doc
-    ( ppTypeSig names typ False
-    , hsep . punctuate comma $ map ppSymName names
+    ( lead $ ppTypeSig names typ False
+    , lead $ hsep . punctuate comma $ map ppSymName names
     , dcolon unicode
     )
     unicode
  where
    names = map getName docnames
+   lead = maybe id (<+>) leader
 
 -- | Pretty-print a pattern synonym
 ppLPatSig :: DocForDecl DocName  -- ^ documentation
@@ -433,15 +449,7 @@ ppLPatSig :: DocForDecl DocName  -- ^ documentation
           -> Bool                -- ^ unicode
           -> LaTeX
 ppLPatSig doc docnames ty unicode
-  = ppTypeOrFunSig typ doc
-      ( keyword "pattern" <+> ppTypeSig names typ False
-      , keyword "pattern" <+> (hsep . punctuate comma $ map ppSymName names)
-      , dcolon unicode
-      )
-      unicode
-  where
-    typ = unLoc (hsSigTypeI ty)
-    names = map getName docnames
+  = ppFunSig (Just (keyword "pattern")) doc docnames (hsSigTypeI ty) unicode
 
 -- | Pretty-print a type, adding documentation to the whole type and its
 -- arguments as needed.
@@ -461,7 +469,7 @@ ppTypeOrFunSig typ (doc, argDocs) (pref1, pref2, sep0) unicode
         text "\\end{tabulary}\\par" $$
         fromMaybe empty (documentationToLaTeX doc)
 
--- This splits up a type signature along `->` and adds docs (when they exist)
+-- | This splits up a type signature along @->@ and adds docs (when they exist)
 -- to the arguments. The output is a list of (leader/seperator, argument and
 -- its doc)
 ppSubSigLike :: Bool                  -- ^ unicode
@@ -479,13 +487,13 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ
     do_args :: Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
     do_args _n leader (HsForAllTy _ fvf tvs ltype)
       = [ ( decltt leader
-          , decltt (hsep (forallSymbol unicode : ppTyVars tvs ++
-                          [ppForAllSeparator unicode fvf]))
+          , decltt (ppForAllPart unicode tvs fvf)
               <+> ppLType unicode ltype
           ) ]
     do_args n leader (HsQualTy _ lctxt ltype)
-      = (decltt leader, ppLContextNoArrow lctxt unicode <+> nl)
-        : do_largs n (darrow unicode) ltype
+      = ( decltt leader
+        , decltt (ppLContextNoArrow lctxt unicode) <+> nl
+        ) : do_largs n (darrow unicode) ltype
 
     do_args n leader (HsFunTy _ (L _ (HsRecTy _ fields)) r)
       = [ (decltt ldr, latex <+> nl)
@@ -504,9 +512,9 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ
     -- We need 'gadtComma' and 'gadtEnd' to line up with the `{` from
     -- 'gadtOpen', so we add 3 spaces to cover for `-> `/`:: ` (3 in unicode
     -- mode since `->` and `::` are rendered as single characters.
-    gadtComma = hcat (replicate (if unicode then 3 else 4) (text "\\ ")) <> text ","
-    gadtEnd = hcat (replicate (if unicode then 3 else 4) (text "\\ ")) <> text "\\}"
-    gadtOpen = text "\\{"
+    gadtComma = hcat (replicate (if unicode then 3 else 4) (char ' ')) <> char ','
+    gadtEnd = hcat (replicate (if unicode then 3 else 4) (char ' ')) <> char '}'
+    gadtOpen = char '{'
 
 
 ppForAllSeparator :: Bool -> ForallVisFlag -> LaTeX
@@ -522,8 +530,9 @@ ppTypeSig nms ty unicode =
     <+> ppType unicode ty
 
 
-ppTyVars :: [LHsTyVarBndr DocNameI] -> [LaTeX]
-ppTyVars = map (ppSymName . getName . hsLTyVarNameI)
+-- | Pretty-print type variables.
+ppTyVars :: Bool -> [LHsTyVarBndr DocNameI] -> [LaTeX]
+ppTyVars unicode = map (ppHsTyVarBndr unicode . unLoc)
 
 
 tyvarNames :: LHsQTyVars DocNameI -> [Name]
@@ -534,10 +543,9 @@ declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
 declWithDoc decl doc =
    text "\\begin{haddockdesc}" $$
    text "\\item[\\begin{tabular}{@{}l}" $$
-   text (latexMonoFilter (show decl)) $$
-   text "\\end{tabular}]" <>
-       (if isNothing doc then empty else text "\\haddockbegindoc") $$
-   maybe empty id doc $$
+   text (latexMonoFilter (latex2String decl)) $$
+   text "\\end{tabular}]" $$
+   maybe empty (\x -> text "{\\haddockbegindoc" $$ x <> text "}") doc $$
    text "\\end{haddockdesc}"
 
 
@@ -548,9 +556,9 @@ multiDecl :: [LaTeX] -> LaTeX
 multiDecl decls =
    text "\\begin{haddockdesc}" $$
    vcat [
-      text "\\item[" $$
-      text (latexMonoFilter (show decl)) $$
-      text "]"
+      text "\\item[\\begin{tabular}{@{}l}" $$
+      text (latexMonoFilter (latex2String decl)) $$
+      text "\\end{tabular}]"
       | decl <- decls ] $$
    text "\\end{haddockdesc}"
 
@@ -594,6 +602,7 @@ ppFds fds unicode =
                            hsep (map (ppDocName . unLoc) vars2)
 
 
+-- TODO: associated type defaults, docs on default methods
 ppClassDecl :: [DocInstance DocNameI]
             -> Documentation DocName -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocNameI -> Bool -> LaTeX
@@ -614,18 +623,28 @@ ppClassDecl instances doc subdocs
     body_
       | null lsigs, null ats, null at_defs = Nothing
       | null ats, null at_defs = Just methodTable
----     | otherwise = atTable $$ methodTable
-      | otherwise = error "LaTeX.ppClassDecl"
+      | otherwise = Just (atTable $$ methodTable)
+
+    atTable =
+      text "\\haddockpremethods{}" <> emph (text "Associated Types") $$
+      vcat  [ ppFamDecl True (fst doc) [] (FamDecl noExtField decl) True
+            | L _ decl <- ats
+            , let name = unL . fdLName $ decl
+                  doc = lookupAnySubdoc name subdocs
+            ]
+
 
     methodTable =
       text "\\haddockpremethods{}" <> emph (text "Methods") $$
-      vcat  [ ppFunSig doc names (hsSigWcType typ) unicode
-            | L _ (TypeSig _ lnames typ) <- lsigs
-            , let doc = lookupAnySubdoc (head names) subdocs
-                  names = map unLoc lnames ]
-              -- FIXME: is taking just the first name ok? Is it possible that
-              -- there are different subdocs for different names in a single
-              -- type signature?
+      vcat  [ ppFunSig leader doc names (hsSigTypeI typ) unicode
+            | L _ (ClassOpSig _ is_def lnames typ) <- lsigs
+            , let doc | is_def = noDocForDecl
+                      | otherwise = lookupAnySubdoc (head names) subdocs
+                  names = map unLoc lnames
+                  leader = if is_def then Just (keyword "default") else Nothing
+            ]
+            -- N.B. taking just the first name is ok. Signatures with multiple
+            -- names are expanded so that each name gets its own signature.
 
     instancesBit = ppDocInstances unicode instances
 
@@ -644,6 +663,7 @@ ppDocInstances unicode (i : rest)
 
 isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
 isUndocdInstance (i,Nothing,_,_) = Just i
+isUndocdInstance (i,Just (MetaDoc _ DocEmpty),_,_) = Just i
 isUndocdInstance _ = Nothing
 
 -- | Print a possibly commented instance. The instance header is printed inside
@@ -726,15 +746,21 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
 
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX
-ppConstrHdr forall tvs ctxt unicode
- = (if null tvs then empty else ppForall)
-   <+>
-   (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
+ppConstrHdr
+  :: Bool                    -- ^ print explicit foralls
+  -> [LHsTyVarBndr DocNameI] -- ^ type variables
+  -> HsContext DocNameI      -- ^ context
+  -> Bool                    -- ^ unicode
+  -> LaTeX
+ppConstrHdr forall_ tvs ctxt unicode = ppForall <> ppCtxt
   where
-    ppForall = case forall of
-      True  -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
-      False -> empty
+    ppForall
+      | null tvs || not forall_ = empty
+      | otherwise = ppForAllPart unicode tvs ForallInvis
+
+    ppCtxt
+      | null ctxt = empty
+      | otherwise = ppContextNoArrow ctxt unicode <+> darrow unicode <> space
 
 
 -- | Pretty-print a constructor
@@ -763,11 +789,10 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     -- First line of the constructor (no doc, no fields, single-line)
     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
                      in case det of
         -- Prefix constructor, e.g. 'Just a'
@@ -1004,7 +1029,7 @@ ppLFunLhType  unicode y = ppFunLhType unicode (unLoc y)
 
 ppType, ppParendType, ppFunLhType, ppCtxType :: Bool -> HsType DocNameI -> LaTeX
 ppType       unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
-ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
+ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_CON ty) unicode
 ppFunLhType  unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode
 ppCtxType    unicode ty = ppr_mono_ty (reparenTypePrec PREC_CTX ty) unicode
 
@@ -1017,7 +1042,7 @@ ppLHsTypeArg _ (HsArgPar _) = text ""
 ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
 ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name
 ppHsTyVarBndr unicode (KindedTyVar _ (L _ name) kind) =
-  parens (ppDocName name) <+> dcolon unicode <+> ppLKind unicode kind
+  parens (ppDocName name <+> dcolon unicode <+> ppLKind unicode kind)
 ppHsTyVarBndr _ (XTyVarBndr nec) = noExtCon nec
 
 ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
@@ -1030,14 +1055,22 @@ ppKind unicode ki = ppr_mono_ty (reparenTypePrec PREC_TOP ki) unicode
 -- Drop top-level for-all type variables in user style
 -- since they are implicit in Haskell
 
+ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
+ppForAllPart unicode tvs fvf = hsep (forallSymbol unicode : tvs') <> fv
+  where
+    tvs' = ppTyVars unicode tvs
+    fv = case fvf of
+           ForallVis   -> text "\\ " <> arrow unicode
+           ForallInvis -> dot
+
+
 ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX
 ppr_mono_lty ty unicode = ppr_mono_ty (unLoc ty) unicode
 
 
 ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX
 ppr_mono_ty (HsForAllTy _ fvf tvs ty) unicode
-  = sep [ hsep (forallSymbol unicode : ppTyVars tvs) <>
-            ppForAllSeparator unicode fvf
+  = sep [ ppForAllPart unicode tvs fvf
         , ppr_mono_lty ty unicode ]
 ppr_mono_ty (HsQualTy _ ctxt ty) unicode
   = sep [ ppLContext ctxt unicode
@@ -1051,7 +1084,7 @@ ppr_mono_ty (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name
 ppr_mono_ty (HsTyVar _ IsPromoted  (L _ name)) _ = char '\'' <> ppDocName name
 ppr_mono_ty (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys)
 ppr_mono_ty (HsSumTy _ tys) u       = sumParens (map (ppLType u) tys)
-ppr_mono_ty (HsKindSig _ ty kind) u = parens (ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind)
+ppr_mono_ty (HsKindSig _ ty kind) u = ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind
 ppr_mono_ty (HsListTy _ ty)       u = brackets (ppr_mono_lty ty u)
 ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u
 ppr_mono_ty (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
@@ -1080,7 +1113,7 @@ ppr_mono_ty (HsParTy _ ty) unicode
 ppr_mono_ty (HsDocTy _ ty _) unicode
   = ppr_mono_lty ty unicode
 
-ppr_mono_ty (HsWildCardTy _) _ = text "\\_"
+ppr_mono_ty (HsWildCardTy _) _ = char '_'
 
 ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
 ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
@@ -1114,9 +1147,6 @@ ppSymName name
   | otherwise = ppName name
 
 
-ppVerbOccName :: OccName -> LaTeX
-ppVerbOccName = text . latexFilter . occNameString
-
 ppIPName :: HsIPName -> LaTeX
 ppIPName = text . ('?':) . unpackFS . hsIPNameFS
 
@@ -1124,18 +1154,9 @@ ppOccName :: OccName -> LaTeX
 ppOccName = text . occNameString
 
 
-ppVerbDocName :: DocName -> LaTeX
-ppVerbDocName = ppVerbOccName . nameOccName . getName
-
-
-ppVerbRdrName :: RdrName -> LaTeX
-ppVerbRdrName = ppVerbOccName . rdrNameOcc
-
-
 ppDocName :: DocName -> LaTeX
 ppDocName = ppOccName . nameOccName . getName
 
-
 ppLDocName :: Located DocName -> LaTeX
 ppLDocName (L _ d) = ppDocName d
 
@@ -1173,9 +1194,10 @@ latexMunge c    s = c : s
 
 
 latexMonoMunge :: Char -> String -> String
-latexMonoMunge ' ' s = '\\' : ' ' : s
+latexMonoMunge ' '      (' ':s) = "\\ \\ " ++ s
+latexMonoMunge ' ' ('\\':' ':s) = "\\ \\ " ++ s
 latexMonoMunge '\n' s = '\\' : '\\' : s
-latexMonoMunge c   s = latexMunge c s
+latexMonoMunge c s = latexMunge c s
 
 
 -------------------------------------------------------------------------------
@@ -1183,34 +1205,40 @@ 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 ppId,
-  markupIdentifierUnchecked  = markupId (ppVerbOccName . snd),
-  markupModule               = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
-  markupWarning              = \p v -> emph (p v),
-  markupEmphasis             = \p v -> emph (p v),
-  markupBold                 = \p v -> bold (p v),
-  markupMonospaced           = \p _ -> tt (p Mono),
-  markupUnorderedList        = \p v -> itemizedList (map ($v) p) $$ text "",
-  markupPic                  = \p _ -> markupPic p,
-  markupMathInline           = \p _ -> markupMathInline p,
-  markupMathDisplay          = \p _ -> markupMathDisplay p,
-  markupOrderedList          = \p v -> enumeratedList (map ($v) p) $$ text "",
-  markupDefList              = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
-  markupCodeBlock            = \p _ -> quote (verb (p Verb)) $$ text "",
-  markupHyperlink            = \(Hyperlink u l) p -> markupLink u (fmap ($p) l),
-  markupAName                = \_ _ -> empty,
-  markupProperty             = \p _ -> quote $ verb $ text p,
-  markupExample              = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
-  markupHeader               = \(Header l h) p -> header l (h p),
-  markupTable                = \(Table h b) p -> table h b p
+latexMarkup :: HasOccName a => DocMarkup (Wrap a) (StringContext -> LaTeX -> LaTeX)
+latexMarkup = Markup
+  { markupParagraph            = \p v -> blockElem (p v (text "\\par"))
+  , markupEmpty                = \_ -> id
+  , markupString               = \s v -> inlineElem (text (fixString v s))
+  , markupAppend               = \l r v -> l v . r v
+  , markupIdentifier           = \i v -> inlineElem (markupId v (fmap occName i))
+  , markupIdentifierUnchecked  = \i v -> inlineElem (markupId v (fmap snd i))
+  , markupModule               = \m _ -> inlineElem (let (mdl,_ref) = break (=='#') m in (tt (text mdl)))
+  , markupWarning              = \p v -> p v
+  , markupEmphasis             = \p v -> inlineElem (emph (p v empty))
+  , markupBold                 = \p v -> inlineElem (bold (p v empty))
+  , markupMonospaced           = \p v -> inlineElem (markupMonospace p v)
+  , markupUnorderedList        = \p v -> blockElem (itemizedList (map (\p' -> p' v empty) p))
+  , markupPic                  = \p _ -> inlineElem (markupPic p)
+  , markupMathInline           = \p _ -> inlineElem (markupMathInline p)
+  , markupMathDisplay          = \p _ -> blockElem (markupMathDisplay p)
+  , markupOrderedList          = \p v -> blockElem (enumeratedList (map (\p' -> p' v empty) p))
+  , markupDefList              = \l v -> blockElem (descriptionList (map (\(a,b) -> (a v empty, b v empty)) l))
+  , markupCodeBlock            = \p _ -> blockElem (quote (verb (p Verb empty)))
+  , markupHyperlink            = \(Hyperlink u l) v -> inlineElem (markupLink u (fmap (\x -> x v empty) l))
+  , markupAName                = \_ _ -> id -- TODO
+  , markupProperty             = \p _ -> blockElem (quote (verb (text p)))
+  , markupExample              = \e _ -> blockElem (quote (verb (text $ unlines $ map exampleToString e)))
+  , markupHeader               = \(Header l h) p -> blockElem (header l (h p empty))
+  , markupTable                = \(Table h b) p -> blockElem (table h b p)
   }
   where
+    blockElem :: LaTeX -> LaTeX -> LaTeX
+    blockElem = ($$)
+
+    inlineElem :: LaTeX -> LaTeX -> LaTeX
+    inlineElem = (<>)
+
     header 1 d = text "\\section*" <> braces d
     header 2 d = text "\\subsection*" <> braces d
     header l d
@@ -1223,6 +1251,9 @@ parLatexMarkup ppId = Markup {
     fixString Verb  s = s
     fixString Mono  s = latexMonoFilter s
 
+    markupMonospace p Verb = p Verb empty
+    markupMonospace p _ = tt (p Mono empty)
+
     markupLink url mLabel = case mLabel of
       Just label -> text "\\href" <> braces (text url) <> braces label
       Nothing    -> text "\\url"  <> braces (text url)
@@ -1239,35 +1270,28 @@ parLatexMarkup ppId = Markup {
 
     markupMathDisplay mathjax = text "\\[" <> text mathjax <> text "\\]"
 
-    markupId ppId_ id v =
+    markupId v wrappedOcc =
       case v of
-        Verb  -> theid
-        Mono  -> theid
-        Plain -> text "\\haddockid" <> braces theid
-      where theid = ppId_ id
-
-
-latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
-latexMarkup = parLatexMarkup ppVerbDocName
-
-
-rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
-rdrLatexMarkup = parLatexMarkup ppVerbRdrName
-
+        Verb  -> text i
+        Mono  -> text "\\haddockid" <> braces (text . latexMonoFilter $ i)
+        Plain -> text "\\haddockid" <> braces (text . latexFilter $ i)
+      where i = showWrapped occNameString wrappedOcc
 
 docToLaTeX :: Doc DocName -> LaTeX
-docToLaTeX doc = markup latexMarkup doc Plain
-
+docToLaTeX doc = markup latexMarkup doc Plain empty
 
 documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
 documentationToLaTeX = fmap docToLaTeX . fmap _doc . combineDocumentation
 
 
 rdrDocToLaTeX :: Doc RdrName -> LaTeX
-rdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain
+rdrDocToLaTeX doc = markup latexMarkup doc Plain empty
 
 
-data StringContext = Plain | Verb | Mono
+data StringContext
+  = Plain  -- ^ all special characters have to be escape
+  | Mono   -- ^ on top of special characters, escape space chraacters
+  | Verb   -- ^ don't escape anything
 
 
 latexStripTrailingWhitespace :: Doc a -> Doc a
@@ -1292,23 +1316,23 @@ latexStripTrailingWhitespace other = other
 
 itemizedList :: [LaTeX] -> LaTeX
 itemizedList items =
-  text "\\begin{itemize}" $$
+  text "\\vbox{\\begin{itemize}" $$
   vcat (map (text "\\item" $$) items) $$
-  text "\\end{itemize}"
+  text "\\end{itemize}}"
 
 
 enumeratedList :: [LaTeX] -> LaTeX
 enumeratedList items =
-  text "\\begin{enumerate}" $$
+  text "\\vbox{\\begin{enumerate}" $$
   vcat (map (text "\\item " $$) items) $$
-  text "\\end{enumerate}"
+  text "\\end{enumerate}}"
 
 
 descriptionList :: [(LaTeX,LaTeX)] -> LaTeX
 descriptionList items =
-  text "\\begin{description}" $$
-  vcat (map (\(a,b) -> text "\\item" <> brackets a <+> b) items) $$
-  text "\\end{description}"
+  text "\\vbox{\\begin{description}" $$
+  vcat (map (\(a,b) -> text "\\item" <> brackets a <> text "\\hfill \\par" $$ b) items) $$
+  text "\\end{description}}"
 
 
 tt :: LaTeX -> LaTeX
@@ -1316,8 +1340,8 @@ tt ltx = text "\\haddocktt" <> braces ltx
 
 
 decltt :: LaTeX -> LaTeX
-decltt ltx = text "\\haddockdecltt" <> braces ltx
-
+decltt ltx = text "\\haddockdecltt" <> braces (text filtered)
+  where filtered = latexMonoFilter (latex2String ltx)
 
 emph :: LaTeX -> LaTeX
 emph ltx = text "\\emph" <> braces ltx
@@ -1325,6 +1349,12 @@ emph ltx = text "\\emph" <> braces ltx
 bold :: LaTeX -> LaTeX
 bold ltx = text "\\textbf" <> braces ltx
 
+-- TODO: @verbatim@ is too much since
+--
+--   * Haddock supports markup _inside_ of codeblocks. Right now, the LaTeX
+--     representing that markup gets printed verbatim
+--   * Verbatim environments are not supported everywhere (example: not nested
+--     inside a @tabulary@ environment)
 verb :: LaTeX -> LaTeX
 verb doc = text "{\\haddockverb\\begin{verbatim}" $$ doc <> text "\\end{verbatim}}"
    -- NB. swallow a trailing \n in the verbatim text by appending the
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a24715a7..c7ae15ca 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -36,11 +36,11 @@ import           Text.XHtml hiding     ( name, title, p, quote )
 
 import BasicTypes (PromotionFlag(..), isPromoted)
 import GHC hiding (LexicalFixity(..))
+import qualified GHC
 import GHC.Exts
 import Name
 import BooleanFormula
 import RdrName ( rdrNameOcc )
-import Outputable ( panic )
 
 -- | Pretty print a declaration
 ppDecl :: Bool                                     -- ^ print summary info only
@@ -75,14 +75,14 @@ ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsType 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] -> LHsType 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 = ppLType unicode qual HideEmptyContexts typ
@@ -133,8 +133,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,9 +152,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
 
     do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
     do_args n leader (HsForAllTy _ fvf tvs ltype)
-      = do_largs n leader' ltype
-      where
-        leader' = leader <+> ppForAll tvs unicode qual fvf
+      = do_largs n (leader <+> ppForAllPart unicode qual tvs fvf) ltype
 
     do_args n leader (HsQualTy _ lctxt ltype)
       | null (unLoc lctxt)
@@ -188,22 +186,6 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
     gadtOpen = toHtml "{"
 
 
-
-ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> ForallVisFlag
-         -> Html
-ppForAll tvs unicode qual fvf =
-  case [ppKTv n k | L _ (KindedTyVar _ (L _ n) k) <- tvs] of
-    [] -> noHtml
-    ts -> forallSymbol unicode <+> hsep ts +++ ppForAllSeparator unicode fvf
-  where ppKTv n k = parens $
-          ppTyName (getName n) <+> dcolon unicode <+> ppLKind unicode qual k
-
-ppForAllSeparator :: Unicode -> ForallVisFlag -> Html
-ppForAllSeparator unicode fvf =
-  case fvf of
-    ForallVis   -> spaceHtml +++ arrow unicode
-    ForallInvis -> dot
-
 ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
 ppFixities [] _ = noHtml
 ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
@@ -236,7 +218,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] (hsSigTypeI typ) fixities splice unicode pkg qual
+  = ppFunSig summary links loc noHtml doc [name] (hsSigTypeI typ) fixities splice unicode pkg qual
 ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
 
 
@@ -268,10 +250,6 @@ ppTypeSig summary nms pp_ty unicode =
     htmlNames = intersperse (stringToHtml ", ") $ map (ppBinder summary) nms
 
 
-ppTyName :: Name -> Html
-ppTyName = ppName Prefix
-
-
 ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan
             -> [DocName] -> HsType DocNameI
             -> Html
@@ -518,7 +496,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
                 -- ToDo: add associated type defaults
 
-            [ ppFunSig summary links loc doc names (hsSigTypeI typ)
+            [ ppFunSig summary links loc noHtml doc names (hsSigTypeI typ)
                        [] splice unicode pkg qual
               | L _ (ClassOpSig _ False lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
@@ -539,8 +517,9 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)
             -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI
             -> 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 })
+        decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname@(L _ nm)
+                        , tcdTyVars = ltyvars, 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
@@ -557,28 +536,63 @@ ppClassDecl summary links instances fixities loc d subdocs
     -- Only the fixity relevant to the class header
     fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
 
-    nm   = tcdName decl
-
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
-    -- ToDo: add assocatied typ defaults
-    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode 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] (hsSigTypeI 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 = unL . fdLName $ unL 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 (HsIB _ (FamEqn { feqn_rhs = typ
+                                           , feqn_tycon = L _ name
+                                           , feqn_pats = vs }))) <- atsDefs
+      ]
+
+    -- Methods
+    methodBit = subMethods
+      [ ppFunSig summary links loc noHtml doc [name] (hsSigTypeI 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] (hsSigTypeI 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] ==
@@ -587,7 +601,7 @@ ppClassDecl summary links instances fixities loc d subdocs
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (ClassOpSig _ _ ns _) <- lsigs, L _ n' <- ns]
+                        [getName n' | ClassOpSig _ _ ns _ <- sigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
@@ -602,6 +616,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
 
@@ -828,24 +843,23 @@ 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) args)
+          ( header_ <+> hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts) args)
           , noHtml
           , noHtml
           )
 
         -- Record constructor, e.g. 'Identity { runIdentity :: a }'
         RecCon (L _ fields) ->
-          ( header_ +++ ppOcc <+> char '{'
+          ( header_ <+> ppOcc <+> char '{'
           , shortSubDecls dataInst [ ppShortField summary unicode qual field
                                    | L _ field <- fields
                                    ]
@@ -854,7 +868,7 @@ ppShortConstrParts summary dataInst con unicode qual
 
         -- Infix constructor, e.g. 'a :| [a]'
         InfixCon arg1 arg2 ->
-          ( header_ +++ hsep [ ppLParendType unicode qual HideEmptyContexts arg1
+          ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts arg1
                              , ppOccInfix
                              , ppLParendType unicode qual HideEmptyContexts arg2
                              ]
@@ -902,28 +916,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
+          | hasArgDocs -> header_ <+> ppOcc <+> fixity
+          | otherwise -> hsep [ header_ <+> ppOcc
                               , hsep (map (ppLParendType unicode qual HideEmptyContexts) 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 arg1
+          | hasArgDocs -> header_ <+> ppOcc <+> fixity
+          | otherwise -> hsep [ header_ <+> ppLParendType unicode qual HideEmptyContexts arg1
                               , ppOccInfix
                               , ppLParendType unicode qual HideEmptyContexts arg2
                               , fixity
@@ -976,17 +989,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 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 tvs ForallInvis
 
     ppCtxt
       | null ctxt = noHtml
@@ -1159,10 +1172,14 @@ ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
 ppPatSigType unicode qual typ =
   let emptyCtxts = patSigContext typ in ppLType unicode qual emptyCtxts typ
 
-ppForAllPart :: Unicode -> Qualification -> ForallVisFlag -> [LHsTyVarBndr DocNameI] -> Html
-ppForAllPart unicode qual fvf tvs =
-  hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++
-  ppForAllSeparator unicode fvf
+
+ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> Html
+ppForAllPart unicode qual tvs fvf = hsep (forallSymbol unicode : tvs') +++ fv
+  where
+    tvs' = ppTyVars unicode qual tvs
+    fv = case fvf of
+           ForallVis   -> spaceHtml +++ arrow unicode
+           ForallInvis -> dot
 
 ppr_mono_lty :: LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
 ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
@@ -1170,7 +1187,7 @@ ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
 
 ppr_mono_ty :: HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
 ppr_mono_ty (HsForAllTy _ fvf tvs ty) unicode qual emptyCtxts
-  = ppForAllPart unicode qual fvf tvs <+> ppr_mono_lty ty unicode qual emptyCtxts
+  = ppForAllPart unicode qual tvs fvf <+> ppr_mono_lty ty unicode qual emptyCtxts
 
 ppr_mono_ty (HsQualTy _ ctxt ty) unicode qual emptyCtxts
   = ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts
@@ -1195,7 +1212,7 @@ 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
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 09aabc0c..edab4b16 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -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 25d8b07a..4535b897 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 574045e0..6a047747 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 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.