Merge commit '1e56f63c3197e7ca1c1e506e083c2bad25d08793' into ghc-9.0

27 files changed, 1167 insertions, 718 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index c5a0f772..c114e84d 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.Hoogle
@@ -37,8 +38,6 @@ import Data.Version
 import System.Directory
 import System.FilePath
 
-import GHC.Core.Multiplicity
-
 prefix :: [String]
 prefix = ["-- Hoogle documentation, generated by Haddock"
          ,"-- See Hoogle, http://www.haskell.org/hoogle/"
@@ -85,7 +84,7 @@ dropHsDocTy = f
         f (HsOpTy x a b c) = HsOpTy x (g a) b (g c)
         f (HsParTy x a) = HsParTy x (g a)
         f (HsKindSig x a b) = HsKindSig x (g a) b
-        f (HsDocTy _ a _) = f $ unL a
+        f (HsDocTy _ a _) = f $ unLoc a
         f x = x
 
 outHsType :: (OutputableBndrId p)
@@ -217,7 +216,7 @@ ppSynonym dflags x = [out dflags x]
 ppData :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
 ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
     = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=noLoc [] }} :
-      concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
+      concatMap (ppCtor dflags decl subdocs . unLoc) (dd_cons defn)
     where
 
         -- GHC gives out "data Bar =", we want to delete the equals.
@@ -253,7 +252,7 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
 
         -- We print the constructors as comma-separated list. See GHC
         -- docs for con_names on why it is a list to begin with.
-        name = commaSeparate dflags . map unL $ getConNames con
+        name = commaSeparate dflags . map unLoc $ getConNames con
 
         tyVarArg (UserTyVar _ _ n) = HsTyVar noExtField NotPromoted n
         tyVarArg (KindedTyVar _ _ n lty) = HsKindSig noExtField (reL (HsTyVar noExtField NotPromoted n)) lty
@@ -268,8 +267,8 @@ ppCtor dflags _dat subdocs con@(ConDeclGADT { })
     where
         f = [typeSig name (getGADTConTypeG con)]
 
-        typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty)
-        name = out dflags $ map unL $ getConNames con
+        typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unLoc ty)
+        name = out dflags $ map unLoc $ getConNames con
 
 ppFixity :: DynFlags -> (Name, Fixity) -> [String]
 ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExtField [noLoc name] fixity) :: FixitySig GhcRn)]
@@ -298,7 +297,7 @@ docWith dflags header d
 mkSubdoc :: DynFlags -> Located Name -> [(Name, DocForDecl Name)] -> [String] -> [String]
 mkSubdoc dflags n subdocs s = concatMap (ppDocumentation dflags) getDoc ++ s
  where
-   getDoc = maybe [] (return . fst) (lookup (unL n) subdocs)
+   getDoc = maybe [] (return . fst) (lookup (unLoc n) subdocs)
 
 data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String
            deriving Show
@@ -325,7 +324,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 d315ced0..6ef07434 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,8 +18,9 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 
-import GHC.Iface.Ext.Types  ( HieFile(..), HieASTs(..) )
+import GHC.Iface.Ext.Types  ( HieFile(..), HieASTs(..), HieAST(..), NodeInfo(..), SourcedNodeInfo(..) )
 import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result, NameCacheUpdater(..))
+import GHC.Types.SrcLoc     ( realSrcLocSpan, mkRealSrcLoc )
 import Data.Map as M
 import GHC.Data.FastString     ( mkFastString )
 import GHC.Unit.Module         ( Module, moduleName )
@@ -32,27 +33,28 @@ import GHC.Types.Unique.Supply ( 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'
@@ -66,25 +68,33 @@ ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
                  <$> (readHieFile ncu 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)
 
+    emptyHieAst fileFs = Node
+      { nodeSpan = realSrcLocSpan (mkRealSrcLoc fileFs 1 0)
+      , nodeChildren = []
+      , sourcedNodeInfo = SourcedNodeInfo mempty
+      }
+
 -- | 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 5fd040a8..3db3c685 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Haddock.Backends.Hyperlinker.Parser (parse) where
 
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Class
 import Control.Applicative ( Alternative(..) )
-import Control.Monad.Trans.Maybe ( MaybeT(..) )
-import Control.Monad.Trans.Class ( MonadTrans(lift) )
 import Data.List           ( isPrefixOf, isSuffixOf )
 
 import qualified Data.ByteString as BS
@@ -274,6 +275,7 @@ classify tok =
     ITdot                  -> TkOperator
     ITstar              {} -> TkOperator
     ITtypeApp              -> TkGlyph
+    ITpercent              -> TkGlyph
 
     ITbiglam               -> TkGlyph
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index ce5ff11c..b093b5a4 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 badb1914..df81fd6e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -39,9 +39,9 @@ import System.FilePath
 import Data.Char
 import Control.Monad
 import Data.Maybe
-import Data.List
+import Data.List            ( sort )
+import Data.Void            ( absurd )
 import Prelude hiding ((<>))
-import GHC.Core.Multiplicity
 
 import Haddock.Doc (combineDocumentation)
 
@@ -105,6 +105,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
@@ -158,7 +162,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"
@@ -173,7 +177,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
@@ -289,7 +293,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
@@ -297,7 +301,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
@@ -309,7 +313,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"
 
@@ -319,13 +323,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
@@ -337,6 +342,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,21 +362,25 @@ ppFamDecl doc instances decl unicode =
 
 -- | Print the LHS of a type\/data family declaration.
 ppFamHeader :: FamilyDecl DocNameI  -- ^ family header to print
-              -> Bool                 -- ^ unicode
-              -> LaTeX
+            -> Bool                 -- ^ unicode
+            -> Bool                 -- ^ is the family associated?
+            -> LaTeX
 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
@@ -412,17 +422,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
@@ -431,15 +447,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.
@@ -459,7 +467,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
@@ -481,8 +489,9 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ
               <+> 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 _ _w (L _ (HsRecTy _ fields)) r)
       = [ (decltt ldr, latex <+> nl)
@@ -501,9 +510,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 '{'
 
 
 ppTypeSig :: [Name] -> HsType DocNameI  -> Bool -> LaTeX
@@ -533,10 +542,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}"
 
 
@@ -547,9 +555,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}"
 
@@ -593,6 +601,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
@@ -613,18 +622,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 = unLoc . 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
 
@@ -643,6 +662,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
@@ -725,15 +745,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 Specificity 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 = ppHsForAllTelescope (mkHsForAllInvisTeleI tvs) unicode
+
+    ppCtxt
+      | null ctxt = empty
+      | otherwise = ppContextNoArrow ctxt unicode <+> darrow unicode <> space
 
 
 -- | Pretty-print a constructor
@@ -762,11 +788,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'
@@ -774,7 +799,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
           | hasArgDocs -> header_ <+> ppOcc
           | otherwise -> hsep [ header_
                               , ppOcc
-                              , hsep (map ((ppLParendType unicode) . hsScaledThing) args)
+                              , hsep (map (ppLParendType unicode . hsScaledThing) args)
                               ]
 
         -- Record constructor, e.g. 'Identity { runIdentity :: a }'
@@ -1001,7 +1026,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
 
@@ -1033,7 +1058,6 @@ ppLKind unicode y = ppKind unicode (unLoc y)
 ppKind :: Bool -> HsKind DocNameI -> LaTeX
 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
 
@@ -1060,7 +1084,7 @@ 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 (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"
+ppr_mono_ty (HsSpliceTy v _)    _ = absurd v
 ppr_mono_ty (HsRecTy {})        _ = text "{..}"
 ppr_mono_ty (XHsType (NHsCoreTy {}))  _ = error "ppr_mono_ty HsCoreTy"
 ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
@@ -1086,7 +1110,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)
@@ -1120,9 +1144,6 @@ ppSymName name
   | otherwise = ppName name
 
 
-ppVerbOccName :: OccName -> LaTeX
-ppVerbOccName = text . latexFilter . occNameString
-
 ppIPName :: HsIPName -> LaTeX
 ppIPName = text . ('?':) . unpackFS . hsIPNameFS
 
@@ -1130,18 +1151,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
 
@@ -1179,9 +1191,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
 
 
 -------------------------------------------------------------------------------
@@ -1189,34 +1202,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
@@ -1229,6 +1248,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)
@@ -1245,35 +1267,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
@@ -1298,23 +1313,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
@@ -1322,8 +1337,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
@@ -1331,6 +1346,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.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 24b565fc..f8c22e0a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -295,6 +295,10 @@ ppHtmlContents state odir doctitle _maybe_package
           ]
   createDirectoryIfMissing True odir
   writeUtf8File (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
+  where
+    -- Extract a module's short description.
+    toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
+    toInstalledDescription = fmap mkMeta . hmi_description . instInfo
 
 
 ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
@@ -304,6 +308,7 @@ ppPrologue pkg qual title (Just doc) =
 
 
 ppSignatureTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
+ppSignatureTree _ _ [] = mempty
 ppSignatureTree pkg qual ts =
   divModuleList << (sectionName << "Signatures" +++ mkNodeList pkg qual [] "n" ts)
 
@@ -669,16 +674,22 @@ numberSectionHeadings = go 1
   where go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
         go _ [] = []
         go n (ExportGroup lev _ doc : es)
-          = ExportGroup lev (show n) doc : go (n+1) es
+          = case collectAnchors doc of
+              [] -> ExportGroup lev (show n) doc : go (n+1) es
+              (a:_) -> ExportGroup lev a doc : go (n+1) es
         go n (other:es)
           = other : go n es
 
+        collectAnchors :: DocH (Wrap (ModuleName, OccName)) (Wrap DocName) -> [String]
+        collectAnchors (DocAppend a b) = collectAnchors a ++ collectAnchors b
+        collectAnchors (DocAName a) = [a]
+        collectAnchors _ = []
 
 processExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification
               -> ExportItem DocNameI -> Maybe Html
 processExport _ _ _ _ _ ExportDecl { expItemDecl = L _ (InstD {}) } = Nothing -- Hide empty instances
 processExport summary _ _ pkg qual (ExportGroup lev id0 doc)
-  = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) pkg qual (mkMeta doc)
+  = nothingIf summary $ groupHeading lev id0 << docToHtmlNoAnchors (Just id0) pkg qual (mkMeta doc)
 processExport summary links unicode pkg qual (ExportDecl decl pats doc subdocs insts fixities splice)
   = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode pkg qual
 processExport summary _ _ _ qual (ExportNoDecl y [])
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6e210b61..eeb9fa94 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(..) )
@@ -41,7 +42,6 @@ import GHC.Exts
 import GHC.Types.Name
 import GHC.Data.BooleanFormula
 import GHC.Types.Name.Reader ( rdrNameOcc )
-import GHC.Core.Multiplicity
 
 -- | Pretty print a declaration
 ppDecl :: Bool                                     -- ^ print summary info only
@@ -76,14 +76,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
@@ -134,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.
@@ -155,7 +155,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
     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)
@@ -189,24 +189,6 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
     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
@@ -240,7 +222,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"
 
 
@@ -272,10 +254,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
@@ -519,7 +497,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
@@ -541,7 +519,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
@@ -562,24 +540,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] (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 = 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 (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] ==
@@ -603,6 +618,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
 
@@ -827,18 +843,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
           )
@@ -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 (hsScaledThing arg1)
+          ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1)
                              , ppOccInfix
                              , ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg2)
                              ]
@@ -901,28 +915,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
@@ -973,17 +986,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
@@ -1169,6 +1182,7 @@ ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
 ppPatSigType unicode qual typ =
   let emptyCtxts = patSigContext typ in ppLType unicode qual emptyCtxts typ
 
+
 ppForAllPart :: Unicode -> Qualification -> HsForAllTelescope DocNameI -> Html
 ppForAllPart unicode qual tele = case tele of
   HsForAllVis { hsf_vis_bndrs = bndrs } ->
@@ -1208,11 +1222,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.
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index d95337b8..980af379 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -35,7 +35,6 @@ import GHC.Types.Name
 import GHC.Types.Name.Set    ( emptyNameSet )
 import GHC.Types.Name.Reader ( mkVarUnqual )
 import GHC.Core.PatSyn
-import GHC.Types.SrcLoc ( Located, noLoc, unLoc, GenLocated(..), srcLocSpan )
 import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Core.Type
@@ -58,8 +57,6 @@ import Haddock.Types
 import Haddock.Interface.Specialize
 import Haddock.GhcUtils                      ( orderedFVs, defaultRuntimeRepVars )
 
-import GHC.Core.Multiplicity
-
 import Data.Maybe                            ( catMaybes, mapMaybe, maybeToList )
 
 
@@ -167,8 +164,7 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
   = let name            = synifyName tc
         args_types_only = filterOutInvisibleTypes tc args
         typats          = map (synifyType WithinType []) args_types_only
-        annot_typats    = zipWith3 annotHsType (mkIsPolyTvs fam_tvs)
-                                   args_types_only typats
+        annot_typats    = zipWith3 annotHsType args_poly args_types_only typats
         hs_rhs          = synifyType WithinType [] rhs
     in HsIB { hsib_ext = map tyVarName tkvs
             , hsib_body   = FamEqn { feqn_ext    = noExtField
@@ -179,7 +175,7 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
                                    , feqn_fixity = synifyFixity name
                                    , feqn_rhs    = hs_rhs } }
   where
-    fam_tvs = tyConVisibleTyVars tc
+    args_poly = tyConArgsPolyKinded tc
 
 synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GhcRn)
 synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
@@ -491,17 +487,26 @@ annotHsType True ty hs_ty
     in noLoc (HsKindSig noExtField hs_ty hs_ki)
 annotHsType _    _ hs_ty = hs_ty
 
--- | For every type variable in the input,
--- report whether or not the tv is poly-kinded. This is used to eventually
--- feed into 'annotHsType'.
-mkIsPolyTvs :: [TyVar] -> [Bool]
-mkIsPolyTvs = map is_poly_tv
+-- | For every argument type that a type constructor accepts,
+-- report whether or not the argument is poly-kinded. This is used to
+-- eventually feed into 'annotThType'.
+tyConArgsPolyKinded :: TyCon -> [Bool]
+tyConArgsPolyKinded tc =
+     map (is_poly_ty . tyVarKind)      tc_vis_tvs
+  ++ map (is_poly_ty . tyCoBinderType) tc_res_kind_vis_bndrs
+  ++ repeat True
   where
-    is_poly_tv tv = not $
+    is_poly_ty :: Type -> Bool
+    is_poly_ty ty = not $
                     isEmptyVarSet $
                     filterVarSet isTyVar $
-                    tyCoVarsOfType $
-                    tyVarKind tv
+                    tyCoVarsOfType ty
+
+    tc_vis_tvs :: [TyVar]
+    tc_vis_tvs = tyConVisibleTyVars tc
+
+    tc_res_kind_vis_bndrs :: [TyCoBinder]
+    tc_res_kind_vis_bndrs = filter isVisibleBinder $ fst $ splitPiTys $ tyConResKind tc
 
 --states of what to do with foralls:
 data SynifyTypeState
@@ -626,11 +631,14 @@ synifyType _ vs (TyConApp tc tys)
         in noLoc $ HsKindSig noExtField ty' full_kind'
       | otherwise = ty'
 
-synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1
-synifyType _ vs (AppTy t1 t2) = let
-  s1 = synifyType WithinType vs t1
-  s2 = synifyType WithinType vs t2
-  in noLoc $ HsAppTy noExtField s1 s2
+synifyType _ vs ty@(AppTy {}) = let
+  (ty_head, ty_args) = splitAppTys ty
+  ty_head' = synifyType WithinType vs ty_head
+  ty_args' = map (synifyType WithinType vs) $
+             filterOut isCoercionTy $
+             filterByList (map isVisibleArgFlag $ appTyArgFlags ty_head ty_args)
+                          ty_args
+  in foldl (\t1 t2 -> noLoc $ HsAppTy noExtField t1 t2) ty_head' ty_args'
 synifyType s vs funty@(FunTy InvisArg _ _ _) = synifySigmaType s vs funty
 synifyType _ vs       (FunTy VisArg w t1 t2) = let
   s1 = synifyType WithinType vs t1
@@ -822,8 +830,8 @@ synifyInstHead (vs, preds, cls, types) = specializeInstHead $ InstHead
     cls_tycon = classTyCon cls
     ts  = filterOutInvisibleTypes cls_tycon types
     ts' = map (synifyType WithinType vs) ts
-    annot_ts = zipWith3 annotHsType is_poly_tvs ts ts'
-    is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars cls_tycon)
+    annot_ts = zipWith3 annotHsType args_poly ts ts'
+    args_poly = tyConArgsPolyKinded cls_tycon
     synifyClsIdSig = synifyIdSig ShowRuntimeRep DeleteTopLevelQuantification vs
 
 -- Convert a family instance, this could be a type family or data family
@@ -862,8 +870,8 @@ synifyFamInst fi opaque = do
     ts = filterOutInvisibleTypes fam_tc eta_expanded_lhs
     synifyTypes = map (synifyType WithinType [])
     ts' = synifyTypes ts
-    annot_ts = zipWith3 annotHsType is_poly_tvs ts ts'
-    is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars fam_tc)
+    annot_ts = zipWith3 annotHsType args_poly ts ts'
+    args_poly = tyConArgsPolyKinded fam_tc
 
 {-
 Note [Invariant: Never expand type synonyms]
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 8b4bcc05..10725ee5 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -20,20 +21,19 @@ module Haddock.GhcUtils where
 
 import Control.Arrow
 import Data.Char ( isSpace )
+import Data.Maybe ( mapMaybe )
 
 import Haddock.Types( DocName, DocNameI )
 
-import GHC.Utils.Exception
 import GHC.Utils.FV as FV
 import GHC.Utils.Outputable ( Outputable, panic, showPpr )
+import GHC.Types.Basic (PromotionFlag(..))
 import GHC.Types.Name
-import GHC.Types.Name.Set
 import GHC.Unit.Module
 import GHC.Driver.Types
 import GHC
 import GHC.Core.Class
 import GHC.Driver.Session
-import GHC.Core.Multiplicity
 import GHC.Types.SrcLoc  ( advanceSrcLoc )
 import GHC.Types.Var     ( Specificity, VarBndr(..), TyVarBinder
                          , tyVarKind, updateTyVarKind, isInvisibleArgFlag )
@@ -122,6 +122,12 @@ pretty = showPpr
 -- These functions are duplicated from the GHC API, as they must be
 -- instantiated at DocNameI instead of (GhcPass _).
 
+-- | Like 'hsTyVarName' from GHC API, but not instantiated at (GhcPass _)
+hsTyVarBndrName :: (XXTyVarBndr n ~ NoExtCon) => HsTyVarBndr flag n -> IdP n
+hsTyVarBndrName (UserTyVar _ _ name) = unLoc name
+hsTyVarBndrName (KindedTyVar _ _ (L _ name) _) = name
+hsTyVarBndrName (XTyVarBndr nec) = noExtCon nec
+
 hsTyVarNameI :: HsTyVarBndr flag DocNameI -> DocName
 hsTyVarNameI (UserTyVar _ _ (L _ n))     = n
 hsTyVarNameI (KindedTyVar _ _ (L _ n) _) = n
@@ -234,6 +240,97 @@ getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG"
   -- Should only be called on ConDeclGADT
 
 
+mkEmptySigWcType :: LHsType GhcRn -> LHsSigWcType GhcRn
+-- Dubious, because the implicit binders are empty even
+-- though the type might have free varaiables
+mkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty)
+
+
+addClassContext :: Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn
+-- Add the class context to a class-op signature
+addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype))
+  = L pos (TypeSig noExtField lname (mkEmptySigWcType (go (hsSigType ltype))))
+          -- The mkEmptySigWcType is suspicious
+  where
+    go (L loc (HsForAllTy { hst_tele = tele, hst_body = ty }))
+       = L loc (HsForAllTy { hst_tele = tele, hst_xforall = noExtField
+                           , hst_body = go ty })
+    go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty }))
+       = L loc (HsQualTy { hst_xqual = noExtField
+                         , hst_ctxt = add_ctxt ctxt, hst_body = ty })
+    go (L loc ty)
+       = L loc (HsQualTy { hst_xqual = noExtField
+                         , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })
+
+    extra_pred :: LHsType GhcRn
+    extra_pred = nlHsTyConApp Prefix cls (map HsValArg (lHsQTyVarsToTypes tvs0))
+
+    add_ctxt :: LHsContext GhcRn -> LHsContext GhcRn
+    add_ctxt (L loc preds) = L loc (extra_pred : preds)
+
+addClassContext _ _ sig = sig   -- E.g. a MinimalSig is fine
+
+lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsType GhcRn]
+lHsQTyVarsToTypes tvs
+  = [ noLoc (HsTyVar noExtField NotPromoted (noLoc (hsLTyVarName tv)))
+    | tv <- hsQTvExplicit tvs ]
+
+
+--------------------------------------------------------------------------------
+-- * Making abstract declarations
+--------------------------------------------------------------------------------
+
+
+restrictTo :: [Name] -> LHsDecl GhcRn -> LHsDecl GhcRn
+restrictTo names (L loc decl) = L loc $ case decl of
+  TyClD x d | isDataDecl d  ->
+    TyClD x (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
+  TyClD x d | isClassDecl d ->
+    TyClD x (d { tcdSigs = restrictDecls names (tcdSigs d),
+               tcdATs = restrictATs names (tcdATs d) })
+  _ -> decl
+
+restrictDataDefn :: [Name] -> HsDataDefn GhcRn -> HsDataDefn GhcRn
+restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
+  | DataType <- new_or_data
+  = defn { dd_cons = restrictCons names cons }
+  | otherwise    -- Newtype
+  = case restrictCons names cons of
+      []    -> defn { dd_ND = DataType, dd_cons = [] }
+      [con] -> defn { dd_cons = [con] }
+      _ -> error "Should not happen"
+
+restrictCons :: [Name] -> [LConDecl GhcRn] -> [LConDecl GhcRn]
+restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
+  where
+    keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) =
+      case con_args d of
+        PrefixCon _ -> Just d
+        RecCon fields
+          | all field_avail (unLoc fields) -> Just d
+          | otherwise -> Just (d { con_args = PrefixCon (field_types $ unLoc fields) })
+          -- if we have *all* the field names available, then
+          -- keep the record declaration.  Otherwise degrade to
+          -- a constructor declaration.  This isn't quite right, but
+          -- it's the best we can do.
+        InfixCon _ _ -> Just d
+      where
+        field_avail :: LConDeclField GhcRn -> Bool
+        field_avail (L _ (ConDeclField _ fs _ _))
+            = all (\f -> extFieldOcc (unLoc f) `elem` names) fs
+
+        field_types flds = [ hsUnrestricted t | L _ (ConDeclField _ _ t _) <- flds ]
+
+    keep _ = Nothing
+
+restrictDecls :: [Name] -> [LSig GhcRn] -> [LSig GhcRn]
+restrictDecls names = mapMaybe (filterLSigNames (`elem` names))
+
+
+restrictATs :: [Name] -> [LFamilyDecl GhcRn] -> [LFamilyDecl GhcRn]
+restrictATs names ats = [ at | at <- ats , unLoc (fdLName (unLoc at)) `elem` names ]
+
+
 -------------------------------------------------------------------------------
 -- * Parenthesization
 -------------------------------------------------------------------------------
@@ -242,6 +339,8 @@ getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG"
 data Precedence
   = PREC_TOP  -- ^ precedence of 'type' production in GHC's parser
 
+  | PREC_SIG  -- ^ explicit type signature
+
   | PREC_CTX  -- ^ Used for single contexts, eg. ctx => type
               -- (as opposed to (ctx1, ctx2) => type)
 
@@ -268,18 +367,21 @@ reparenTypePrec = go
   go _ (HsBangTy x b ty)     = HsBangTy x b (reparenLType ty)
   go _ (HsTupleTy x con tys) = HsTupleTy x con (map reparenLType tys)
   go _ (HsSumTy x tys)       = HsSumTy x (map reparenLType tys)
-  go _ (HsKindSig x ty kind) = HsKindSig x (reparenLType ty) (reparenLType kind)
   go _ (HsListTy x ty)       = HsListTy x (reparenLType ty)
   go _ (HsRecTy x flds)      = HsRecTy x (map (fmap reparenConDeclField) flds)
   go p (HsDocTy x ty d)      = HsDocTy x (goL p ty) d
   go _ (HsExplicitListTy x p tys) = HsExplicitListTy x p (map reparenLType tys)
   go _ (HsExplicitTupleTy x tys) = HsExplicitTupleTy x (map reparenLType tys)
+  go p (HsKindSig x ty kind)
+    = paren p PREC_SIG $ HsKindSig x (goL PREC_SIG ty) (goL PREC_SIG kind)
   go p (HsIParamTy x n ty)
-    = paren p PREC_CTX $ HsIParamTy x n (reparenLType ty)
+    = paren p PREC_SIG $ HsIParamTy x n (reparenLType ty)
   go p (HsForAllTy x tele ty)
     = paren p PREC_CTX $ HsForAllTy x (reparenHsForAllTelescope tele) (reparenLType ty)
   go p (HsQualTy x ctxt ty)
-    = paren p PREC_FUN $ HsQualTy x (fmap (map reparenLType) ctxt) (reparenLType ty)
+    = let p' [_] = PREC_CTX
+          p' _   = PREC_TOP -- parens will get added anyways later...
+      in paren p PREC_CTX $ HsQualTy x (fmap (\xs -> map (goL (p' xs)) xs) ctxt) (goL PREC_TOP ty)
   go p (HsFunTy x w ty1 ty2)
     = paren p PREC_FUN $ HsFunTy x w (goL PREC_FUN ty1) (goL PREC_TOP ty2)
   go p (HsAppTy x fun_ty arg_ty)
@@ -370,17 +472,17 @@ class Parent a where
 instance Parent (ConDecl GhcRn) where
   children con =
     case con_args con of
-      RecCon fields -> map (extFieldOcc . unL) $
-                         concatMap (cd_fld_names . unL) (unL fields)
+      RecCon fields -> map (extFieldOcc . unLoc) $
+                         concatMap (cd_fld_names . unLoc) (unLoc fields)
       _             -> []
 
 instance Parent (TyClDecl GhcRn) where
   children d
-    | isDataDecl  d = map unL $ concatMap (getConNames . unL)
+    | isDataDecl  d = map unLoc $ concatMap (getConNames . unLoc)
                               $ (dd_cons . tcdDataDefn) $ d
     | isClassDecl d =
-        map (unL . fdLName . unL) (tcdATs d) ++
-        [ unL n | L _ (TypeSig _ ns _) <- tcdSigs d, n <- ns ]
+        map (unLoc . fdLName . unLoc) (tcdATs d) ++
+        [ unLoc n | L _ (TypeSig _ ns _) <- tcdSigs d, n <- ns ]
     | otherwise = []
 
 
@@ -390,13 +492,13 @@ family = getName &&& children
 
 
 familyConDecl :: ConDecl GHC.GhcRn -> [(Name, [Name])]
-familyConDecl d = zip (map unL (getConNames d)) (repeat $ children d)
+familyConDecl d = zip (map unLoc (getConNames d)) (repeat $ children d)
 
 -- | A mapping from the parent (main-binder) to its children and from each
 -- child to its grand-children, recursively.
 families :: TyClDecl GhcRn -> [(Name, [Name])]
 families d
-  | isDataDecl  d = family d : concatMap (familyConDecl . unL) (dd_cons (tcdDataDefn d))
+  | isDataDecl  d = family d : concatMap (familyConDecl . unLoc) (dd_cons (tcdDataDefn d))
   | isClassDecl d = [family d]
   | otherwise     = []
 
@@ -436,17 +538,16 @@ minimalDef n = do
 -- * DynFlags
 -------------------------------------------------------------------------------
 
-
-setObjectDir, setHiDir, setHieDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags
-setObjectDir  f d = d{ objectDir  = Just f}
-setHiDir      f d = d{ hiDir      = Just f}
-setHieDir     f d = d{ hieDir     = Just f}
-setStubDir    f d = d{ stubDir    = Just f
-                     , includePaths = addGlobalInclude (includePaths d) [f] }
-  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-  -- \#included from the .hc file when compiling with -fvia-C.
-setOutputDir  f = setObjectDir f . setHiDir f . setHieDir f . setStubDir f
-
+-- TODO: use `setOutputDir` from GHC
+setOutputDir :: FilePath -> DynFlags -> DynFlags
+setOutputDir dir dynFlags =
+  dynFlags { objectDir    = Just dir
+           , hiDir        = Just dir
+           , hieDir       = Just dir
+           , stubDir      = Just dir
+           , includePaths = addGlobalInclude (includePaths dynFlags) [dir]
+           , dumpDir      = Just dir
+           }
 
 -------------------------------------------------------------------------------
 -- * 'StringBuffer' and 'ByteString'
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index fa20b836..1501919b 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -43,11 +43,11 @@ import Haddock.Types
 import Haddock.Utils
 
 import Control.Monad
+import Control.Monad.IO.Class ( liftIO )
 import Control.Exception (evaluate)
-import Data.List
+import Data.List (foldl', isPrefixOf, nub)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Distribution.Verbosity
 import Text.Printf
 
 import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
@@ -62,6 +62,7 @@ import GHC.Types.Name.Occurrence (isTcOcc)
 import GHC.Types.Name.Reader (unQualOK, gre_name, globalRdrEnvElts)
 import GHC.Utils.Error (withTimingD)
 import GHC.HsToCore.Docs
+import GHC.Runtime.Loader (initializePlugins)
 
 #if defined(mingw32_HOST_OS)
 import System.IO
@@ -111,7 +112,7 @@ processModules verbosity modules flags extIfaces = do
   let warnings = Flag_NoWarnings `notElem` flags
   dflags <- getDynFlags
   let (interfaces'', msgs) =
-         runWriter $ mapM (renameInterface dflags links warnings) interfaces'
+         runWriter $ mapM (renameInterface dflags (ignoredSymbols flags) links warnings) interfaces'
   liftIO $ mapM_ putStrLn msgs
 
   return (interfaces'', homeLinks)
@@ -151,7 +152,13 @@ createIfaces verbosity modules flags instIfaceMap = do
 processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe (Interface, ModuleSet))
 processModule verbosity modsum flags modMap instIfaceMap = do
   out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
-  tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum
+
+  -- Since GHC 8.6, plugins are initialized on a per module basis
+  hsc_env' <- getSession
+  dynflags' <- liftIO (initializePlugins hsc_env' (GHC.ms_hspp_opts modsum))
+  let modsum' = modsum { ms_hspp_opts = dynflags' }
+
+  tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum'
 
   case isBootSummary modsum of
     IsBoot ->
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 0840bd77..6ef0ed19 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE MagicHash, BangPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.AttachInstances
@@ -17,11 +19,10 @@ module Haddock.Interface.AttachInstances (attachInstances) where
 
 import Haddock.Types
 import Haddock.Convert
-import Haddock.GhcUtils
 
 import Control.Applicative ((<|>))
 import Control.Arrow hiding ((<+>))
-import Data.List
+import Data.List (sortBy)
 import Data.Ord (comparing)
 import Data.Maybe ( maybeToList, mapMaybe, fromMaybe )
 import qualified Data.Map as Map
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index dd9419eb..7fb71d4b 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -31,12 +31,13 @@ import Haddock.Interface.LexParseRn
 import Data.Bifunctor
 import Data.Bitraversable
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Data.Map (Map)
-import Data.List
+import Data.List (find, foldl')
 import Data.Maybe
-import Control.Applicative
 import Control.Monad
 import Data.Traversable
+import GHC.Stack (HasCallStack)
 
 import GHC.Types.Avail hiding (avail)
 import qualified GHC.Types.Avail  as Avail
@@ -49,7 +50,6 @@ import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
 import GHC.Unit.State
-import GHC.Data.Bag
 import GHC.Types.Name.Reader
 import GHC.Tc.Types
 import GHC.Data.FastString ( unpackFS, bytesFS )
@@ -58,16 +58,21 @@ import qualified GHC.Utils.Outputable as O
 import GHC.HsToCore.Docs hiding (mkMaps)
 import GHC.Parser.Annotation (IsUnicodeSyntax(..))
 
+mkExceptionContext :: TypecheckedModule -> String
+mkExceptionContext =
+  ("creating Haddock interface for " ++) . moduleNameString . ms_mod_name . pm_mod_summary . tm_parsed_module
 
 -- | Use a 'TypecheckedModule' to produce an 'Interface'.
 -- To do this, we need access to already processed modules in the topological
 -- sort. That's what's in the 'IfaceMap'.
-createInterface :: TypecheckedModule
+createInterface :: HasCallStack
+                => TypecheckedModule
                 -> [Flag]       -- Boolean flags
                 -> IfaceMap     -- Locally processed modules
                 -> InstIfaceMap -- External, already installed interfaces
                 -> ErrMsgGhc Interface
-createInterface tm flags modMap instIfaceMap = do
+createInterface tm flags modMap instIfaceMap =
+ withExceptionContext (mkExceptionContext tm) $ do
 
   let ms             = pm_mod_summary . tm_parsed_module $ tm
       mi             = moduleInfo tm
@@ -85,8 +90,9 @@ createInterface tm flags modMap instIfaceMap = do
 
       (TcGblEnv { tcg_rdr_env = gre
                 , tcg_warns   = warnings
-                , tcg_exports = all_exports
+                , tcg_exports = all_exports0
                 }, md) = tm_internals_ tm
+      all_local_avails = gresToAvailInfo . filter isLocalGRE . globalRdrEnvElts $ gre
 
   -- The 'pkgName' is necessary to decide what package to mention in "@since"
   -- annotations. Not having it is not fatal though.
@@ -113,9 +119,9 @@ createInterface tm flags modMap instIfaceMap = do
   let declsWithDocs = topDecls group_
 
       exports0 = fmap (map (first unLoc)) mayExports
-      exports
-        | OptIgnoreExports `elem` opts = Nothing
-        | otherwise = exports0
+      (all_exports, exports)
+        | OptIgnoreExports `elem` opts = (all_local_avails, Nothing)
+        | otherwise = (all_exports0, exports0)
 
       unrestrictedImportedMods
         -- module re-exports are only possible with
@@ -127,8 +133,8 @@ createInterface tm flags modMap instIfaceMap = do
       fixMap = mkFixMap group_
       (decls, _) = unzip declsWithDocs
       localInsts = filter (nameIsLocalOrFrom sem_mdl)
-                        $  map getName instances
-                        ++ map getName fam_instances
+                        $  map getName fam_instances
+                        ++ map getName instances
       -- Locations of all TH splices
       splices = [ l | L l (SpliceD _ _) <- hsmodDecls hsm ]
 
@@ -165,6 +171,18 @@ createInterface tm flags modMap instIfaceMap = do
 
   modWarn <- liftErrMsg (moduleWarning dflags gre warnings)
 
+  -- Prune the docstring 'Map's to keep only docstrings that are not private.
+  --
+  -- Besides all the names that GHC has told us this module exports, we also
+  -- keep the docs for locally defined class instances. This is more names than
+  -- we need, but figuring out which instances are fully private is tricky.
+  --
+  -- We do this pruning to avoid having to rename, emit warnings, and save
+  -- docstrings which will anyways never be rendered.
+  let !localVisibleNames = S.fromList (localInsts ++ exportedNames)
+      !prunedDocMap = M.restrictKeys docMap localVisibleNames
+      !prunedArgMap = M.restrictKeys argMap localVisibleNames
+
   return $! Interface {
     ifaceMod               = mdl
   , ifaceIsSig             = is_sig
@@ -173,12 +191,12 @@ createInterface tm flags modMap instIfaceMap = do
   , ifaceDoc               = Documentation mbDoc modWarn
   , ifaceRnDoc             = Documentation Nothing Nothing
   , ifaceOptions           = opts
-  , ifaceDocMap            = docMap
-  , ifaceArgMap            = argMap
-  , ifaceRnDocMap          = M.empty
-  , ifaceRnArgMap          = M.empty
+  , ifaceDocMap            = prunedDocMap
+  , ifaceArgMap            = prunedArgMap
+  , ifaceRnDocMap          = M.empty -- Filled in `renameInterface`
+  , ifaceRnArgMap          = M.empty -- Filled in `renameInterface`
   , ifaceExportItems       = prunedExportItems
-  , ifaceRnExportItems     = []
+  , ifaceRnExportItems     = [] -- Filled in `renameInterface`
   , ifaceExports           = exportedNames
   , ifaceVisibleExports    = visibleNames
   , ifaceDeclMap           = declMap
@@ -452,7 +470,8 @@ mkFixMap group_ =
 -- We create the export items even if the module is hidden, since they
 -- might be useful when creating the export items for other modules.
 mkExportItems
-  :: Bool               -- is it a signature
+  :: HasCallStack
+  => Bool               -- is it a signature
   -> IfaceMap
   -> Maybe Package      -- this package
   -> Module             -- this module
@@ -490,7 +509,7 @@ mkExportItems
       return [ExportDoc doc]
 
     lookupExport (IEDocNamed _ str, _)      = liftErrMsg $
-      findNamedDoc str [ unL d | d <- decls ] >>= \case
+      findNamedDoc str [ unLoc d | d <- decls ] >>= \case
         Nothing -> return  []
         Just docStr -> do
           doc <- processDocStringParas dflags pkgName gre docStr
@@ -511,7 +530,8 @@ mkExportItems
       availExportItem is_sig modMap thisMod semMod warnings exportedNames
         maps fixMap splices instIfaceMap dflags avail
 
-availExportItem :: Bool               -- is it a signature
+availExportItem :: HasCallStack
+                => Bool               -- is it a signature
                 -> IfaceMap
                 -> Module             -- this module
                 -> Module             -- semantic module
@@ -538,13 +558,13 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
           export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap
           return [export]
         (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->
-          let declNames = getMainDeclBinder (unL decl)
+          let declNames = getMainDeclBinder (unLoc decl)
           in case () of
             _
               -- We should not show a subordinate by itself if any of its
               -- parents is also exported. See note [1].
               | t `notElem` declNames,
-                Just p <- find isExported (parents t $ unL decl) ->
+                Just p <- find isExported (parents t $ unLoc decl) ->
                 do liftErrMsg $ tell [
                      "Warning: " ++ moduleString thisMod ++ ": " ++
                      pretty dflags (nameOccName t) ++ " is exported separately but " ++
@@ -593,11 +613,24 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
 
         _ -> return []
 
-    availExportDecl :: AvailInfo -> LHsDecl GhcRn
+    -- Tries 'extractDecl' first then falls back to 'hiDecl' if that fails
+    availDecl :: Name -> LHsDecl GhcRn -> ErrMsgGhc (LHsDecl GhcRn)
+    availDecl declName parentDecl =
+      case extractDecl declMap declName parentDecl of
+        Right d -> pure d
+        Left err -> do
+          synifiedDeclOpt <- hiDecl dflags declName
+          case synifiedDeclOpt of
+            Just synifiedDecl -> pure synifiedDecl
+            Nothing -> O.pprPanic "availExportItem" (O.text err)
+
+    availExportDecl :: HasCallStack => AvailInfo -> LHsDecl GhcRn
                     -> (DocForDecl Name, [(Name, DocForDecl Name)])
                     -> ErrMsgGhc [ ExportItem GhcRn ]
     availExportDecl avail decl (doc, subs)
       | availExportsDecl avail = do
+          extractedDecl <- availDecl (availName avail) decl
+
           -- bundled pattern synonyms only make sense if the declaration is
           -- exported (otherwise there would be nothing to bundle to)
           bundledPatSyns <- findBundledPatterns avail
@@ -613,8 +646,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
                 ]
 
           return [ ExportDecl {
-                       expItemDecl      = restrictTo (fmap fst subs)
-                                            (extractDecl declMap (availName avail) decl)
+                       expItemDecl      = restrictTo (fmap fst subs) extractedDecl
                      , expItemPats      = bundledPatSyns
                      , expItemMbDoc     = doc
                      , expItemSubDocs   = subs
@@ -624,18 +656,18 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
                      }
                  ]
 
-      | otherwise =
-          return [ ExportDecl {
-                       expItemDecl      = extractDecl declMap sub decl
+      | otherwise = for subs $ \(sub, sub_doc) -> do
+          extractedDecl <- availDecl sub decl
+
+          return ( ExportDecl {
+                       expItemDecl      = extractedDecl
                      , expItemPats      = []
                      , expItemMbDoc     = sub_doc
                      , expItemSubDocs   = []
                      , expItemInstances = []
                      , expItemFixities  = [ (sub, f) | Just f <- [M.lookup sub fixMap] ]
                      , expItemSpliced   = False
-                     }
-                 | (sub, sub_doc) <- subs
-                 ]
+                     } )
 
     exportedNameSet = mkNameSet exportedNames
     isExported n = elemNameSet n exportedNameSet
@@ -710,6 +742,7 @@ semToIdMod this_uid m
     | Module.isHoleModule m = mkModule this_uid (moduleName m)
     | otherwise             = m
 
+-- | Reify a declaration from the GHC internal 'TyThing' representation.
 hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))
 hiDecl dflags t = do
   mayTyThing <- liftGhcToErrMsgGhc $ lookupName t
@@ -852,20 +885,31 @@ fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNam
     isSigD (L _ SigD{}) = True
     isSigD _            = False
 
+
 -- | Sometimes the declaration we want to export is not the "main" declaration:
 -- it might be an individual record selector or a class method.  In these
 -- cases we have to extract the required declaration (and somehow cobble
 -- together a type signature for it...).
-extractDecl :: DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn
+--
+-- This function looks through the declarations in this module to try to find
+-- the one with the right name.
+extractDecl
+  :: HasCallStack
+  => DeclMap                   -- ^ all declarations in the file
+  -> Name                      -- ^ name of the declaration to extract
+  -> LHsDecl GhcRn             -- ^ parent declaration
+  -> Either ErrMsg (LHsDecl GhcRn)
 extractDecl declMap name decl
-  | name `elem` getMainDeclBinder (unLoc decl) = decl
+  | name `elem` getMainDeclBinder (unLoc decl) = pure decl
   | otherwise  =
     case unLoc decl of
-      TyClD _ d@ClassDecl {} ->
+      TyClD _ d@ClassDecl { tcdLName = L _ clsNm
+                          , tcdSigs = clsSigs
+                          , tcdATs = clsATs } ->
         let
           matchesMethod =
             [ lsig
-            | lsig <- tcdSigs d
+            | lsig <- clsSigs
             , ClassOpSig _ False _ _ <- pure $ unLoc lsig
               -- Note: exclude `default` declarations (see #505)
             , name `elem` sigName lsig
@@ -873,51 +917,54 @@ extractDecl declMap name decl
 
           matchesAssociatedType =
             [ lfam_decl
-            | lfam_decl <- tcdATs d
+            | lfam_decl <- clsATs
             , name == unLoc (fdLName (unLoc lfam_decl))
             ]
 
             -- TODO: document fixity
         in case (matchesMethod, matchesAssociatedType)  of
-          ([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)
-                           L pos sig = addClassContext n tyvar_names s0
-                       in L pos (SigD noExtField sig)
-          (_, [L pos fam_decl]) -> L pos (TyClD noExtField (FamDecl noExtField fam_decl))
+          ([s0], _) -> let tyvar_names = tyClDeclTyVars d
+                           L pos sig = addClassContext clsNm tyvar_names s0
+                       in pure (L pos (SigD noExtField sig))
+          (_, [L pos fam_decl]) -> pure (L pos (TyClD noExtField (FamDecl noExtField fam_decl)))
 
           ([], [])
             | Just (famInstDecl:_) <- M.lookup name declMap
             -> extractDecl declMap name famInstDecl
-          _ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
-                                         O.$$ O.nest 4 (O.ppr d)
-                                         O.$$ O.text "Matches:"
-                                         O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType))
-      TyClD _ d@DataDecl {} ->
-        let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
-        in if isDataConName name
-           then SigD noExtField <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
-           else SigD noExtField <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
+          _ -> Left (concat [ "Ambiguous decl for ", getOccString name
+                            , " in class ", getOccString clsNm ])
+
+      TyClD _ d@DataDecl { tcdLName = L _ dataNm
+                         , tcdDataDefn = HsDataDefn { dd_cons = dataCons } } -> do
+        let ty_args = map HsValArg (lHsQTyVarsToTypes (tyClDeclTyVars d))
+        lsig <- if isDataConName name
+                  then extractPatternSyn name dataNm ty_args dataCons
+                  else extractRecSel name dataNm ty_args dataCons
+        pure (SigD noExtField <$> lsig)
+
       TyClD _ FamDecl {}
         | isValName name
         , Just (famInst:_) <- M.lookup name declMap
         -> extractDecl declMap name famInst
       InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body =
-                             FamEqn { feqn_tycon = L _ n
-                                    , feqn_pats  = tys
-                                    , feqn_rhs   = defn }}))) ->
-        if isDataConName name
-        then SigD noExtField <$> extractPatternSyn name n tys (dd_cons defn)
-        else SigD noExtField <$> extractRecSel name n tys (dd_cons defn)
+          FamEqn { feqn_tycon = L _ famName
+                 , feqn_pats  = ty_args
+                 , feqn_rhs   = HsDataDefn { dd_cons = dataCons } }}))) -> do
+        lsig <- if isDataConName name
+                  then extractPatternSyn name famName ty_args dataCons
+                  else extractRecSel name famName ty_args dataCons
+        pure (SigD noExtField <$> lsig)
       InstD _ (ClsInstD _ ClsInstDecl { cid_datafam_insts = insts })
         | isDataConName name ->
             let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body =
-                                          FamEqn { feqn_rhs   = dd
+                                          FamEqn { feqn_rhs   = HsDataDefn { dd_cons = dataCons }
                                                  }
                                          })) <- insts
-                               , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))
+                               , name `elem` map unLoc (concatMap (getConNames . unLoc) dataCons)
                                ]
             in case matches of
                 [d0] -> extractDecl declMap name (noLoc (InstD noExtField (DataFamInstD noExtField d0)))
-                _    -> error "internal: extractDecl (ClsInstD)"
+                _    -> Left "internal: extractDecl (ClsInstD)"
         | otherwise ->
             let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
                                    <- insts
@@ -929,16 +976,15 @@ extractDecl declMap name decl
                           ]
             in case matches of
               [d0] -> extractDecl declMap name (noLoc . InstD noExtField $ DataFamInstD noExtField d0)
-              _ -> error "internal: extractDecl (ClsInstD)"
-      _ -> O.pprPanic "extractDecl" $
-        O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":"
-        O.$$ O.nest 4 (O.ppr decl)
+              _ -> Left "internal: extractDecl (ClsInstD)"
+      _ -> Left ("extractDecl: Unhandled decl for " ++ getOccString name)
 
-extractPatternSyn :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn
+extractPatternSyn :: HasCallStack => Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> Either ErrMsg (LSig GhcRn)
 extractPatternSyn nm t tvs cons =
   case filter matches cons of
-    [] -> error "extractPatternSyn: constructor pattern not found"
-    con:_ -> extract <$> con
+    [] -> Left . O.showSDocUnsafe $
+          O.text "constructor pattern " O.<+> O.ppr nm O.<+> O.text "not found in type" O.<+> O.ppr t
+    con:_ -> pure (extract <$> con)
  where
   matches :: LConDecl GhcRn -> Bool
   matches (L _ con) = nm `elem` (unLoc <$> getConNames con)
@@ -969,13 +1015,13 @@ extractPatternSyn nm t tvs cons =
                           mkAppTyArg f (HsArgPar _) = HsParTy noExtField f
 
 extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn]
-              -> LSig GhcRn
-extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
+              -> Either ErrMsg (LSig GhcRn)
+extractRecSel _ _ _ [] = Left "extractRecSel: selector not found"
 
 extractRecSel nm t tvs (L _ con : rest) =
   case getConArgs con of
     RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
-      L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) data_ty (getBangType ty)))))
+      pure (L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) data_ty (getBangType ty))))))
     _ -> extractRecSel nm t tvs rest
  where
   matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs
index 043a1530..4e271602 100644
--- a/haddock-api/src/Haddock/Interface/Json.hs
+++ b/haddock-api/src/Haddock/Interface/Json.hs
@@ -13,7 +13,6 @@ import GHC.Utils.Outputable
 
 import Control.Arrow
 import Data.Map (Map)
-import Data.Bifunctor
 import qualified Data.Map as Map
 
 import Haddock.Types
@@ -58,11 +57,172 @@ jsonMap f g = jsonObject . map (f *** g) . Map.toList
 jsonMDoc :: MDoc Name -> JsonDoc
 jsonMDoc MetaDoc{..} =
   jsonObject [ ("meta", jsonObject [("version", jsonMaybe (jsonString . show) (_version _meta))])
-             , ("doc",  jsonDoc _doc)
+             , ("document",  jsonDoc _doc)
              ]
 
+showModName :: Wrap (ModuleName, OccName) -> String
+showModName = showWrapped (moduleNameString . fst)
+
+showName :: Wrap Name -> String
+showName = showWrapped nameStableString
+
+
 jsonDoc :: Doc Name -> JsonDoc
-jsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc))
+
+jsonDoc DocEmpty = jsonObject
+    [ ("tag", jsonString "DocEmpty") ]
+
+jsonDoc (DocAppend x y) = jsonObject
+    [ ("tag", jsonString "DocAppend")
+    , ("first", jsonDoc x)
+    , ("second", jsonDoc y)
+    ]
+
+jsonDoc (DocString s) = jsonObject
+    [ ("tag", jsonString "DocString")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocParagraph x) = jsonObject
+    [ ("tag", jsonString "DocParagraph")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocIdentifier name) = jsonObject
+    [ ("tag", jsonString "DocIdentifier")
+    , ("name", jsonString (showName name))
+    ]
+
+jsonDoc (DocIdentifierUnchecked modName) = jsonObject
+    [ ("tag", jsonString "DocIdentifierUnchecked")
+    , ("modName", jsonString (showModName modName))
+    ]
+
+jsonDoc (DocModule s) = jsonObject
+    [ ("tag", jsonString "DocModule")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocWarning x) = jsonObject
+    [ ("tag", jsonString "DocWarning")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocEmphasis x) = jsonObject
+    [ ("tag", jsonString "DocEmphasis")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocMonospaced x) = jsonObject
+    [ ("tag", jsonString "DocMonospaced")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocBold x) = jsonObject
+    [ ("tag", jsonString "DocBold")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocUnorderedList xs) = jsonObject
+    [ ("tag", jsonString "DocUnorderedList")
+    , ("documents", jsonArray (fmap jsonDoc xs))
+    ]
+
+jsonDoc (DocOrderedList xs) = jsonObject
+    [ ("tag", jsonString "DocOrderedList")
+    , ("documents", jsonArray (fmap jsonDoc xs))
+    ]
+
+jsonDoc (DocDefList xys) = jsonObject
+    [ ("tag", jsonString "DocDefList")
+    , ("definitions", jsonArray (fmap jsonDef xys))
+    ]
+  where
+    jsonDef (x, y) = jsonObject [("document", jsonDoc x), ("y", jsonDoc y)]
+
+jsonDoc (DocCodeBlock x) = jsonObject
+    [ ("tag", jsonString "DocCodeBlock")
+    , ("document", jsonDoc x)
+    ]
+
+jsonDoc (DocHyperlink hyperlink) = jsonObject
+    [ ("tag", jsonString "DocHyperlink")
+    , ("hyperlink", jsonHyperlink hyperlink)
+    ]
+  where
+    jsonHyperlink Hyperlink{..} = jsonObject
+        [ ("hyperlinkUrl", jsonString hyperlinkUrl)
+        , ("hyperlinkLabel", jsonMaybe jsonDoc hyperlinkLabel)
+        ]
+
+jsonDoc (DocPic picture) = jsonObject
+    [ ("tag", jsonString "DocPic")
+    , ("picture", jsonPicture picture)
+    ]
+  where
+    jsonPicture Picture{..} = jsonObject
+        [ ("pictureUrl", jsonString pictureUri)
+        , ("pictureLabel", jsonMaybe jsonString pictureTitle)
+        ]
+
+jsonDoc (DocMathInline s) = jsonObject
+    [ ("tag", jsonString "DocMathInline")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocMathDisplay s) = jsonObject
+    [ ("tag", jsonString "DocMathDisplay")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocAName s) = jsonObject
+    [ ("tag", jsonString "DocAName")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocProperty s) = jsonObject
+    [ ("tag", jsonString "DocProperty")
+    , ("string", jsonString s)
+    ]
+
+jsonDoc (DocExamples examples) = jsonObject
+    [ ("tag", jsonString "DocExamples")
+    , ("examples", jsonArray (fmap jsonExample examples))
+    ]
+  where
+    jsonExample Example{..} = jsonObject
+        [ ("exampleExpression", jsonString exampleExpression)
+        , ("exampleResult", jsonArray (fmap jsonString exampleResult))
+        ]
+
+jsonDoc (DocHeader header) = jsonObject
+    [ ("tag", jsonString "DocHeader")
+    , ("header", jsonHeader header)
+    ]
+  where
+    jsonHeader Header{..} = jsonObject
+        [ ("headerLevel", jsonInt headerLevel)
+        , ("headerTitle", jsonDoc headerTitle)
+        ]
+
+jsonDoc (DocTable table) = jsonObject
+    [ ("tag", jsonString "DocTable")
+    , ("table", jsonTable table)
+    ]
+  where
+    jsonTable Table{..} = jsonObject
+        [ ("tableHeaderRows", jsonArray (fmap jsonTableRow tableHeaderRows))
+        , ("tableBodyRows", jsonArray (fmap jsonTableRow tableBodyRows))
+        ]
+
+    jsonTableRow TableRow{..} = jsonArray (fmap jsonTableCell tableRowCells)
+
+    jsonTableCell TableCell{..} = jsonObject
+        [ ("tableCellColspan", jsonInt tableCellColspan)
+        , ("tableCellRowspan", jsonInt tableCellRowspan)
+        , ("tableCellContents", jsonDoc tableCellContents)
+        ]
+
 
 jsonModule :: Module -> JsonDoc
 jsonModule = JSString . moduleStableString
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 2b03ecfa..d1d6bb31 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -19,10 +19,10 @@ module Haddock.Interface.LexParseRn
   , processModuleHeader
   ) where
 
-import GHC.Types.Avail
 import Control.Arrow
 import Control.Monad
-import Data.List
+import Data.Functor (($>))
+import Data.List (maximumBy, (\\))
 import Data.Ord
 import Documentation.Haddock.Doc (metaDocConcat)
 import GHC.Driver.Session (languageExtensions)
@@ -32,10 +32,10 @@ import Haddock.Interface.ParseModuleHeader
 import Haddock.Parser
 import Haddock.Types
 import GHC.Types.Name
+import GHC.Parser.PostProcess
 import GHC.Utils.Outputable ( showPpr, showSDoc )
 import GHC.Types.Name.Reader
 import GHC.Data.EnumSet as EnumSet
-import GHC.Rename.Env (dataTcOccs)
 
 processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]
                   -> ErrMsgM (Maybe (MDoc Name))
@@ -89,24 +89,38 @@ processModuleHeader dflags pkgName gre safety mayStr = do
 -- fallbacks in case we can't locate the identifiers.
 --
 -- See the comments in the source for implementation commentary.
-rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name)
+rename :: DynFlags -> GlobalRdrEnv -> Doc NsRdrName -> ErrMsgM (Doc Name)
 rename dflags gre = rn
   where
     rn d = case d of
       DocAppend a b -> DocAppend <$> rn a <*> rn b
       DocParagraph doc -> DocParagraph <$> rn doc
-      DocIdentifier x -> do
+      DocIdentifier i -> do
+        let NsRdrName ns x = unwrap i
+            occ = rdrNameOcc x
+            isValueName = isDataOcc occ || isVarOcc occ
+
+        let valueNsChoices | isValueName = [x]
+                           | otherwise   = [] -- is this ever possible?
+            typeNsChoices  | isValueName = [setRdrNameSpace x tcName]
+                           | otherwise   = [x]
+
         -- Generate the choices for the possible kind of thing this
-        -- is.
-        let choices = dataTcOccs x
+        -- is. We narrow down the possibilities with the namespace (if
+        -- there is one).
+        let choices = case ns of
+                        Value -> valueNsChoices
+                        Type  -> typeNsChoices
+                        None  -> valueNsChoices ++ typeNsChoices
 
         -- Lookup any GlobalRdrElts that match the choices.
         case concatMap (\c -> lookupGRE_RdrName c gre) choices of
           -- We found no names in the env so we start guessing.
           [] ->
             case choices of
-              -- This shouldn't happen as 'dataTcOccs' always returns at least its input.
-              [] -> pure (DocMonospaced (DocString (showPpr dflags x)))
+              -- The only way this can happen is if a value namespace was
+              -- specified on something that cannot be a value.
+              [] -> invalidValue dflags i
 
               -- There was nothing in the environment so we need to
               -- pick some default from what's available to us. We
@@ -116,14 +130,14 @@ rename dflags gre = rn
               -- type constructor names (such as in #253). So now we
               -- only get type constructor links if they are actually
               -- in scope.
-              a:_ -> outOfScope dflags a
+              a:_ -> outOfScope dflags ns (i $> a)
 
           -- There is only one name in the environment that matches so
           -- use it.
-          [a] -> pure (DocIdentifier (gre_name a))
+          [a] -> pure (DocIdentifier (i $> gre_name a))
 
           -- There are multiple names available.
-          gres -> ambiguous dflags x gres
+          gres -> ambiguous dflags i gres
 
       DocWarning doc -> DocWarning <$> rn doc
       DocEmphasis doc -> DocEmphasis <$> rn doc
@@ -155,19 +169,25 @@ rename dflags gre = rn
 -- users shouldn't rely on this doing the right thing. See tickets
 -- #253 and #375 on the confusion this causes depending on which
 -- default we pick in 'rename'.
-outOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a)
-outOfScope dflags x =
-  case x of
-    Unqual occ -> warnAndMonospace occ
-    Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ))
-    Orig _ occ -> warnAndMonospace occ
-    Exact name -> warnAndMonospace name  -- Shouldn't happen since x is out of scope
+outOfScope :: DynFlags -> Namespace -> Wrap RdrName -> ErrMsgM (Doc a)
+outOfScope dflags ns x =
+  case unwrap x of
+    Unqual occ -> warnAndMonospace (x $> occ)
+    Qual mdl occ -> pure (DocIdentifierUnchecked (x $> (mdl, occ)))
+    Orig _ occ -> warnAndMonospace (x $> occ)
+    Exact name -> warnAndMonospace (x $> name)  -- Shouldn't happen since x is out of scope
   where
+    prefix = case ns of
+               Value -> "the value "
+               Type -> "the type "
+               None -> ""
+
     warnAndMonospace a = do
-      tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++
+      let a' = showWrapped (showPpr dflags) a
+      tell ["Warning: " ++ prefix ++ "'" ++ a' ++ "' is out of scope.\n" ++
             "    If you qualify the identifier, haddock can try to link it anyway."]
-      pure (monospaced a)
-    monospaced a = DocMonospaced (DocString (showPpr dflags a))
+      pure (monospaced a')
+    monospaced = DocMonospaced . DocString
 
 -- | Handle ambiguous identifiers.
 --
@@ -175,26 +195,39 @@ outOfScope dflags x =
 --
 -- Emits a warning if the 'GlobalRdrElts's don't belong to the same type or class.
 ambiguous :: DynFlags
-          -> RdrName
+          -> Wrap NsRdrName
           -> [GlobalRdrElt] -- ^ More than one @gre@s sharing the same `RdrName` above.
           -> ErrMsgM (Doc Name)
 ambiguous dflags x gres = do
-  let noChildren = map availName (gresToAvailInfo gres)
-      dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren
-      msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++
-            concatMap (\n -> "    * " ++ defnLoc n ++ "\n") (map gre_name gres) ++
+  let dflt = maximumBy (comparing (gre_lcl &&& isTyConName . gre_name)) gres
+      msg = "Warning: " ++ showNsRdrName dflags x ++ " is ambiguous. It is defined\n" ++
+            concatMap (\n -> "    * " ++ defnLoc n ++ "\n") gres ++
             "    You may be able to disambiguate the identifier by qualifying it or\n" ++
-            "    by hiding some imports.\n" ++
-            "    Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt
+            "    by specifying the type/value namespace explicitly.\n" ++
+            "    Defaulting to the one defined " ++ defnLoc dflt
   -- TODO: Once we have a syntax for namespace qualification (#667) we may also
   -- want to emit a warning when an identifier is a data constructor for a type
   -- of the same name, but not the only constructor.
   -- For example, for @data D = C | D@, someone may want to reference the @D@
   -- constructor.
-  when (length noChildren > 1) $ tell [msg]
-  pure (DocIdentifier dflt)
+  when (length (gresToAvailInfo gres) > 1) $ tell [msg]
+  pure (DocIdentifier (x $> gre_name dflt))
+  where
+    defnLoc = showSDoc dflags . pprNameDefnLoc . gre_name
+
+-- | Handle value-namespaced names that cannot be for values.
+--
+-- Emits a warning that the value-namespace is invalid on a non-value identifier.
+invalidValue :: DynFlags -> Wrap NsRdrName -> ErrMsgM (Doc a)
+invalidValue dflags x = do
+  tell ["Warning: " ++ showNsRdrName dflags x ++ " cannot be value, yet it is\n" ++
+            "    namespaced as such. Did you mean to specify a type namespace\n" ++
+            "    instead?"]
+  pure (DocMonospaced (DocString (showNsRdrName dflags x)))
+
+-- | Printable representation of a wrapped and namespaced name
+showNsRdrName :: DynFlags -> Wrap NsRdrName -> String
+showNsRdrName dflags = (\p i -> p ++ "'" ++ i ++ "'") <$> prefix <*> ident
   where
-    isLocalName (nameSrcLoc -> RealSrcLoc {}) = True
-    isLocalName _ = False
-    x_str = '\'' : showPpr dflags x ++ "'"
-    defnLoc = showSDoc dflags . pprNameDefnLoc
+    ident = showWrapped (showPpr dflags . rdrName)
+    prefix = renderNs . namespace . unwrap
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index 611d8b6f..3e464fbc 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -Wwarn #-}
+{-# LANGUAGE DeriveFunctor #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.ParseModuleHeader
@@ -11,12 +13,12 @@
 -----------------------------------------------------------------------------
 module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where
 
-import Control.Monad (mplus)
+import Control.Applicative (Alternative (..))
+import Control.Monad (ap)
 import Data.Char
 import GHC.Driver.Session
 import Haddock.Parser
 import Haddock.Types
-import GHC.Types.Name.Reader
 
 -- -----------------------------------------------------------------------------
 -- Parsing module headers
@@ -24,37 +26,47 @@ import GHC.Types.Name.Reader
 -- NB.  The headers must be given in the order Module, Description,
 -- Copyright, License, Maintainer, Stability, Portability, except that
 -- any or all may be omitted.
-parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName)
+parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo NsRdrName, MDoc NsRdrName)
 parseModuleHeader dflags pkgName str0 =
    let
-      getKey :: String -> String -> (Maybe String,String)
-      getKey key str = case parseKey key str of
-         Nothing -> (Nothing,str)
-         Just (value,rest) -> (Just value,rest)
-
-      (_moduleOpt,str1) = getKey "Module" str0
-      (descriptionOpt,str2) = getKey "Description" str1
-      (copyrightOpt,str3) = getKey "Copyright" str2
-      (licenseOpt,str4) = getKey "License" str3
-      (licenceOpt,str5) = getKey "Licence" str4
-      (spdxLicenceOpt,str6) = getKey "SPDX-License-Identifier" str5
-      (maintainerOpt,str7) = getKey "Maintainer" str6
-      (stabilityOpt,str8) = getKey "Stability" str7
-      (portabilityOpt,str9) = getKey "Portability" str8
+      kvs :: [(String, String)]
+      str1 :: String
+
+      (kvs, str1) = maybe ([], str0) id $ runP fields str0
+
+      -- trim whitespaces
+      trim :: String -> String
+      trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+
+      getKey :: String -> Maybe String
+      getKey key = fmap trim (lookup key kvs)
+
+      descriptionOpt = getKey "Description"
+      copyrightOpt   = getKey "Copyright"
+      licenseOpt     = getKey "License"
+      licenceOpt     = getKey "Licence"
+      spdxLicenceOpt = getKey "SPDX-License-Identifier"
+      maintainerOpt  = getKey "Maintainer"
+      stabilityOpt   = getKey "Stability"
+      portabilityOpt = getKey "Portability"
 
    in (HaddockModInfo {
           hmi_description = parseString dflags <$> descriptionOpt,
           hmi_copyright = copyrightOpt,
-          hmi_license = spdxLicenceOpt `mplus` licenseOpt `mplus` licenceOpt,
+          hmi_license = spdxLicenceOpt <|> licenseOpt <|> licenceOpt,
           hmi_maintainer = maintainerOpt,
           hmi_stability = stabilityOpt,
           hmi_portability = portabilityOpt,
           hmi_safety = Nothing,
           hmi_language = Nothing, -- set in LexParseRn
           hmi_extensions = [] -- also set in LexParseRn
-          }, parseParas dflags pkgName str9)
+          }, parseParas dflags pkgName str1)
+
+-------------------------------------------------------------------------------
+-- Small parser to parse module header.
+-------------------------------------------------------------------------------
 
--- | This function is how we read keys.
+-- | The below is a small parser framework how we read keys.
 --
 -- all fields in the header are optional and have the form
 --
@@ -73,78 +85,105 @@ parseModuleHeader dflags pkgName str0 =
 --
 -- the value will be "this is a .. description" and the rest will begin
 -- at "The module comment".
-parseKey :: String -> String -> Maybe (String,String)
-parseKey key toParse0 =
-   do
-      let
-         (spaces0,toParse1) = extractLeadingSpaces (dropWhile (`elem` ['\r', '\n']) toParse0)
-
-         indentation = spaces0
-      afterKey0 <- extractPrefix key toParse1
-      let
-         afterKey1 = extractLeadingSpaces afterKey0
-      afterColon0 <- case snd afterKey1 of
-         ':':afterColon -> return afterColon
-         _ -> Nothing
-      let
-         (_,afterColon1) = extractLeadingSpaces afterColon0
-
-      return (scanKey True indentation afterColon1)
-   where
-      scanKey :: Bool -> String -> String -> (String,String)
-      scanKey _       _           [] = ([],[])
-      scanKey isFirst indentation str =
-         let
-            (nextLine,rest1) = extractNextLine str
-
-            accept = isFirst || sufficientIndentation || allSpaces
-
-            sufficientIndentation = case extractPrefix indentation nextLine of
-               Just (c:_) | isSpace c -> True
-               _ -> False
-
-            allSpaces = case extractLeadingSpaces nextLine of
-               (_,[]) -> True
-               _ -> False
-         in
-            if accept
-               then
-                  let
-                     (scanned1,rest2) = scanKey False indentation rest1
-
-                     scanned2 = case scanned1 of
-                        "" -> if allSpaces then "" else nextLine
-                        _ -> nextLine ++ "\n" ++ scanned1
-                  in
-                     (scanned2,rest2)
-               else
-                  ([],str)
-
-      extractLeadingSpaces :: String -> (String,String)
-      extractLeadingSpaces [] = ([],[])
-      extractLeadingSpaces (s@(c:cs))
-         | isSpace c =
-            let
-               (spaces1,cs1) = extractLeadingSpaces cs
-            in
-               (c:spaces1,cs1)
-         | otherwise = ([],s)
-
-      extractNextLine :: String -> (String,String)
-      extractNextLine [] = ([],[])
-      extractNextLine (c:cs)
-         | c == '\n' =
-            ([],cs)
-         | otherwise =
-            let
-               (line,rest) = extractNextLine cs
-            in
-               (c:line,rest)
-
-      -- comparison is case-insensitive.
-      extractPrefix :: String -> String -> Maybe String
-      extractPrefix [] s = Just s
-      extractPrefix _ [] = Nothing
-      extractPrefix (c1:cs1) (c2:cs2)
-         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
-         | otherwise = Nothing
+
+-- | 'C' is a 'Char' carrying its column.
+--
+-- This let us make an indentation-aware parser, as we know current indentation.
+-- by looking at the next character in the stream ('curInd').
+--
+-- Thus we can munch all spaces but only not-spaces which are indented.
+--
+data C = C {-# UNPACK #-} !Int Char
+
+newtype P a = P { unP :: [C] -> Maybe ([C], a) }
+  deriving Functor
+
+instance Applicative P where
+    pure x = P $ \s -> Just (s, x)
+    (<*>)  = ap
+
+instance Monad P where
+    return = pure
+    m >>= k = P $ \s0 -> do
+        (s1, x) <- unP m s0
+        unP (k x) s1
+
+instance Alternative P where
+    empty   = P $ \_ -> Nothing
+    a <|> b = P $ \s -> unP a s <|> unP b s
+
+runP :: P a -> String -> Maybe a
+runP p input = fmap snd (unP p input')
+  where
+    input' = concat
+        [ zipWith C [0..] l ++ [C (length l) '\n']
+        | l <- lines input
+        ]
+
+-------------------------------------------------------------------------------
+--
+-------------------------------------------------------------------------------
+
+curInd :: P Int
+curInd = P $ \s -> Just . (,) s $ case s of
+    []        -> 0
+    C i _ : _ -> i
+
+rest :: P String
+rest = P $ \cs -> Just ([], [ c | C _ c <- cs ])
+
+munch :: (Int -> Char -> Bool) -> P String
+munch p = P $ \cs ->
+    let (xs,ys) = takeWhileMaybe p' cs in Just (ys, xs)
+  where
+    p' (C i c)
+        | p i c  = Just c
+        | otherwise = Nothing
+
+munch1 :: (Int -> Char -> Bool) -> P String
+munch1 p = P $ \s -> case s of
+    [] -> Nothing
+    (c:cs) | Just c' <- p' c -> let (xs,ys) = takeWhileMaybe p' cs in Just (ys, c' : xs)
+           | otherwise -> Nothing
+  where
+    p' (C i c)
+        | p i c  = Just c
+        | otherwise = Nothing
+
+char :: Char -> P Char
+char c = P $ \s -> case s of
+    []                        -> Nothing
+    (C _ c' : cs) | c == c'   -> Just (cs, c)
+                  | otherwise -> Nothing
+
+skipSpaces :: P ()
+skipSpaces = P $ \cs -> Just (dropWhile (\(C _ c) -> isSpace c) cs, ())
+
+takeWhileMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
+takeWhileMaybe f = go where
+    go xs0@[] = ([], xs0)
+    go xs0@(x:xs) = case f x of
+        Just y  -> let (ys, zs) = go xs in (y : ys, zs)
+        Nothing -> ([], xs0)
+
+-------------------------------------------------------------------------------
+-- Fields
+-------------------------------------------------------------------------------
+
+field :: Int -> P (String, String)
+field i = do
+    fn <- munch1 $ \_ c -> isAlpha c || c == '-'
+    skipSpaces
+    _ <- char ':'
+    skipSpaces
+    val <- munch $ \j c -> isSpace c || j > i
+    return (fn, val)
+
+fields :: P ([(String, String)], String)
+fields = do
+    skipSpaces
+    i  <- curInd
+    fs <- many (field i)
+    r  <- rest
+    return (fs, r)
+
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 061ef8eb..bb9cd02d 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.Rename
@@ -28,13 +29,22 @@ import GHC.Builtin.Types (eqTyCon_RDR)
 import Control.Applicative
 import Control.Arrow ( first )
 import Control.Monad hiding (mapM)
-import Data.List
+import Data.List (intercalate)
 import qualified Data.Map as Map hiding ( Map )
+import qualified Data.Set as Set
 import Prelude hiding (mapM)
 import GHC.HsToCore.Docs
 
-renameInterface :: DynFlags -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface
-renameInterface dflags renamingEnv warnings iface =
+-- | Traverse docstrings and ASTs in the Haddock interface, renaming 'Name' to
+-- 'DocName'.
+--
+-- What this really boils down to is: for each 'Name', figure out which of the
+-- modules that export the name is the preferred place to link to.
+--
+-- The renamed output gets written into fields in the Haddock interface record
+-- that were previously left empty.
+renameInterface :: DynFlags -> [String] -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface
+renameInterface _dflags ignoredSymbols renamingEnv warnings iface =
 
   -- first create the local env, where every name exported by this module
   -- is mapped to itself, and everything else comes from the global renaming
@@ -69,8 +79,15 @@ renameInterface dflags renamingEnv warnings iface =
       -- Note that since the renamed AST represents equality constraints as
       -- @HasOpTy t1 eqTyCon_RDR t2@ (and _not_ as @HsEqTy t1 t2@), we need to
       -- manually filter out 'eqTyCon_RDR' (aka @~@).
-      strings = [ pretty dflags n
+
+      qualifiedName n = (moduleNameString $ moduleName $ nameModule n) <> "." <> getOccString n
+
+      ignoreSet = Set.fromList ignoredSymbols
+
+      strings = [ qualifiedName n
+
                 | n <- missingNames
+                , not (qualifiedName n `Set.member` ignoreSet)
                 , not (isSystemName n)
                 , not (isBuiltInSyntax n)
                 , Exact n /= eqTyCon_RDR
@@ -82,7 +99,7 @@ renameInterface dflags renamingEnv warnings iface =
     unless (OptHide `elem` ifaceOptions iface || null strings || not warnings) $
       tell ["Warning: " ++ moduleString (ifaceMod iface) ++
             ": could not find link destinations for:\n"++
-            unwords ("   " : strings) ]
+            intercalate "\n\t- "  ("" : strings) ]
 
     return $ iface { ifaceRnDoc         = finalModuleDoc,
                      ifaceRnDocMap      = rnDocMap,
@@ -130,6 +147,11 @@ lookupRn name = RnM $ \lkp ->
     (False,maps_to) -> (maps_to, (name :))
     (True, maps_to) -> (maps_to, id)
 
+-- | Look up a 'Name' in the renaming environment, but don't warn if you don't
+-- find the name. Prefer to use 'lookupRn' whenever possible.
+lookupRnNoWarn :: Name -> RnM DocName
+lookupRnNoWarn name = RnM $ \lkp -> (snd (lkp name), id)
+
 -- | Run the renamer action using lookup in a 'LinkEnv' as the lookup function.
 -- Returns the renamed value along with a list of `Name`'s that could not be
 -- renamed because they weren't in the environment.
@@ -173,8 +195,8 @@ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
 renameLDocHsSyn = return
 
 
-renameDoc :: Traversable t => t Name -> RnM (t DocName)
-renameDoc = traverse rename
+renameDoc :: Traversable t => t (Wrap Name) -> RnM (t (Wrap DocName))
+renameDoc = traverse (traverse rename)
 
 renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
 renameFnArgsDoc = mapM renameDoc
@@ -544,7 +566,7 @@ renameSig sig = case sig of
     lnames' <- mapM renameL lnames
     return $ FixSig noExtField (FixitySig noExtField lnames' fixity)
   MinimalSig _ src (L l s) -> do
-    s' <- traverse renameL s
+    s' <- traverse (traverse lookupRnNoWarn) s
     return $ MinimalSig noExtField src (L l s')
   -- we have filtered out all other kinds of signatures in Interface.Create
   _ -> error "expected TypeSig"
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 0e9fc851..a084af90 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -3,19 +3,20 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
 module Haddock.Interface.Specialize
     ( specializeInstHead
     ) where
 
 
+import Haddock.GhcUtils ( hsTyVarBndrName )
 import Haddock.Syb
 import Haddock.Types
 
 import GHC
 import GHC.Types.Name
 import GHC.Data.FastString
-import GHC.Builtin.Types.Prim ( funTyConName )
 import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName )
 import GHC.Parser.Annotation (IsUnicodeSyntax(..))
 
@@ -57,13 +58,9 @@ specialize specs = go spec_map0
 -- Again, it is just a convenience function around 'specialize'. Note that
 -- length of type list should be the same as the number of binders.
 specializeTyVarBndrs :: LHsQTyVars GhcRn -> [HsType GhcRn] -> HsType GhcRn -> HsType GhcRn
-specializeTyVarBndrs bndrs typs =
-    specialize $ zip bndrs' typs
+specializeTyVarBndrs bndrs typs = specialize $ zip bndrs' typs
   where
-    bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs
-    bname (UserTyVar _ _ (L _ name)) = name
-    bname (KindedTyVar _ _ (L _ name) _) = name
-    bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs"
+    bndrs' = map (hsTyVarBndrName . unLoc) . hsq_explicit $ bndrs
 
 
 
@@ -217,7 +214,7 @@ freeVariables =
     teleNames (HsForAllVis   _ bndrs) = bndrsNames bndrs
     teleNames (HsForAllInvis _ bndrs) = bndrsNames bndrs
 
-    bndrsNames = Set.fromList . map (getName . tyVarName . unLoc)
+    bndrsNames = Set.fromList . map (getName . hsTyVarBndrName . unLoc)
 
 
 -- | Make given type visually unambiguous.
@@ -365,9 +362,3 @@ alternativeNames name =
 
 located :: Functor f => (a -> f b) -> Located a -> f (Located b)
 located f (L loc e) = L loc <$> f e
-
-
-tyVarName :: HsTyVarBndr flag name -> IdP name
-tyVarName (UserTyVar _ _ name) = unLoc name
-tyVarName (KindedTyVar _ _ (L _ name) _) = name
-tyVarName (XTyVarBndr _ ) = error "haddock:tyVarName"
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 9686de1f..0b8bb9f2 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -22,12 +22,12 @@ module Haddock.InterfaceFile (
 
 
 import Haddock.Types
-import Haddock.Utils hiding (out)
 
 import Control.Monad
+import Control.Monad.IO.Class ( MonadIO(..) )
 import Data.Array
 import Data.IORef
-import Data.List
+import Data.List (mapAccumR)
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.Word
@@ -84,7 +84,7 @@ binaryInterfaceMagic = 0xD0Cface
 --
 binaryInterfaceVersion :: Word16
 #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,1,0)
-binaryInterfaceVersion = 34
+binaryInterfaceVersion = 37
 
 binaryInterfaceVersionCompatibility :: [Word16]
 binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
@@ -702,3 +702,28 @@ instance Binary DocName where
         name <- get bh
         return (Undocumented name)
       _ -> error "get DocName: Bad h"
+
+instance Binary n => Binary (Wrap n) where
+  put_ bh (Unadorned n) = do
+    putByte bh 0
+    put_ bh n
+  put_ bh (Parenthesized n) = do
+    putByte bh 1
+    put_ bh n
+  put_ bh (Backticked n) = do
+    putByte bh 2
+    put_ bh n
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> do
+        name <- get bh
+        return (Unadorned name)
+      1 -> do
+        name <- get bh
+        return (Parenthesized name)
+      2 -> do
+        name <- get bh
+        return (Backticked name)
+      _ -> error "get Wrap: Bad h"
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index 5c9bf448..0b886d1a 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -36,14 +36,14 @@ module Haddock.Options (
   readIfaceArgs,
   optPackageName,
   optPackageVersion,
-  modulePackageInfo
+  modulePackageInfo,
+  ignoredSymbols
 ) where
 
 
 import qualified Data.Char as Char
 import           Data.Version
 import           Control.Applicative
-import           Distribution.Verbosity
 import           GHC.Data.FastString
 import           GHC ( DynFlags, Module, moduleUnit, unitState )
 import           Haddock.Types
@@ -109,6 +109,7 @@ data Flag
   | Flag_PackageVersion String
   | Flag_Reexport String
   | Flag_SinceQualification String
+  | Flag_IgnoreLinkSymbol String
   deriving (Eq, Show)
 
 
@@ -220,7 +221,9 @@ options backwardsCompat =
     Option [] ["package-version"] (ReqArg Flag_PackageVersion "VERSION")
       "version of the package being documented in usual x.y.z.w format",
     Option []  ["since-qual"] (ReqArg Flag_SinceQualification "QUAL")
-      "package qualification of @since, one of\n'always' (default) or 'only-external'"
+      "package qualification of @since, one of\n'always' (default) or 'only-external'",
+    Option [] ["ignore-link-symbol"] (ReqArg Flag_IgnoreLinkSymbol "SYMBOL")
+      "name of a symbol which does not trigger a warning in case of link issue"
   ]
 
 
@@ -332,11 +335,13 @@ sinceQualification flags =
 verbosity :: [Flag] -> Verbosity
 verbosity flags =
   case [ str | Flag_Verbosity str <- flags ] of
-    []  -> normal
+    []  -> Normal
     x:_ -> case parseVerbosity x of
       Left e -> throwE e
       Right v -> v
 
+ignoredSymbols :: [Flag] -> [String]
+ignoredSymbols flags = [ symbol | Flag_IgnoreLinkSymbol symbol <- flags ]
 
 ghcFlags :: [Flag] -> [String]
 ghcFlags flags = [ option | Flag_OptGhc option <- flags ]
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
index e1b5c787..0604a831 100644
--- a/haddock-api/src/Haddock/Parser.hs
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      :  Haddock.Parser
 -- Copyright   :  (c) Mateusz Kowalczyk 2013,
@@ -15,26 +16,41 @@ module Haddock.Parser ( parseParas
 
 import qualified Documentation.Haddock.Parser as P
 import Documentation.Haddock.Types
+import Haddock.Types
 
 import GHC.Driver.Session ( DynFlags )
 import GHC.Data.FastString   ( fsLit )
-import GHC.Parser.Lexer ( mkPState, unP, ParseResult(POk) )
+import GHC.Parser.Lexer ( mkPState, unP, ParseResult(POk, PFailed) )
 import GHC.Parser       ( parseIdentifier )
-import GHC.Types.Name.Reader ( RdrName )
-import GHC.Types.SrcLoc ( mkRealSrcLoc, unLoc )
+import GHC.Types.Name.Occurrence ( occNameString )
+import GHC.Types.Name.Reader ( RdrName(..) )
+import GHC.Types.SrcLoc ( mkRealSrcLoc, GenLocated(..), unLoc )
 import GHC.Data.StringBuffer ( stringToStringBuffer )
 
-parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName
+
+parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod (Wrap NsRdrName)
 parseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p
 
-parseString :: DynFlags -> String -> DocH mod RdrName
+parseString :: DynFlags -> String -> DocH mod (Wrap NsRdrName)
 parseString d = P.overIdentifier (parseIdent d) . P.parseString
 
-parseIdent :: DynFlags -> String -> Maybe RdrName
-parseIdent dflags str0 =
-  let buffer = stringToStringBuffer str0
-      realSrcLc = mkRealSrcLoc (fsLit "<unknown file>") 0 0
-      pstate = mkPState dflags buffer realSrcLc
-  in case unP parseIdentifier pstate of
-    POk _ name -> Just (unLoc name)
-    _ -> Nothing
+parseIdent :: DynFlags -> Namespace -> String -> Maybe (Wrap NsRdrName)
+parseIdent dflags ns str0 =
+  case unP parseIdentifier (pstate str1) of
+    POk _ (L _ name)
+      -- Guards against things like 'Q.--', 'Q.case', etc.
+      -- See https://github.com/haskell/haddock/issues/952 and Trac #14109
+      | Qual _ occ <- name
+      , PFailed{} <- unP parseIdentifier (pstate (occNameString occ))
+      -> Nothing
+      | otherwise
+      -> Just (wrap (NsRdrName ns name))
+    PFailed{} -> Nothing
+  where
+    realSrcLc = mkRealSrcLoc (fsLit "<unknown file>") 0 0
+    pstate str = mkPState dflags (stringToStringBuffer str) realSrcLc
+    (wrap,str1) = case str0 of
+                    '(' : s@(c : _) | c /= ',', c /= ')'  -- rule out tuple names
+                                    -> (Parenthesized, init s)
+                    '`' : s@(_ : _) -> (Backticked,    init s)
+                    _               -> (Unadorned,     str0)
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 21c7d19b..aa76f8f6 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -27,14 +27,16 @@ module Haddock.Types (
   , module Documentation.Haddock.Types
  ) where
 
-import Control.Exception
 import Control.Arrow hiding ((<+>))
 import Control.DeepSeq
+import Control.Exception (throw)
 import Control.Monad (ap)
+import Control.Monad.Catch
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Typeable (Typeable)
 import Data.Map (Map)
 import Data.Data (Data)
+import Data.Void (Void)
 import Documentation.Haddock.Types
 import GHC.Types.Basic (Fixity(..), PromotionFlag(..))
 
@@ -284,6 +286,12 @@ noDocForDecl = (Documentation Nothing Nothing, mempty)
 -- | Type of environment used to cross-reference identifiers in the syntax.
 type LinkEnv = Map Name Module
 
+-- | An 'RdrName' tagged with some type/value namespace information.
+data NsRdrName = NsRdrName
+  { namespace :: !Namespace
+  , rdrName :: !RdrName
+  }
+
 -- | Extends 'Name' with cross-reference information.
 data DocName
   = Documented Name Module
@@ -330,7 +338,30 @@ instance SetName DocName where
     setName name' (Documented _ mdl) = Documented name' mdl
     setName name' (Undocumented _) = Undocumented name'
 
+-- | Adds extra "wrapper" information to a name.
+--
+-- This is to work around the fact that most name types in GHC ('Name', 'RdrName',
+-- 'OccName', ...) don't include backticks or parens.
+data Wrap n
+  = Unadorned { unwrap :: n  }     -- ^ don't do anything to the name
+  | Parenthesized { unwrap :: n }  -- ^ add parentheses around the name
+  | Backticked { unwrap :: n }     -- ^ add backticks around the name
+  deriving (Show, Functor, Foldable, Traversable)
+
+-- | Useful for debugging
+instance Outputable n => Outputable (Wrap n) where
+  ppr (Unadorned n)     = ppr n
+  ppr (Parenthesized n) = hcat [ char '(', ppr n, char ')' ]
+  ppr (Backticked n)    = hcat [ char '`', ppr n, char '`' ]
+
+showWrapped :: (a -> String) -> Wrap a -> String
+showWrapped f (Unadorned n) = f n
+showWrapped f (Parenthesized n) = "(" ++ f n ++ ")"
+showWrapped f (Backticked n) = "`" ++ f n ++ "`"
+
+instance HasOccName DocName where
 
+    occName = occName . getName
 
 -----------------------------------------------------------------------------
 -- * Instances
@@ -424,10 +455,10 @@ instance NamedThing name => NamedThing (InstOrigin name) where
 
 type LDoc id = Located (Doc id)
 
-type Doc id = DocH (ModuleName, OccName) id
-type MDoc id = MetaDoc (ModuleName, OccName) id
+type Doc id = DocH (Wrap (ModuleName, OccName)) (Wrap id)
+type MDoc id = MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
 
-type DocMarkup id a = DocMarkupH (ModuleName, OccName) id a
+type DocMarkup id a = DocMarkupH (Wrap (ModuleName, OccName)) id a
 
 instance (NFData a, NFData mod)
          => NFData (DocH mod a) where
@@ -620,17 +651,28 @@ tell w = Writer ((), w)
 
 
 -- | Haddock's own exception type.
-data HaddockException = HaddockException String deriving Typeable
+data HaddockException
+  = HaddockException String
+  | WithContext [String] SomeException
+  deriving Typeable
 
 
 instance Show HaddockException where
   show (HaddockException str) = str
-
+  show (WithContext ctxts se)  = unlines $ ["While " ++ ctxt ++ ":\n" | ctxt <- reverse ctxts] ++ [show se]
 
 throwE :: String -> a
 instance Exception HaddockException
 throwE str = throw (HaddockException str)
 
+withExceptionContext :: MonadCatch m => String -> m a -> m a
+withExceptionContext ctxt =
+  handle (\ex ->
+      case ex of
+        HaddockException _ -> throwM $ WithContext [ctxt] (toException ex)
+        WithContext ctxts se -> throwM $ WithContext (ctxt:ctxts) se
+          ) .
+  handle (throwM . WithContext [ctxt])
 
 -- In "Haddock.Interface.Create", we need to gather
 -- @Haddock.Types.ErrMsg@s a lot, like @ErrMsgM@ does,
@@ -665,6 +707,12 @@ instance Monad ErrMsgGhc where
 instance MonadIO ErrMsgGhc where
   liftIO m = WriterGhc (fmap (\x -> (x, [])) (liftIO m))
 
+instance MonadThrow ErrMsgGhc where
+  throwM e = WriterGhc (throwM e)
+
+instance MonadCatch ErrMsgGhc where
+  catch (WriterGhc m) f = WriterGhc (catch m (runWriterGhc . f))
+
 -----------------------------------------------------------------------------
 -- * Pass sensitive types
 -----------------------------------------------------------------------------
@@ -685,7 +733,7 @@ type instance XOpTy            DocNameI = NoExtField
 type instance XParTy           DocNameI = NoExtField
 type instance XIParamTy        DocNameI = NoExtField
 type instance XKindSig         DocNameI = NoExtField
-type instance XSpliceTy        DocNameI = NoExtField
+type instance XSpliceTy        DocNameI = Void       -- see `renameHsSpliceTy`
 type instance XDocTy           DocNameI = NoExtField
 type instance XBangTy          DocNameI = NoExtField
 type instance XRecTy           DocNameI = NoExtField
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 8346a477..0c9c6073 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -13,15 +13,9 @@
 -----------------------------------------------------------------------------
 module Haddock.Utils (
 
-  -- * Misc utilities
-  restrictTo, emptyHsQTvs,
-  toDescription, toInstalledDescription,
-  mkEmptySigWcType, addClassContext, lHsQTyVarsToTypes,
-
   -- * Filename utilities
   moduleHtmlFile, moduleHtmlFile',
   contentsHtmlFile, indexHtmlFile, indexJsonFile,
-  moduleIndexFrameName, mainFrameName, synopsisFrameName,
   subIndexHtmlFile,
   haddockJsFile, jsQuickJumpFile,
   quickJumpCssFile,
@@ -32,7 +26,7 @@ module Haddock.Utils (
   makeAnchorId,
 
   -- * Miscellaneous utilities
-  getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
+  getProgramName, bye, die, escapeStr,
   writeUtf8File, withTempDir,
 
   -- * HTML cross reference mapping
@@ -45,11 +39,8 @@ module Haddock.Utils (
   replace,
   spanWith,
 
-  -- * MTL stuff
-  MonadIO(..),
-
   -- * Logging
-  parseVerbosity,
+  parseVerbosity, Verbosity(..), silent, normal, verbose, deafening,
   out,
 
   -- * System tools
@@ -59,48 +50,54 @@ module Haddock.Utils (
 
 import Documentation.Haddock.Doc (emptyMetaDoc)
 import Haddock.Types
-import Haddock.GhcUtils
 
-import GHC.Types.Basic ( PromotionFlag(..) )
-import GHC.Utils.Exception (ExceptionMonad)
 import GHC
 import GHC.Types.Name
 
-import Control.Monad ( liftM )
-import Control.Monad.Catch ( bracket_ )
+import Control.Monad.IO.Class ( MonadIO(..) )
+import Control.Monad.Catch ( MonadMask, bracket_ )
 import Data.Char ( isAlpha, isAlphaNum, isAscii, ord, chr )
 import Numeric ( showIntAtBase )
 import Data.Map ( Map )
 import qualified Data.Map as Map hiding ( Map )
 import Data.IORef ( IORef, newIORef, readIORef )
 import Data.List ( isSuffixOf )
-import Data.Maybe ( mapMaybe )
 import System.Environment ( getProgName )
 import System.Exit
 import System.Directory ( createDirectory, removeDirectoryRecursive )
-import System.IO ( hPutStr, hSetEncoding, IOMode(..), stderr, utf8, withFile )
+import System.IO ( hPutStr, hSetEncoding, IOMode(..), utf8, withFile )
 import System.IO.Unsafe ( unsafePerformIO )
 import qualified System.FilePath.Posix as HtmlPath
-import Distribution.Verbosity
-import Distribution.ReadE
 
 #ifndef mingw32_HOST_OS
 import qualified System.Posix.Internals
 #endif
 
-import GHC.Utils.Monad ( MonadIO(..) )
-
-import GHC.Core.Multiplicity
-
-
 --------------------------------------------------------------------------------
 -- * Logging
 --------------------------------------------------------------------------------
 
+data Verbosity = Silent | Normal | Verbose | Deafening
+  deriving (Eq, Ord, Enum, Bounded, Show)
 
-parseVerbosity :: String -> Either String Verbosity
-parseVerbosity = runReadE flagToVerbosity
+silent, normal, verbose, deafening :: Verbosity
+silent    = Silent
+normal    = Normal
+verbose   = Verbose
+deafening = Deafening
 
+-- | Parse out a verbosity level. Inspired from Cabal's verbosity parsing.
+parseVerbosity :: String -> Either String Verbosity
+parseVerbosity "0" = Right Silent
+parseVerbosity "1" = Right Normal
+parseVerbosity "2" = Right Silent
+parseVerbosity "3" = Right Deafening
+parseVerbosity "silent"    = return Silent
+parseVerbosity "normal"    = return Normal
+parseVerbosity "verbose"   = return Verbose
+parseVerbosity "debug"     = return Deafening
+parseVerbosity "deafening" = return Deafening
+parseVerbosity other = Left ("Can't parse verbosity " ++ other)
 
 -- | Print a message to stdout, if it is not too verbose
 out :: MonadIO m
@@ -117,115 +114,14 @@ out progVerbosity msgVerbosity msg
 --------------------------------------------------------------------------------
 
 
--- | Extract a module's short description.
-toDescription :: Interface -> Maybe (MDoc Name)
-toDescription = fmap mkMeta . hmi_description . ifaceInfo
-
-
--- | Extract a module's short description.
-toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
-toInstalledDescription = fmap mkMeta . hmi_description . instInfo
 
 mkMeta :: Doc a -> MDoc a
 mkMeta x = emptyMetaDoc { _doc = x }
 
-mkEmptySigWcType :: LHsType GhcRn -> LHsSigWcType GhcRn
--- Dubious, because the implicit binders are empty even
--- though the type might have free varaiables
-mkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty)
-
-addClassContext :: Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn
--- Add the class context to a class-op signature
-addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype))
-  = L pos (TypeSig noExtField lname (mkEmptySigWcType (go (hsSigType ltype))))
-          -- The mkEmptySigWcType is suspicious
-  where
-    go (L loc (HsForAllTy { hst_tele = tele, hst_body = ty }))
-       = L loc (HsForAllTy { hst_xforall = noExtField
-                           , hst_tele = tele, hst_body = go ty })
-    go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty }))
-       = L loc (HsQualTy { hst_xqual = noExtField
-                         , hst_ctxt = add_ctxt ctxt, hst_body = ty })
-    go (L loc ty)
-       = L loc (HsQualTy { hst_xqual = noExtField
-                         , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })
-
-    extra_pred = nlHsTyConApp Prefix cls (lHsQTyVarsToTypes tvs0)
-    add_ctxt (L loc preds) = L loc (extra_pred : preds)
-
-addClassContext _ _ sig = sig   -- E.g. a MinimalSig is fine
-
-lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsTypeArg GhcRn]
-lHsQTyVarsToTypes tvs
-  = [ HsValArg $ noLoc (HsTyVar noExtField NotPromoted (noLoc (hsLTyVarName tv)))
-    | tv <- hsQTvExplicit tvs ]
-
---------------------------------------------------------------------------------
--- * Making abstract declarations
---------------------------------------------------------------------------------
-
-
-restrictTo :: [Name] -> LHsDecl GhcRn -> LHsDecl GhcRn
-restrictTo names (L loc decl) = L loc $ case decl of
-  TyClD x d | isDataDecl d  ->
-    TyClD x (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
-  TyClD x d | isClassDecl d ->
-    TyClD x (d { tcdSigs = restrictDecls names (tcdSigs d),
-               tcdATs = restrictATs names (tcdATs d) })
-  _ -> decl
-
-restrictDataDefn :: [Name] -> HsDataDefn GhcRn -> HsDataDefn GhcRn
-restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
-  | DataType <- new_or_data
-  = defn { dd_cons = restrictCons names cons }
-  | otherwise    -- Newtype
-  = case restrictCons names cons of
-      []    -> defn { dd_ND = DataType, dd_cons = [] }
-      [con] -> defn { dd_cons = [con] }
-      _ -> error "Should not happen"
-
-restrictCons :: [Name] -> [LConDecl GhcRn] -> [LConDecl GhcRn]
-restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
-  where
-    keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) =
-      case con_args d of
-        PrefixCon _ -> Just d
-        RecCon fields
-          | all field_avail (unL fields) -> Just d
-          | otherwise -> Just (d { con_args = PrefixCon (field_types (map unL (unL fields))) })
-          -- if we have *all* the field names available, then
-          -- keep the record declaration.  Otherwise degrade to
-          -- a constructor declaration.  This isn't quite right, but
-          -- it's the best we can do.
-        InfixCon _ _ -> Just d
-      where
-        field_avail :: LConDeclField GhcRn -> Bool
-        field_avail (L _ (ConDeclField _ fs _ _))
-            = all (\f -> extFieldOcc (unLoc f) `elem` names) fs
-        field_types flds = [ hsUnrestricted t | ConDeclField _ _ t _ <- flds ]
-
-    keep _ = Nothing
-
-restrictDecls :: [Name] -> [LSig GhcRn] -> [LSig GhcRn]
-restrictDecls names = mapMaybe (filterLSigNames (`elem` names))
-
-
-restrictATs :: [Name] -> [LFamilyDecl GhcRn] -> [LFamilyDecl GhcRn]
-restrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ]
-
-emptyHsQTvs :: LHsQTyVars GhcRn
--- This function is here, rather than in HsTypes, because it *renamed*, but
--- does not necessarily have all the rigt kind variables.  It is used
--- in Haddock just for printing, so it doesn't matter
-emptyHsQTvs = HsQTvs { hsq_ext = error "haddock:emptyHsQTvs"
-                     , hsq_explicit = [] }
-
-
 --------------------------------------------------------------------------------
 -- * Filename mangling functions stolen from s main/DriverUtil.lhs.
 --------------------------------------------------------------------------------
 
-
 baseName :: ModuleName -> FilePath
 baseName = map (\c -> if c == '.' then '-' else c) . moduleNameString
 
@@ -252,13 +148,6 @@ indexHtmlFile = "doc-index.html"
 indexJsonFile = "doc-index.json"
 
 
-
-moduleIndexFrameName, mainFrameName, synopsisFrameName :: String
-moduleIndexFrameName = "modules"
-mainFrameName = "main"
-synopsisFrameName = "synopsis"
-
-
 subIndexHtmlFile :: String -> String
 subIndexHtmlFile ls = "doc-index-" ++ b ++ ".html"
    where b | all isAlpha ls = ls
@@ -332,7 +221,7 @@ quickJumpCssFile = "quick-jump.css"
 
 
 getProgramName :: IO String
-getProgramName = liftM (`withoutSuffix` ".bin") getProgName
+getProgramName = fmap (`withoutSuffix` ".bin") getProgName
    where str `withoutSuffix` suff
             | suff `isSuffixOf` str = take (length str - length suff) str
             | otherwise             = str
@@ -341,25 +230,6 @@ getProgramName = liftM (`withoutSuffix` ".bin") getProgName
 bye :: String -> IO a
 bye s = putStr s >> exitSuccess
 
-
-dieMsg :: String -> IO ()
-dieMsg s = getProgramName >>= \prog -> die (prog ++ ": " ++ s)
-
-
-noDieMsg :: String -> IO ()
-noDieMsg s = getProgramName >>= \prog -> hPutStr stderr (prog ++ ": " ++ s)
-
-
-mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)]
-mapSnd _ [] = []
-mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs
-
-
-mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
-mapMaybeM _ Nothing = return Nothing
-mapMaybeM f (Just a) = liftM Just (f a)
-
-
 escapeStr :: String -> String
 escapeStr = escapeURIString isUnreserved
 
@@ -406,9 +276,9 @@ writeUtf8File filepath contents = withFile filepath WriteMode $ \h -> do
     hSetEncoding h utf8
     hPutStr h contents
 
-withTempDir :: (ExceptionMonad m) => FilePath -> m a -> m a
+withTempDir :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a
 withTempDir dir = bracket_ (liftIO $ createDirectory dir)
-                            (liftIO $ removeDirectoryRecursive dir)
+                           (liftIO $ removeDirectoryRecursive dir)
 
 -----------------------------------------------------------------------------
 -- * HTML cross references
diff --git a/haddock-api/src/Haddock/Utils/Json.hs b/haddock-api/src/Haddock/Utils/Json.hs
index e3c3dddc..2270a547 100644
--- a/haddock-api/src/Haddock/Utils/Json.hs
+++ b/haddock-api/src/Haddock/Utils/Json.hs
@@ -19,7 +19,7 @@ import Data.Char
 import Data.Int
 import Data.String
 import Data.Word
-import Data.List
+import Data.List (intersperse)
 import Data.Monoid
 
 import Data.ByteString.Builder (Builder)