Merge branch 'ghc-head' with 'ghc-8.4'

15 files changed, 1357 insertions, 1010 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index e7ce9d30..9a31428f 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Backends.Hoogle
@@ -73,21 +74,21 @@ dropHsDocTy :: HsType a -> HsType a
 dropHsDocTy = f
     where
         g (L src x) = L src (f x)
-        f (HsForAllTy a e) = HsForAllTy a (g e)
-        f (HsQualTy a e) = HsQualTy a (g e)
-        f (HsBangTy a b) = HsBangTy a (g b)
-        f (HsAppTy a b) = HsAppTy (g a) (g b)
-        f (HsFunTy a b) = HsFunTy (g a) (g b)
-        f (HsListTy a) = HsListTy (g a)
-        f (HsPArrTy a) = HsPArrTy (g a)
-        f (HsTupleTy a b) = HsTupleTy a (map g b)
-        f (HsOpTy a b c) = HsOpTy (g a) b (g c)
-        f (HsParTy a) = HsParTy (g a)
-        f (HsKindSig a b) = HsKindSig (g a) b
-        f (HsDocTy a _) = f $ unL a
+        f (HsForAllTy x a e) = HsForAllTy x a (g e)
+        f (HsQualTy x a e) = HsQualTy x a (g e)
+        f (HsBangTy x a b) = HsBangTy x a (g b)
+        f (HsAppTy x a b) = HsAppTy x (g a) (g b)
+        f (HsFunTy x a b) = HsFunTy x (g a) (g b)
+        f (HsListTy x a) = HsListTy x (g a)
+        f (HsPArrTy x a) = HsPArrTy x (g a)
+        f (HsTupleTy x a b) = HsTupleTy x a (map g b)
+        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 x = x
 
-outHsType :: (SourceTextX a, OutputableBndrId a)
+outHsType :: (a ~ GhcPass p, OutputableBndrId a)
           => DynFlags -> HsType a -> String
 outHsType dflags = out dflags . dropHsDocTy
 
@@ -125,20 +126,20 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl
                            , expItemFixities = fixities
                            } = ppDocumentation dflags dc ++ f decl
     where
-        f (TyClD d@DataDecl{})  = ppData dflags d subdocs
-        f (TyClD d@SynDecl{})   = ppSynonym dflags d
-        f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs
-        f (TyClD (FamDecl d))   = ppFam dflags d
-        f (ForD (ForeignImport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
-        f (ForD (ForeignExport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
-        f (SigD sig) = ppSig dflags sig ++ ppFixities
+        f (TyClD _ d@DataDecl{})  = ppData dflags d subdocs
+        f (TyClD _ d@SynDecl{})   = ppSynonym dflags d
+        f (TyClD _ d@ClassDecl{}) = ppClass dflags d subdocs
+        f (TyClD _ (FamDecl _ d)) = ppFam dflags d
+        f (ForD _ (ForeignImport _ name typ _)) = [pp_sig dflags [name] (hsSigType typ)]
+        f (ForD _ (ForeignExport _ name typ _)) = [pp_sig dflags [name] (hsSigType typ)]
+        f (SigD _ sig) = ppSig dflags sig ++ ppFixities
         f _ = []
 
         ppFixities = concatMap (ppFixity dflags) fixities
 ppExport _ _ = []
 
 ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
-ppSigWithDoc dflags (TypeSig names sig) subdocs
+ppSigWithDoc dflags (TypeSig _ names sig) subdocs
     = concatMap mkDocSig names
     where
         mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)]
@@ -189,7 +190,7 @@ ppClass dflags decl subdocs =
             , tcdTyVars = feqn_pats tfe
             , tcdFixity = feqn_fixity tfe
             , tcdRhs    = feqn_rhs tfe
-            , tcdFVs    = emptyNameSet
+            , tcdSExt   = emptyNameSet
             }
 
 ppFam :: DynFlags -> FamilyDecl GhcRn -> [String]
@@ -241,17 +242,17 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
 ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
 ppCtor dflags dat subdocs con@ConDeclH98 {}
   -- AZ:TODO get rid of the concatMap
-   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConDetails con)
+   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConArgs con)
     where
         f (PrefixCon args) = [typeSig name $ args ++ [resType]]
         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
         f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
-                          [(concatMap (lookupCon dflags subdocs . noLoc . selectorFieldOcc . unLoc) (cd_fld_names r)) ++
-                           [out dflags (map (selectorFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
+                          [(concatMap (lookupCon dflags subdocs . noLoc . extFieldOcc . unLoc) (cd_fld_names r)) ++
+                           [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
                           | r <- map unLoc recs]
 
-        funs = foldr1 (\x y -> reL $ HsFunTy x y)
-        apps = foldl1 (\x y -> reL $ HsAppTy x y)
+        funs = foldr1 (\x y -> reL $ HsFunTy NoExt x y)
+        apps = foldl1 (\x y -> reL $ HsAppTy NoExt x y)
 
         typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds)
 
@@ -259,20 +260,20 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         -- docs for con_names on why it is a list to begin with.
         name = commaSeparate dflags . map unL $ getConNames con
 
-        resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
-                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
+        resType = apps $ map (reL . HsTyVar NoExt NotPromoted . reL) $
+                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _ _) <- hsQTvExplicit $ tyClDeclTyVars dat]
 
-ppCtor dflags _dat subdocs con@ConDeclGADT {}
+ppCtor dflags _dat subdocs con@(ConDeclGADT { })
    = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
     where
-        f = [typeSig name (hsib_body $ con_type con)]
+        f = [typeSig name (getGADTConTypeG con)]
 
         typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty)
         name = out dflags $ map unL $ getConNames con
-
+ppCtor _ _ _ XConDecl {} = panic "haddock:ppCtor"
 
 ppFixity :: DynFlags -> (Name, Fixity) -> [String]
-ppFixity dflags (name, fixity) = [out dflags ((FixitySig [noLoc name] fixity) :: FixitySig GhcRn)]
+ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExt [noLoc name] fixity) :: FixitySig GhcRn)]
 
 
 ---------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index c4a9091f..220a59fe 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -13,6 +13,7 @@ import Haddock.Backends.Hyperlinker.Types
 
 import qualified GHC
 import qualified SrcLoc
+import qualified Outputable as GHC
 
 import Control.Applicative
 import Control.Monad (guard)
@@ -79,9 +80,9 @@ variables =
     everythingInRenamedSource (var `Syb.combine` rec)
   where
     var term = case cast term of
-        (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.HsVar _ name)) :: GHC.LHsExpr GHC.GhcRn)) ->
             pure (sspan, RtkVar (GHC.unLoc name))
-        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->
+        (Just (GHC.L _ (GHC.RecordCon _ (GHC.L sspan name) _))) ->
             pure (sspan, RtkVar name)
         _ -> empty
     rec term = case cast term of
@@ -95,9 +96,9 @@ types = everythingInRenamedSource ty
   where
     ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)]
     ty term = case cast term of
-        (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.HsTyVar _ _ name)) :: GHC.LHsType GHC.GhcRn)) ->
             pure (sspan, RtkType (GHC.unLoc name))
-        (Just ((GHC.L sspan (GHC.HsOpTy l name r)) :: GHC.LHsType GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.HsOpTy _ l name r)) :: GHC.LHsType GHC.GhcRn)) ->
             (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r)
         _ -> empty
 
@@ -112,20 +113,20 @@ binds = everythingInRenamedSource
       (fun `Syb.combine` pat `Syb.combine` tvar)
   where
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
+        (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
             pure (sspan, RtkBind name)
-        (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ args _ _))) ->
+        (Just (GHC.PatSynBind _ (GHC.PSB _ (GHC.L sspan name) args _ _))) ->
             pure (sspan, RtkBind name) ++ everythingInRenamedSource patsyn_binds args
         _ -> empty
     patsyn_binds term = case cast term of
         (Just (GHC.L sspan (name :: GHC.Name))) -> pure (sspan, RtkVar name)
         _ -> empty
     pat term = case cast term of
-        (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.VarPat _ name)) :: GHC.LPat GHC.GhcRn)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
             [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs
-        (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
+        (Just (GHC.L _ (GHC.AsPat _ (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
     rec term = case cast term of
@@ -133,9 +134,9 @@ binds = everythingInRenamedSource
             pure (sspan, RtkVar name)
         _ -> empty
     tvar term = case cast term of
-        (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
+        (Just ((GHC.L sspan (GHC.UserTyVar _ name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
             pure (sspan, RtkBind (GHC.unLoc name))
-        (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
+        (Just (GHC.L _ (GHC.KindedTyVar _ (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
 
@@ -150,16 +151,17 @@ decls (group, _, _, _) = concatMap ($ group)
   where
     typ (GHC.L _ t) = case t of
         GHC.DataDecl { tcdLName = name } -> pure . decl $ name
-        GHC.SynDecl name _ _ _ _ -> pure . decl $ name
-        GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
+        GHC.SynDecl _ name _ _ _ -> pure . decl $ name
+        GHC.FamDecl _ fam -> pure . decl $ GHC.fdLName fam
         GHC.ClassDecl{..} ->
           [decl tcdLName]
             ++ concatMap sig tcdSigs
             ++ concatMap tyfam tcdATs
+        GHC.XTyClDecl {} -> GHC.panic "haddock:decls"
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
+        (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
-        (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _)))
+        (Just (GHC.PatSynBind _ (GHC.PSB _ (GHC.L sspan name) _ _ _)))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
     con term = case cast term of
@@ -168,24 +170,24 @@ decls (group, _, _, _) = concatMap ($ group)
               ++ everythingInRenamedSource fld cdcl
         Nothing -> empty
     ins term = case cast term of
-        (Just ((GHC.DataFamInstD (GHC.DataFamInstDecl eqn))
+        (Just ((GHC.DataFamInstD _ (GHC.DataFamInstDecl eqn))
                 :: GHC.InstDecl GHC.GhcRn))
           -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
-        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl eqn))) ->
+        (Just (GHC.TyFamInstD _ (GHC.TyFamInstDecl eqn))) ->
             pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
         _ -> empty
     fld term = case cast term of
         Just (field :: GHC.ConDeclField GHC.GhcRn)
-          -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
+          -> map (decl . fmap GHC.extFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
     fix term = case cast term of
-        Just ((GHC.FixitySig names _) :: GHC.FixitySig GHC.GhcRn)
+        Just ((GHC.FixitySig _ names _) :: GHC.FixitySig GHC.GhcRn)
           -> map (\(GHC.L sspan x) -> (sspan, RtkVar x)) names
         Nothing -> empty
     tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
-    sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
-    sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names
-    sig (GHC.L _ (GHC.ClassOpSig _ names _)) = map decl names
+    sig (GHC.L _ (GHC.TypeSig _ names _)) = map decl names
+    sig (GHC.L _ (GHC.PatSynSig _ names _)) = map decl names
+    sig (GHC.L _ (GHC.ClassOpSig _ _ names _)) = map decl names
     sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
@@ -199,12 +201,12 @@ imports src@(_, imps, _, _) =
     everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
-        (Just ((GHC.IEVar v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v
-        (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t
-        (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t
-        (Just (GHC.IEThingWith t _ vs _fls)) ->
+        (Just ((GHC.IEVar _ v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v
+        (Just (GHC.IEThingAbs _ t)) -> pure $ typ $ GHC.ieLWrappedName t
+        (Just (GHC.IEThingAll _ t)) -> pure $ typ $ GHC.ieLWrappedName t
+        (Just (GHC.IEThingWith _ t _ vs _fls)) ->
           [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs
-        (Just (GHC.IEModuleContents m)) -> pure $ modu m
+        (Just (GHC.IEModuleContents _ m)) -> pure $ modu m
         _ -> empty
     typ (GHC.L sspan name) = (sspan, RtkType name)
     var (GHC.L sspan name) = (sspan, RtkVar name)
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 38fccf0c..d06e85d1 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -179,13 +179,14 @@ string_txt (PStr s1) s2 = unpackFS s1 ++ s2
 string_txt (ZStr s1) s2 = zString s1 ++ s2
 string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
 
-
+-- | Prints out an entry in a module export list.
 exportListItem :: ExportItem DocNameI -> LaTeX
 exportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs }
-  = sep (punctuate comma . map ppDocBinder $ declNames decl) <>
-     case subdocs of
-       [] -> empty
-       _  -> parens (sep (punctuate comma (map (ppDocBinder . fst) subdocs)))
+  = let (leader, names) = declNames decl
+    in sep (punctuate comma [ leader <+> ppDocBinder name | name <- names ]) <>
+         case subdocs of
+           [] -> empty
+           _  -> parens (sep (punctuate comma (map (ppDocBinder . fst) subdocs)))
 exportListItem (ExportNoDecl y [])
   = ppDocBinder y
 exportListItem (ExportNoDecl y subs)
@@ -215,7 +216,7 @@ processExports (e : es) =
 
 
 isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
-isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD _ (TypeSig _ lnames t))
                        , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
   | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))
 isSimpleSig _ = Nothing
@@ -249,13 +250,17 @@ ppDocGroup lev doc = sec lev <> braces doc
         sec _ = text "\\paragraph"
 
 
-declNames :: LHsDecl DocNameI -> [DocName]
+-- | Given a declaration, extract out the names being declared
+declNames :: LHsDecl DocNameI
+          -> ( LaTeX           -- ^ to print before each name in an export list
+             , [DocName]       -- ^ names being declared
+             )
 declNames (L _ decl) = case decl of
-  TyClD d  -> [tcdName d]
-  SigD (TypeSig lnames _ ) -> map unLoc lnames
-  SigD (PatSynSig lnames _) -> map unLoc lnames
-  ForD (ForeignImport (L _ n) _ _ _) -> [n]
-  ForD (ForeignExport (L _ n) _ _ _) -> [n]
+  TyClD _ d  -> (empty, [tcdName d])
+  SigD _ (TypeSig _ lnames _ ) -> (empty, map unLoc lnames)
+  SigD _ (PatSynSig _ lnames _) -> (text "pattern", map unLoc lnames)
+  ForD _ (ForeignImport _ (L _ n) _ _) -> (empty, [n])
+  ForD _ (ForeignExport _ (L _ n) _ _) -> (empty, [n])
   _ -> error "declaration not supported by declNames"
 
 
@@ -278,47 +283,44 @@ moduleBasename mdl = map (\c -> if c == '.' then '-' else c)
 -- * Decls
 -------------------------------------------------------------------------------
 
-
-ppDecl :: LHsDecl DocNameI
-       -> [(HsDecl DocNameI, DocForDecl DocName)]
-       -> DocForDecl DocName
-       -> [DocInstance DocNameI]
-       -> [(DocName, DocForDecl DocName)]
-       -> [(DocName, Fixity)]
+-- | Pretty print a declaration
+ppDecl :: LHsDecl DocNameI                         -- ^ decl to print
+       -> [(HsDecl DocNameI, DocForDecl DocName)]  -- ^ all pattern decls
+       -> DocForDecl DocName                       -- ^ documentation for decl
+       -> [DocInstance DocNameI]                   -- ^ all instances
+       -> [(DocName, DocForDecl DocName)]          -- ^ all subdocs
+       -> [(DocName, Fixity)]                      -- ^ all fixities
        -> LaTeX
 
-ppDecl (L loc decl) pats (doc, fnArgsDoc) instances subdocs _fixities = case decl of
-  TyClD d@(FamDecl {})          -> ppTyFam False loc doc d unicode
-  TyClD d@(DataDecl {})
-                                -> ppDataDecl pats instances subdocs loc (Just doc) d unicode
-  TyClD d@(SynDecl {})          -> ppTySyn loc (doc, fnArgsDoc) d unicode
+ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
+  TyClD _ d@FamDecl {}         -> ppTyFam False doc 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
---  TyClD d@(TySynonym {})
+--  TyClD _ d@TySynonym{}
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
-  TyClD d@(ClassDecl {})    -> ppClassDecl instances loc doc subdocs d unicode
-  SigD (TypeSig lnames t)   -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)
-                                        (hsSigWcType t) unicode
-  SigD (PatSynSig lnames ty) ->
-      ppLPatSig loc (doc, fnArgsDoc) (map unLoc lnames) ty unicode
-  ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode
-  InstD _                        -> empty
-  DerivD _                       -> empty
+  TyClD _ d@ClassDecl{}          -> ppClassDecl instances doc subdocs d unicode
+  SigD _ (TypeSig _ lnames ty)   -> ppFunSig (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
+  DerivD _ _                     -> empty
   _                              -> error "declaration not supported by ppDecl"
   where
     unicode = False
 
 
-ppTyFam :: Bool -> SrcSpan -> Documentation DocName ->
+ppTyFam :: Bool -> Documentation DocName ->
               TyClDecl DocNameI -> Bool -> LaTeX
-ppTyFam _ _ _ _ _ =
+ppTyFam _ _ _ _ =
   error "type family declarations are currently not supported by --latex"
 
 
-ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
-ppFor loc doc (ForeignImport (L _ name) typ _ _) unicode =
-  ppFunSig loc doc [name] (hsSigType typ) unicode
-ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
+ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
+ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
+  ppFunSig doc [name] (hsSigType typ) unicode
+ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 --  error "foreign declarations are currently not supported by --latex"
 
 
@@ -328,18 +330,18 @@ ppFor _ _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 
 
 -- we skip type patterns for now
-ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
+ppTySyn :: DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
 
-ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+ppTySyn doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
                          , tcdRhs = ltype }) unicode
-  = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
+  = ppTypeOrFunSig (unLoc ltype) doc (full, hdr, char '=') unicode
   where
     hdr  = hsep (keyword "type"
                  : ppDocBinder name
                  : map ppSymName (tyvarNames ltyvars))
     full = hdr <+> char '=' <+> ppLType unicode ltype
 
-ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
+ppTySyn _ _ _ = error "declaration not supported by ppTySyn"
 
 
 -------------------------------------------------------------------------------
@@ -347,61 +349,98 @@ ppTySyn _ _ _ _ = error "declaration not supported by ppTySyn"
 -------------------------------------------------------------------------------
 
 
-ppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocNameI
+ppFunSig :: DocForDecl DocName -> [DocName] -> LHsType DocNameI
          -> Bool -> LaTeX
-ppFunSig loc doc docnames (L _ typ) unicode =
-  ppTypeOrFunSig loc docnames typ doc
+ppFunSig doc docnames (L _ typ) unicode =
+  ppTypeOrFunSig typ doc
     ( ppTypeSig names typ False
     , hsep . punctuate comma $ map ppSymName names
-    , dcolon unicode)
+    , dcolon unicode
+    )
     unicode
  where
    names = map getName docnames
 
-ppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName]
-          -> LHsSigType DocNameI
-          -> Bool -> LaTeX
-ppLPatSig _loc (doc, _argDocs) docnames ty unicode
-  = declWithDoc pref1 (documentationToLaTeX doc)
+-- | Pretty-print a pattern synonym
+ppLPatSig :: DocForDecl DocName  -- ^ documentation
+          -> [DocName]           -- ^ pattern names in the pattern signature
+          -> LHsSigType DocNameI -- ^ type of the pattern synonym
+          -> 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
-    pref1 = hsep [ keyword "pattern"
-                 , hsep $ punctuate comma $ map ppDocBinder docnames
-                 , dcolon unicode
-                 , ppLType unicode (hsSigType ty)
-                 ]
-
-ppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocNameI
-               -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)
-               -> Bool -> LaTeX
-ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)
-               unicode
-  | Map.null argDocs =
-      declWithDoc pref1 (documentationToLaTeX doc)
-  | otherwise        =
-      declWithDoc pref2 $ Just $
+    typ = unLoc (hsSigType ty)
+    names = map getName docnames
+
+-- | Pretty-print a type, adding documentation to the whole type and its
+-- arguments as needed.
+ppTypeOrFunSig :: HsType DocNameI
+               -> DocForDecl DocName  -- ^ documentation
+               -> ( LaTeX             -- ^ first-line (no-argument docs only)
+                  , LaTeX             -- ^ first-line (argument docs only)
+                  , LaTeX             -- ^ type prefix (argument docs only)
+                  )
+               -> Bool                -- ^ unicode
+               -> LaTeX
+ppTypeOrFunSig typ (doc, argDocs) (pref1, pref2, sep0) unicode
+  | Map.null argDocs = declWithDoc pref1 (documentationToLaTeX doc)
+  | otherwise        = declWithDoc pref2 $ Just $
         text "\\haddockbeginargs" $$
-        do_args 0 sep0 typ $$
+        vcat (map (uncurry (<->)) (ppSubSigLike unicode typ argDocs [] sep0)) $$
         text "\\end{tabulary}\\par" $$
         fromMaybe empty (documentationToLaTeX doc)
+
+-- 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
+             -> HsType DocNameI       -- ^ type signature
+             -> FnArgsDoc DocName     -- ^ docs to add
+             -> [(DocName, DocForDecl DocName)] -- ^ all subdocs (useful when we have `HsRecTy`)
+             -> LaTeX                 -- ^ seperator (beginning of first line)
+             -> [(LaTeX, LaTeX)]      -- ^ arguments (leader/sep, type)
+ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ
   where
-     do_largs n leader (L _ t) = do_args n leader t
-
-     arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
-
-     do_args :: Int -> LaTeX -> HsType DocNameI -> LaTeX
-     do_args _n leader (HsForAllTy tvs ltype)
-       = decltt leader
-         <-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
-         <+> ppLType unicode ltype
-     do_args n leader (HsQualTy lctxt ltype)
-       = decltt leader
-         <-> ppLContextNoArrow lctxt unicode <+> nl $$
-             do_largs n (darrow unicode) ltype
-     do_args n leader (HsFunTy lt r)
-       = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$
-         do_largs (n+1) (arrow unicode) r
-     do_args n leader t
-       = decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl
+    do_largs n leader (L _ t) = do_args n leader t
+
+    arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
+
+    do_args :: Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
+    do_args _n leader (HsForAllTy _ tvs ltype)
+      = [ ( decltt leader
+          , decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
+              <+> ppLType unicode ltype
+          ) ]
+    do_args n leader (HsQualTy _ lctxt ltype)
+      = (decltt leader, ppLContextNoArrow lctxt unicode <+> nl)
+        : do_largs n (darrow unicode) ltype
+
+    do_args n leader (HsFunTy _ (L _ (HsRecTy _ fields)) r)
+      = [ (decltt ldr, latex <+> nl)
+        | (L _ field, ldr) <- zip fields (leader <+> gadtOpen : repeat gadtComma)
+        , let latex = ppSideBySideField subdocs unicode field
+        ]
+        ++ do_largs (n+1) (gadtEnd <+> arrow unicode) r
+    do_args n leader (HsFunTy _ lt r)
+      = (decltt leader, decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl)
+        : do_largs (n+1) (arrow unicode) r
+    do_args n leader t
+      = [ (decltt leader, decltt (ppType unicode t) <-> arg_doc n <+> nl) ]
+
+    -- FIXME: this should be done more elegantly
+    --
+    -- 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 "\\{"
 
 
 ppTypeSig :: [Name] -> HsType DocNameI  -> Bool -> LaTeX
@@ -483,10 +522,10 @@ ppFds fds unicode =
                            hsep (map (ppDocName . unLoc) vars2)
 
 
-ppClassDecl :: [DocInstance DocNameI] -> SrcSpan
+ppClassDecl :: [DocInstance DocNameI]
             -> Documentation DocName -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocNameI -> Bool -> LaTeX
-ppClassDecl instances loc doc subdocs
+ppClassDecl instances doc subdocs
   (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars, tcdFDs = lfds
              , tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs }) unicode
   = declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$
@@ -508,15 +547,15 @@ ppClassDecl instances loc doc subdocs
 
     methodTable =
       text "\\haddockpremethods{}\\textbf{Methods}" $$
-      vcat  [ ppFunSig loc doc [name] (hsSigWcType typ) unicode
-            | L _ (TypeSig lnames typ) <- lsigs
+      vcat  [ ppFunSig doc [name] (hsSigWcType typ) unicode
+            | L _ (TypeSig _ lnames typ) <- lsigs
             , name <- map unLoc lnames
             , let doc = lookupAnySubdoc name subdocs
             ]
 
     instancesBit = ppDocInstances unicode instances
 
-ppClassDecl _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppClassDecl _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX
 ppDocInstances _unicode [] = empty
@@ -565,15 +604,17 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
 -- * Data & newtype declarations
 -------------------------------------------------------------------------------
 
-
-ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -> [DocInstance DocNameI] ->
-              [(DocName, DocForDecl DocName)] -> SrcSpan ->
-              Maybe (Documentation DocName) -> TyClDecl DocNameI -> Bool ->
-              LaTeX
-ppDataDecl pats instances subdocs _loc doc dataDecl unicode
-
-   =  declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
-                  (if null body then Nothing else Just (vcat body))
+-- | Pretty-print a data declaration
+ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -- ^ relevant patterns
+           -> [DocInstance DocNameI]                  -- ^ relevant instances
+           -> [(DocName, DocForDecl DocName)]         -- ^ relevant decl docs
+           -> Maybe (Documentation DocName)           -- ^ this decl's docs
+           -> TyClDecl DocNameI                       -- ^ data decl to print
+           -> Bool                                    -- ^ unicode
+           -> LaTeX
+ppDataDecl pats instances subdocs doc dataDecl unicode =
+   declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)
+               (if null body then Nothing else Just (vcat body))
    $$ instancesBit
 
   where
@@ -585,28 +626,26 @@ ppDataDecl pats instances subdocs _loc doc dataDecl unicode
     (whereBit, leaders)
       | null cons
       , null pats = (empty,[])
-      | null cons = (decltt (keyword "where"), repeat empty)
+      | null cons = (text "where", repeat empty)
       | otherwise = case resTy of
-        ConDeclGADT{} -> (decltt (keyword "where"), repeat empty)
+        ConDeclGADT{} -> (text "where", repeat empty)
         _             -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
 
     constrBit
       | null cons = Nothing
       | otherwise = Just $
+          text "\\enspace" <+> emph (text "Constructors") <> text "\\par" $$
           text "\\haddockbeginconstrs" $$
           vcat (zipWith (ppSideBySideConstr subdocs unicode) leaders cons) $$
           text "\\end{tabulary}\\par"
 
     patternBit
-      | null cons = Nothing
-      | otherwise = Just $
+      | null pats = Nothing
+      | otherwise = Just $ 
+          text "\\enspace" <+> emph (text "Bundled Patterns") <> text "\\par" $$
           text "\\haddockbeginconstrs" $$
-          vcat [ hsep [ keyword "pattern"
-                      , hsep $ punctuate comma $ map (ppDocBinder . unLoc) lnames
-                      , dcolon unicode
-                      , ppLType unicode (hsSigType ty)
-                      ] <-> rDoc (fmap _doc . combineDocumentation . fst $ d)
-               | (SigD (PatSynSig lnames ty),d) <- pats
+          vcat [ empty <-> ppSideBySidePat lnames typ d unicode
+               | (SigD _ (PatSynSig _ lnames typ), d) <- pats
                ] $$
           text "\\end{tabulary}\\par"
 
@@ -625,41 +664,102 @@ ppConstrHdr forall tvs ctxt unicode
       False -> empty
 
 
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
-                   -> LConDecl DocNameI -> LaTeX
-ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
-  leader <->
-  case con_details con of
-
-    PrefixCon args ->
-      decltt (hsep ((header_ unicode <+> ppOcc) :
-                 map (ppLParendType unicode) args))
-      <-> rDoc mbDoc <+> nl
-
-    RecCon (L _ fields) ->
-      (decltt (header_ unicode <+> ppOcc)
-        <-> rDoc mbDoc <+> nl)
-      $$
-      doRecordFields fields
-
-    InfixCon arg1 arg2 ->
-      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
-                 ppOcc,
-                 ppLParendType unicode arg2 ])
-      <-> rDoc mbDoc <+> nl
+-- | Pretty-print a constructor
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)]  -- ^ all decl docs
+                   -> Bool                             -- ^ unicode
+                   -> LaTeX                            -- ^ prefix to decl
+                   -> LConDecl DocNameI                -- ^ constructor decl
+                   -> LaTeX
+ppSideBySideConstr subdocs unicode leader (L _ con) =
+  leader <-> decltt decl <-> rDoc mbDoc <+> nl
+  $$ fieldPart
+  where
+    -- Find the name of a constructors in the decl (`getConName` always returns
+    -- a non-empty list)
+    aConName = unLoc (head (getConNames con))
+
+    occ      = map (nameOccName . getName . unLoc) $ getConNames con
+
+    ppOcc      = cat (punctuate comma (map ppBinder occ))
+    ppOccInfix = cat (punctuate comma (map ppBinderInfix occ))
+
+    -- Extract out the map of of docs corresponding to the constructors arguments
+    argDocs = maybe Map.empty snd (lookup aConName subdocs)
+    hasArgDocs = not $ Map.null argDocs
+
+    -- First line of the constructor (no doc, no fields, single-line)
+    decl = case con of
+      ConDeclH98{ con_args = det
+                , con_ex_tvs = vars
+                , con_mb_cxt = cxt
+                } -> let tyVars = map (getName . hsLTyVarName) vars
+                         context = unLoc (fromMaybe (noLoc []) cxt)
+                         forall_ = False
+                         header_ = ppConstrHdr forall_ tyVars context unicode
+                     in case det of
+        -- Prefix constructor, e.g. 'Just a'
+        PrefixCon args
+          | hasArgDocs -> header_ <+> ppOcc
+          | otherwise -> hsep [ header_
+                              , ppOcc
+                              , hsep (map (ppLParendType unicode) args)
+                              ]
+
+        -- Record constructor, e.g. 'Identity { runIdentity :: a }'
+        RecCon _ ->  header_ <+> ppOcc
+
+        -- Infix constructor, e.g. 'a :| [a]'
+        InfixCon arg1 arg2
+          | hasArgDocs -> header_ <+> ppOcc
+          | otherwise -> hsep [ header_
+                              , ppLParendType unicode arg1
+                              , ppOccInfix
+                              , ppLParendType unicode arg2
+                              ]
+
+      ConDeclGADT{}
+        | hasArgDocs || not (isEmpty fieldPart) -> ppOcc
+        | otherwise -> hsep [ ppOcc
+                            , dcolon unicode
+                            -- ++AZ++ make this prepend "{..}" when it is a record style GADT
+                            , ppLType unicode (getGADTConType con)
+                            ]
+      XConDecl{} -> panic "haddock:ppSideBySideConstr"
+
+    fieldPart = case (con, getConArgs con) of
+        -- Record style GADTs
+        (ConDeclGADT{}, RecCon _)            -> doConstrArgsWithDocs []
+
+        -- Regular record declarations
+        (_, RecCon (L _ fields))             -> doRecordFields fields
+
+        -- Any GADT or a regular H98 prefix data constructor
+        (_, PrefixCon args)     | hasArgDocs -> doConstrArgsWithDocs args
+
+        -- An infix H98 data constructor
+        (_, InfixCon arg1 arg2) | hasArgDocs -> doConstrArgsWithDocs [arg1,arg2]
+
+        _ -> empty
 
- where
     doRecordFields fields =
-        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
+      vcat [ empty <-> tt (text begin) <+> ppSideBySideField subdocs unicode field <+> nl
+           | (begin, L _ field) <- zip ("\\qquad \\{" : repeat "\\qquad ,") fields
+           ]
+      $$
+      empty <-> tt (text "\\qquad \\}") <+> nl
 
+    doConstrArgsWithDocs args = vcat $ map (\l -> empty <-> text "\\qquad" <+> l) $ case con of
+      ConDeclH98{} ->
+        [ decltt (ppLParendType unicode arg) <-> rDoc (fmap _doc mdoc) <+> nl
+        | (i, arg) <- zip [0..] args
+        , let mdoc = Map.lookup i argDocs
+        ]
+      ConDeclGADT{} ->
+        [ l <+> text "\\enspace" <+> r
+        | (l,r) <- ppSubSigLike unicode (unLoc (getGADTConType con)) argDocs subdocs (dcolon unicode)
+        ]
+      XConDecl{} -> panic "haddock:doConstrArgsWithDocs"
 
-    header_ = ppConstrHdr False tyVars context
-    occ     = map (nameOccName . getName . unLoc) $ getConNames con
-    ppOcc   = case occ of
-      [one] -> ppBinder one
-      _     -> cat (punctuate comma (map ppBinder occ))
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
-    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
 
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
@@ -668,147 +768,49 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
               (cn:_) -> lookup (unLoc cn) subdocs >>=
                         fmap _doc . combineDocumentation . fst
 
-ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =
-  leader <->
-  doGADTCon (hsib_body $ con_type con)
-
- where
-    doGADTCon resTy = decltt (ppOcc <+> dcolon unicode <+>
-                               ppLType unicode resTy
-                            ) <-> rDoc mbDoc
-
-    occ     = map (nameOccName . getName . unLoc) $ getConNames con
-    ppOcc   = case occ of
-      [one] -> ppBinder one
-      _     -> cat (punctuate comma (map ppBinder occ))
-
-    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
-    -- or also because we want Haddock to do the doc-parsing, not GHC.
-    mbDoc = case getConNames con of
-              [] -> panic "empty con_names"
-              (cn:_) -> lookup (unLoc cn) subdocs >>=
-                        fmap _doc . combineDocumentation . fst
-{- old
-
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
-                   -> LConDecl DocName -> LaTeX
-ppSideBySideConstr subdocs unicode leader (L loc con) =
-  leader <->
-  case con_res con of
-  ResTyH98 -> case con_details con of
-
-    PrefixCon args ->
-      decltt (hsep ((header_ unicode <+> ppOcc) :
-                 map (ppLParendType unicode) args))
-      <-> rDoc mbDoc <+> nl
-
-    RecCon (L _ fields) ->
-      (decltt (header_ unicode <+> ppOcc)
-        <-> rDoc mbDoc <+> nl)
-      $$
-      doRecordFields fields
-
-    InfixCon arg1 arg2 ->
-      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
-                 ppOcc,
-                 ppLParendType unicode arg2 ])
-      <-> rDoc mbDoc <+> nl
-
-  ResTyGADT _ resTy -> case con_details con of
-    -- prefix & infix could also use hsConDeclArgTys if it seemed to
-    -- simplify the code.
-    PrefixCon args -> doGADTCon args resTy
-    cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
-                                     doRecordFields fields
-    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
-
- where
-    doRecordFields fields =
-        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
-
-    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+>
-                               ppLType unicode (mk_forall $ mk_phi $
-                                                foldr mkFunTy resTy args)
-                            ) <-> rDoc mbDoc
-
-
-    header_ = ppConstrHdr (con_explicit con) tyVars context
-    occ     = map (nameOccName . getName . unLoc) $ con_names con
-    ppOcc   = case occ of
-      [one] -> ppBinder one
-      _     -> cat (punctuate comma (map ppBinder occ))
-    ltvs    = con_qvars con
-    tyVars  = tyvarNames (con_qvars con)
-    context = unLoc (con_cxt con)
-
-    mk_forall ty | con_explicit con = L loc (HsForAllTy (hsQTvExplicit ltvs) ty)
-                 | otherwise        = ty
-    mk_phi ty | null context = ty
-              | otherwise    = L loc (HsQualTy (con_cxt con) ty)
-
-    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
-    -- or also because we want Haddock to do the doc-parsing, not GHC.
-    mbDoc = case con_names con of
-              [] -> panic "empty con_names"
-              (cn:_) -> lookup (unLoc cn) subdocs >>=
-                        fmap _doc . combineDocumentation . fst
-    mkFunTy a b = noLoc (HsFunTy a b)
--}
 
+-- | Pretty-print a record field
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI ->  LaTeX
-ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
+ppSideBySideField subdocs unicode (ConDeclField _ names ltype _) =
   decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
     <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
-
--- {-
--- ppHsFullConstr :: HsConDecl -> LaTeX
--- ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) =
---      declWithDoc False doc (
--- 	hsep ((ppHsConstrHdr tvs ctxt +++
--- 		ppHsBinder False nm) : map ppHsBangType typeList)
---       )
--- ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) =
---    td << vanillaTable << (
---      case doc of
---        Nothing -> aboves [hdr, fields_html]
---        Just _  -> aboves [hdr, constr_doc, fields_html]
---    )
---
---   where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm)
---
--- 	constr_doc
--- 	  | isJust doc = docBox (docToLaTeX (fromJust doc))
--- 	  | otherwise  = LaTeX.emptyTable
---
--- 	fields_html =
--- 	   td <<
--- 	      table ! [width "100%", cellpadding 0, cellspacing 8] << (
--- 		   aboves (map ppFullField (concat (map expandField fields)))
--- 		)
--- -}
---
--- ppShortField :: Bool -> Bool -> ConDeclField DocName -> LaTeX
--- ppShortField summary unicode (ConDeclField (L _ name) ltype _)
---   = tda [theclass "recfield"] << (
---       ppBinder summary (docNameOcc name)
---       <+> dcolon unicode <+> ppLType unicode ltype
---     )
---
--- {-
--- ppFullField :: HsFieldDecl -> LaTeX
--- ppFullField (HsFieldDecl [n] ty doc)
---   = declWithDoc False doc (
--- 	ppHsBinder False n <+> dcolon <+> ppHsBangType ty
---     )
--- ppFullField _ = error "ppFullField"
---
--- expandField :: HsFieldDecl -> [HsFieldDecl]
--- expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ]
--- -}
+    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
+ppSideBySideField _ _ (XConDeclField _) = panic "haddock:ppSideBySideField"
+
+
+-- | Pretty-print a bundled pattern synonym
+ppSideBySidePat :: [Located DocName]    -- ^ pattern name(s)
+                -> LHsSigType DocNameI  -- ^ type of pattern(s)
+                -> DocForDecl DocName   -- ^ doc map
+                -> Bool                 -- ^ unicode
+                -> LaTeX
+ppSideBySidePat lnames typ (doc, argDocs) unicode =
+  decltt decl <-> rDoc mDoc <+> nl
+  $$ fieldPart
+  where
+    hasArgDocs = not $ Map.null argDocs
+    ppOcc = hsep (punctuate comma (map (ppDocBinder . unLoc) lnames))
+
+    decl | hasArgDocs = keyword "pattern" <+> ppOcc
+         | otherwise = hsep [ keyword "pattern"
+                            , ppOcc
+                            , dcolon unicode
+                            , ppLType unicode (hsSigType typ)
+                            ]
+
+    fieldPart
+      | not hasArgDocs = empty
+      | otherwise = vcat
+          [ empty <-> text "\\qquad" <+> l <+> text "\\enspace" <+> r
+          | (l,r) <- ppSubSigLike unicode (unLoc patTy) argDocs [] (dcolon unicode)
+          ]
+
+    patTy = hsSigType typ
+
+    mDoc = fmap _doc $ combineDocumentation doc
 
 
 -- | Print the LHS of a data\/newtype declaration.
@@ -824,6 +826,7 @@ ppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars
     ppAppDocNameNames False name (tyvarNames tyvars)
 ppDataHeader _ _ = error "ppDataHeader: illegal argument"
 
+
 --------------------------------------------------------------------------------
 -- * Type applications
 --------------------------------------------------------------------------------
@@ -955,57 +958,57 @@ ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode
 
 
 ppr_mono_ty :: Int -> HsType DocNameI -> Bool -> LaTeX
-ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode
+ppr_mono_ty ctxt_prec (HsForAllTy _ tvs ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
     sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
         , ppr_mono_lty pREC_TOP ty unicode ]
-ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode
+ppr_mono_ty ctxt_prec (HsQualTy _ ctxt ty) unicode
   = maybeParen ctxt_prec pREC_FUN $
     sep [ ppLContext ctxt unicode
         , ppr_mono_lty pREC_TOP ty unicode ]
 
-ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _         (HsTyVar NotPromoted (L _ name)) _ = ppDocName name
-ppr_mono_ty _         (HsTyVar Promoted    (L _ name)) _ = char '\'' <> ppDocName name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
-ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
-ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
-ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsIParamTy (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsBangTy _ b ty)     u = ppBang b <> ppLParendType u ty
+ppr_mono_ty _         (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name
+ppr_mono_ty _         (HsTyVar _ Promoted    (L _ name)) _ = char '\'' <> ppDocName name
+ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
+ppr_mono_ty _         (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys)
+ppr_mono_ty _         (HsSumTy _ tys) u       = sumParens (map (ppLType u) tys)
+ppr_mono_ty _         (HsKindSig _ ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
+ppr_mono_ty _         (HsListTy _ ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsPArrTy _ ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
+ppr_mono_ty _         (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
-ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
-ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsRecTy {})        _ = text "{..}"
+ppr_mono_ty _         (XHsType (NHsCoreTy {}))  _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
 
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
+ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode
   = maybeParen ctxt_prec pREC_OP $
     ppr_mono_lty pREC_OP ty1 unicode <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode
 
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
+ppr_mono_ty ctxt_prec (HsAppTy _ fun_ty arg_ty) unicode
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
+ppr_mono_ty ctxt_prec (HsOpTy _ ty1 op ty2) unicode
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
   where
     ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op
     occName = nameOccName . getName . unLoc $ op
 
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode
+ppr_mono_ty ctxt_prec (HsParTy _ ty) unicode
 --  = parens (ppr_mono_lty pREC_TOP ty)
   = ppr_mono_lty ctxt_prec ty unicode
 
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
+ppr_mono_ty ctxt_prec (HsDocTy _ ty _) unicode
   = ppr_mono_lty ctxt_prec ty unicode
 
 ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
 
-ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
+ppr_mono_ty _ (HsTyLit _ t) u = ppr_tylit t u
 
 ppr_mono_ty _ (HsAppsTy {}) _ = panic "ppr_mono_ty:HsAppsTy"
 
@@ -1036,6 +1039,11 @@ ppBinder n
   | isInfixName n = parens $ ppOccName n
   | otherwise     = ppOccName n
 
+ppBinderInfix :: OccName -> LaTeX
+ppBinderInfix n
+  | isInfixName n = ppOccName n
+  | otherwise     = cat [ char '`', ppOccName n, char '`' ]
+
 isInfixName :: OccName -> Bool
 isInfixName n = isVarSym n || isConSym n
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index c9a262a4..6da6a2e8 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -667,7 +667,7 @@ numberSectionHeadings = go 1
 
 processExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification
               -> ExportItem DocNameI -> Maybe Html
-processExport _ _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
+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)
 processExport summary links unicode pkg qual (ExportDecl decl pats doc subdocs insts fixities splice)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 815ecee9..3fbe6eaf 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -39,24 +39,34 @@ import GHC.Exts
 import Name
 import BooleanFormula
 import RdrName ( rdrNameOcc )
-
-ppDecl :: Bool -> LinksInfo -> LHsDecl DocNameI
-       -> [(HsDecl DocNameI, DocForDecl DocName)]
-       -> DocForDecl DocName ->  [DocInstance DocNameI] -> [(DocName, Fixity)]
-       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode
-       -> Maybe Package -> Qualification -> Html
+import Outputable ( panic )
+
+-- | Pretty print a declaration
+ppDecl :: Bool                                     -- ^ print summary info only
+       -> LinksInfo                                -- ^ link information
+       -> LHsDecl DocNameI                         -- ^ declaration to print
+       -> [(HsDecl DocNameI, DocForDecl DocName)]  -- ^ relevant pattern synonyms
+       -> DocForDecl DocName                       -- ^ documentation for this decl
+       -> [DocInstance DocNameI]                   -- ^ relevant instances
+       -> [(DocName, Fixity)]                      -- ^ relevant fixities
+       -> [(DocName, DocForDecl DocName)]          -- ^ documentation for all decls
+       -> Splice
+       -> Unicode                                  -- ^ unicode output
+       -> Maybe Package
+       -> Qualification
+       -> Html
 ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of
-  TyClD (FamDecl d)            -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual
-  TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual
-  TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual
-  TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual
-  SigD (TypeSig lnames lty)    -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
+  TyClD _ (FamDecl _ d)          -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual
+  TyClD _ d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual
+  TyClD _ d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual
+  TyClD _ d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual
+  SigD _ (TypeSig _ lnames lty)  -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
                                          (hsSigWcType lty) fixities splice unicode pkg qual
-  SigD (PatSynSig lnames ty)   -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
-                                         ty fixities splice unicode pkg qual
-  ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
-  InstD _                      -> noHtml
-  DerivD _                     -> noHtml
+  SigD _ (PatSynSig _ lnames lty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
+                                         (hsSigType lty) fixities splice unicode pkg qual
+  ForD _ d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
+  InstD _ _                      -> noHtml
+  DerivD _ _                     -> noHtml
   _                            -> error "declaration not supported by ppDecl"
 
 
@@ -76,21 +86,18 @@ ppFunSig summary links loc doc docnames typ fixities splice unicode pkg qual =
   where
     pp_typ = ppLType unicode qual HideEmptyContexts typ
 
-ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-             [Located DocName] -> LHsSigType DocNameI ->
-             [(DocName, Fixity)] ->
-             Splice -> Unicode -> Maybe Package -> Qualification -> Html
-ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice
-          unicode pkg qual
-  | summary = pref1
-  | otherwise = topDeclElem links loc splice (map unLoc docnames) (pref1 <+> ppFixities fixities qual)
-                +++ docSection Nothing pkg qual doc
+-- | Pretty print a pattern synonym
+ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
+          -> [Located DocName]     -- ^ names of patterns in declaration
+          -> LHsType DocNameI      -- ^ type of patterns in declaration
+          -> [(DocName, Fixity)]
+          -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppLPatSig summary links loc doc lnames typ fixities splice unicode pkg qual =
+  ppSigLike summary links loc (keyword "pattern") doc (map unLoc lnames) fixities
+            (unLoc typ, pp_typ) splice unicode pkg qual (patSigContext typ)
   where
-    pref1 = hsep [ keyword "pattern"
-                 , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames
-                 , dcolon unicode
-                 , ppPatSigType unicode qual (hsSigType typ)
-                 ]
+    pp_typ = ppPatSigType unicode qual typ
+
 
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
              [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
@@ -99,7 +106,7 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
           splice unicode pkg qual emptyCtxts =
   ppTypeOrFunSig summary links loc docnames typ doc
     ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
-    , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
+    , (leader <+>) . addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
     , dcolon unicode
     )
     splice unicode pkg qual emptyCtxts
@@ -118,36 +125,72 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
                splice unicode pkg qual emptyCtxts
   | summary = pref1
   | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc
-  | otherwise = topDeclElem links loc splice docnames pref2 +++
-      subArguments pkg qual (do_args 0 sep typ) +++ docSection curName pkg qual doc
+  | otherwise = topDeclElem links loc splice docnames pref2
+                  +++ subArguments pkg qual (ppSubSigLike unicode qual typ argDocs [] sep emptyCtxts)
+                  +++ docSection curName pkg qual doc
   where
     curName = getName <$> listToMaybe docnames
+
+
+-- 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.
+ppSubSigLike :: Unicode -> Qualification
+             -> HsType DocNameI                  -- ^ type signature
+             -> FnArgsDoc DocName                -- ^ docs to add
+             -> [(DocName, DocForDecl DocName)]  -- ^ all subdocs (useful when
+                                                 -- we expand an `HsRecTy`)
+             -> Html -> HideEmptyContexts -> [SubDecl]
+ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
+  where
     argDoc n = Map.lookup n argDocs
 
     do_largs n leader (L _ t) = do_args n leader t
 
     do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
-    do_args n leader (HsForAllTy tvs ltype)
+    do_args n leader (HsForAllTy _ tvs ltype)
       = do_largs n leader' ltype
       where
         leader' = leader <+> ppForAll tvs unicode qual
 
-    do_args n leader (HsQualTy lctxt ltype)
+    do_args n leader (HsQualTy _ lctxt ltype)
       | null (unLoc lctxt)
       = do_largs n leader ltype
       | otherwise
       = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, [])
         : do_largs n (darrow unicode) ltype
 
-    do_args n leader (HsFunTy lt r)
+    do_args n leader (HsFunTy _ (L _ (HsRecTy _ fields)) r)
+      = [ (ldr <+> html, mdoc, subs)
+        | (L _ field, ldr) <- zip fields (leader <+> gadtOpen : repeat gadtComma)
+        , let (html, mdoc, subs) = ppSideBySideField subdocs unicode qual field
+        ]
+        ++ do_largs (n+1) (gadtEnd <+> arrow unicode) r
+
+    do_args n leader (HsFunTy _ lt r)
       = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, [])
         : do_largs (n+1) (arrow unicode) r
+
     do_args n leader t
       = [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])]
 
+
+    -- FIXME: this should be done more elegantly
+    --
+    -- 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 = concatHtml (replicate (if unicode then 2 else 3) spaceHtml) <> toHtml ","
+    gadtEnd = concatHtml (replicate (if unicode then 2 else 3) spaceHtml) <> toHtml "}"
+    gadtOpen = toHtml "{"
+
+
+
 ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html
 ppForAll tvs unicode qual =
-  case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- tvs] of
+  case [ppKTv n k | L _ (KindedTyVar _ (L _ n) k) <- tvs] of
     [] -> noHtml
     ts -> forallSymbol unicode <+> hsep ts +++ dot
   where ppKTv n k = parens $
@@ -186,7 +229,7 @@ tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocNameI -> [(DocName, Fixity)]
       -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) typ _ _) fixities
+ppFor summary links loc doc (ForeignImport _ (L _ name) typ _) fixities
       splice unicode pkg qual
   = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode pkg qual
 ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
@@ -279,12 +322,14 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
      ClosedTypeFamily _ -> keyword "where ..."
      _                  -> mempty
   )
+ppTyFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppTyFamHeader"
 
 ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html
 ppResultSig result unicode qual = case result of
-    NoSig               -> noHtml
-    KindSig kind        -> dcolon unicode  <+> ppLKind unicode qual kind
-    TyVarSig (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
+    NoSig _               -> noHtml
+    KindSig _ kind        -> dcolon unicode  <+> ppLKind unicode qual kind
+    TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
+    XFamilyResultSig _    -> panic "haddock:ppResultSig"
 
 ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI
                      -> Html
@@ -330,6 +375,8 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
       = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
         , Nothing, [] )
+    ppTyFamEqn (XHsImplicitBndrs _) = panic "haddock:ppTyFam"
+    ppTyFamEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppTyFam"
 
 
 
@@ -363,6 +410,7 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =
 ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocNameI -> Html
 ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
   ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs)
+ppFamDeclBinderWithVars _ _ _ (XFamilyDecl _) = panic "haddock:ppFamDeclBinderWithVars"
 
 -- | Print a newtype / data binder and its variables
 ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html
@@ -477,7 +525,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
             [ ppFunSig summary links loc doc names (hsSigWcType typ)
                        [] splice unicode pkg qual
-              | L _ (TypeSig lnames typ) <- sigs
+              | L _ (TypeSig _ lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -525,7 +573,7 @@ ppClassDecl summary links instances fixities loc d subdocs
 
     methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ)
                                       subfixs splice unicode pkg qual
-                           | L _ (ClassOpSig _ lnames typ) <- lsigs
+                           | L _ (ClassOpSig _ _ lnames typ) <- lsigs
                            , name <- map unLoc lnames
                            , let doc = lookupAnySubdoc name subdocs
                                  subfixs = [ f | f@(n',_) <- fixities
@@ -534,15 +582,15 @@ ppClassDecl summary links instances fixities loc d subdocs
                            -- N.B. taking just the first name is ok. Signatures with multiple names
                            -- are expanded so that each name gets its own signature.
 
-    minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of
+    minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
-                   sort [getName n | TypeSig ns _ <- sigs, L _ n <- ns]
+                   sort [getName n | TypeSig _ ns _ <- sigs, L _ n <- ns]
         -> noHtml
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns]
+                        [getName n' | L _ (TypeSig _ ns _) <- lsigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
@@ -645,7 +693,7 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
               -> [Sig DocNameI]
               -> [Html]
 ppInstanceSigs links splice unicode qual sigs = do
-    TypeSig lnames typ <- sigs
+    TypeSig _ lnames typ <- sigs
     let names = map unLoc lnames
         L _ rtyp = hsSigWcType typ
     -- Instance methods signatures are synified and thus don't have a useful
@@ -706,21 +754,27 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual
     isH98     = case unLoc (head cons) of
                   ConDeclH98 {} -> True
                   ConDeclGADT{} -> False
+                  XConDecl{}    -> False
 
     pats1 = [ hsep [ keyword "pattern"
                    , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames
                    , dcolon unicode
                    , ppPatSigType unicode qual (hsSigType typ)
                    ]
-            | (SigD (PatSynSig lnames typ),_) <- pats
+            | (SigD _ (PatSynSig _ lnames typ),_) <- pats
             ]
 
 
-ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)] ->
-              [(DocName, DocForDecl DocName)] ->
-              SrcSpan -> Documentation DocName -> TyClDecl DocNameI ->
-              [(HsDecl DocNameI, DocForDecl DocName)] ->
-              Splice -> Unicode -> Maybe Package -> Qualification -> Html
+-- | Pretty-print a data declaration
+ppDataDecl :: Bool -> LinksInfo
+           -> [DocInstance DocNameI]                  -- ^ relevant instances
+           -> [(DocName, Fixity)]                     -- ^ relevant fixities
+           -> [(DocName, DocForDecl DocName)]         -- ^ all decl documentation
+           -> SrcSpan
+           -> Documentation DocName                   -- ^ this decl's documentation
+           -> TyClDecl DocNameI                       -- ^ this decl
+           -> [(HsDecl DocNameI, DocForDecl DocName)] -- ^ relevant patterns
+           -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
            splice unicode pkg qual
 
@@ -733,6 +787,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
     isH98     = case unLoc (head cons) of
                   ConDeclH98 {} -> True
                   ConDeclGADT{} -> False
+                  XConDecl{}    -> False
 
     header_ = topDeclElem links loc splice [docname] $
              ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix
@@ -749,25 +804,20 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
       [ ppSideBySideConstr subdocs subfixs unicode pkg qual c
       | c <- cons
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
-                                     (map unLoc (getConNames (unLoc c)))) fixities
+                                            (map unLoc (getConNames (unLoc c)))) fixities
       ]
 
     patternBit = subPatterns pkg qual
-      [ (hsep [ keyword "pattern"
-              , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames
-              , dcolon unicode
-              , ppPatSigType unicode qual (hsSigType typ)
-              ] <+> ppFixities subfixs qual
-        ,combineDocumentation (fst d), [])
-      | (SigD (PatSynSig lnames typ),d) <- pats
-      , let subfixs = filter (\(n,_) -> any (\cn -> cn == n) (map unLoc lnames)) fixities
+      [ ppSideBySidePat subfixs unicode qual lnames typ d
+      | (SigD _ (PatSynSig _ lnames typ), d) <- pats
+      , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
+                                            (map unLoc lnames)) fixities
       ]
 
     instancesBit = ppInstances links (OriginData docname) instances
         splice unicode pkg qual
 
 
-
 ppShortConstr :: Bool -> ConDecl DocNameI -> Unicode -> Qualification -> Html
 ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
   where
@@ -777,121 +827,183 @@ ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
 -- returns three pieces: header, body, footer so that header & footer can be
 -- incorporated into the declaration
 ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualification -> (Html, Html, Html)
-ppShortConstrParts summary dataInst con unicode qual = case con of
-  ConDeclH98{} -> case con_details con of
-    PrefixCon args ->
-      (header_ unicode qual +++ hsep (ppOcc
-            : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml)
-    RecCon (L _ fields) ->
-      (header_ unicode qual +++ ppOcc <+> char '{',
-       doRecordFields fields,
-       char '}')
-    InfixCon arg1 arg2 ->
-      (header_ unicode qual +++ hsep [ppLParendType unicode qual HideEmptyContexts arg1,
-            ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2],
-       noHtml, noHtml)
-
-  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml)
-
-  where
-    resTy = hsib_body (con_type con)
-
-    doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) (map unLoc fields))
-
-    header_  = ppConstrHdr forall_ tyVars context
-    occ        = map (nameOccName . getName . unLoc) $ getConNames con
-
-    ppOcc      = case occ of
-      [one] -> ppBinder summary one
-      _     -> hsep (punctuate comma (map (ppBinder summary) occ))
+ppShortConstrParts summary dataInst con unicode qual
+  = case con of
+      ConDeclH98{ con_args = det
+                , con_ex_tvs = vars
+                , con_mb_cxt = cxt
+                } -> let tyVars = map (getName . hsLTyVarName) vars
+                         context = unLoc (fromMaybe (noLoc []) cxt)
+                         forall_ = False
+                         header_ = ppConstrHdr forall_ tyVars context unicode qual
+                     in case det of
+
+        -- Prefix constructor, e.g. 'Just a'
+        PrefixCon args ->
+          ( header_ +++ hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts) args)
+          , noHtml
+          , noHtml
+          )
 
-    ppOccInfix = case occ of
-      [one] -> ppBinderInfix summary one
-      _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ))
+        -- Record constructor, e.g. 'Identity { runIdentity :: a }'
+        RecCon (L _ fields) ->
+          ( header_ +++ ppOcc <+> char '{'
+          , shortSubDecls dataInst [ ppShortField summary unicode qual field
+                                   | L _ field <- fields
+                                   ]
+          , char '}'
+          )
 
-    ltvs     = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)
-    tyVars   = tyvarNames ltvs
-    lcontext = fromMaybe (noLoc []) (con_cxt con)
-    context  = unLoc lcontext
-    forall_  = False
+        -- Infix constructor, e.g. 'a :| [a]'
+        InfixCon arg1 arg2 ->
+          ( header_ +++ hsep [ ppLParendType unicode qual HideEmptyContexts arg1
+                             , ppOccInfix
+                             , ppLParendType unicode qual HideEmptyContexts arg2
+                             ]
+          , noHtml
+          , noHtml
+          )
 
+      -- GADT constructor, e.g. 'Foo :: Int -> Foo'
+      ConDeclGADT {} ->
+          ( hsep [ ppOcc, dcolon unicode, ppLType unicode qual HideEmptyContexts (getGADTConType con) ]
+          , noHtml
+          , noHtml
+          )
+      XConDecl {} -> panic "haddock:ppShortConstrParts"
 
--- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Unicode
-            -> Qualification -> Html
-ppConstrHdr forall_ tvs ctxt unicode qual
- = (if null tvs then noHtml else ppForall)
-   +++
-   (if null ctxt then noHtml
-    else ppContextNoArrow ctxt unicode qual HideEmptyContexts
-         <+> darrow unicode +++ toHtml " ")
   where
-    ppForall | forall_   = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs)
-                           <+> toHtml ". "
-             | otherwise = noHtml
+    occ        = map (nameOccName . getName . unLoc) $ getConNames con
+    ppOcc      = hsep (punctuate comma (map (ppBinder summary) occ))
+    ppOccInfix = hsep (punctuate comma (map (ppBinderInfix summary) occ))
 
+
+-- | Pretty print an expanded constructor
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
-                   -> Unicode -> Maybe Package -> Qualification -> LConDecl DocNameI -> SubDecl
+                   -> Unicode -> Maybe Package -> Qualification
+                   -> LConDecl DocNameI -- ^ constructor declaration to print
+                   -> SubDecl
 ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
- = (decl, mbDoc, fieldPart)
+ = ( decl       -- Constructor header (name, fixity)
+   , mbDoc      -- Docs on the whole constructor
+   , fieldPart  -- Information on the fields (or arguments, if they have docs)
+   )
  where
-    decl = case con of
-      ConDeclH98{} -> case con_details con of
-        PrefixCon args ->
-          hsep ((header_ +++ ppOcc)
-            : map (ppLParendType unicode qual HideEmptyContexts) args)
-          <+> fixity
+    -- Find the name of a constructors in the decl (`getConName` always returns a non-empty list)
+    aConName = unLoc (head (getConNames con))
 
-        RecCon _ -> header_ +++ ppOcc <+> fixity
+    fixity   = ppFixities fixities qual
+    occ      = map (nameOccName . getName . unLoc) $ getConNames con
 
-        InfixCon arg1 arg2 ->
-          hsep [header_ +++ ppLParendType unicode qual HideEmptyContexts arg1,
-            ppOccInfix,
-            ppLParendType unicode qual HideEmptyContexts arg2]
-          <+> fixity
+    ppOcc      = hsep (punctuate comma (map (ppBinder False) occ))
+    ppOccInfix = hsep (punctuate comma (map (ppBinderInfix False) occ))
 
-      ConDeclGADT{} -> doGADTCon resTy
+    -- Extract out the map of of docs corresponding to the constructors arguments
+    argDocs = maybe Map.empty snd (lookup aConName subdocs)
+    hasArgDocs = not $ Map.null argDocs
 
-    resTy = hsib_body (con_type con)
+    decl = case con of
+      ConDeclH98{ con_args = det
+                , con_ex_tvs = vars
+                , con_mb_cxt = cxt
+                } -> let tyVars = map (getName . hsLTyVarName) vars
+                         context = unLoc (fromMaybe (noLoc []) cxt)
+                         forall_ = False
+                         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) args)
+                              , fixity
+                              ]
+
+        -- Record constructor, e.g. 'Identity { runIdentity :: a }'
+        RecCon _ -> header_ +++ ppOcc <+> fixity
+
+        -- Infix constructor, e.g. 'a :| [a]'
+        InfixCon arg1 arg2
+          | hasArgDocs -> header_ +++ ppOcc <+> fixity
+          | otherwise -> hsep [ header_ +++ ppLParendType unicode qual HideEmptyContexts arg1
+                              , ppOccInfix
+                              , ppLParendType unicode qual HideEmptyContexts arg2
+                              , fixity
+                              ]
+
+      -- GADT constructor, e.g. 'Foo :: Int -> Foo'
+      ConDeclGADT{}
+          | hasArgDocs || not (null fieldPart) -> ppOcc <+> fixity
+          | otherwise -> hsep [ ppOcc
+                              , dcolon unicode
+                              -- ++AZ++ make this prepend "{..}" when it is a record style GADT
+                              , ppLType unicode qual HideEmptyContexts (getGADTConType con)
+                              , fixity
+                              ]
+      XConDecl{} -> panic "haddock:ppSideBySideConstr"
+
+    fieldPart = case (con, getConArgs con) of
+        -- Record style GADTs
+        (ConDeclGADT{}, RecCon _)            -> [ doConstrArgsWithDocs [] ]
+
+        -- Regular record declarations
+        (_, RecCon (L _ fields))             -> [ doRecordFields fields ]
+
+        -- Any GADT or a regular H98 prefix data constructor
+        (_, PrefixCon args)     | hasArgDocs -> [ doConstrArgsWithDocs args ]
+
+        -- An infix H98 data constructor
+        (_, InfixCon arg1 arg2) | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ]
 
-    fieldPart = case getConDetails con of
-        RecCon (L _ fields) -> [doRecordFields fields]
         _ -> []
 
     doRecordFields fields = subFields pkg qual
       (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))
 
-    doGADTCon :: Located (HsType DocNameI) -> Html
-    doGADTCon ty = ppOcc <+> dcolon unicode
-        -- ++AZ++ make this prepend "{..}" when it is a record style GADT
-        <+> ppLType unicode qual HideEmptyContexts ty
-        <+> fixity
-
-    fixity  = ppFixities fixities qual
-    header_ = ppConstrHdr forall_ tyVars context unicode qual
-    occ       = map (nameOccName . getName . unLoc) $ getConNames con
-
-    ppOcc     = case occ of
-      [one] -> ppBinder False one
-      _     -> hsep (punctuate comma (map (ppBinder False) occ))
+    doConstrArgsWithDocs args = subFields pkg qual $ case con of
+      ConDeclH98{} ->
+        [ (ppLParendType unicode qual HideEmptyContexts arg, mdoc, [])
+        | (i, arg) <- zip [0..] args
+        , let mdoc = Map.lookup i argDocs
+        ]
+      ConDeclGADT{} ->
+        ppSubSigLike unicode qual (unLoc (getGADTConType con))
+                     argDocs subdocs (dcolon unicode) HideEmptyContexts
+      XConDecl{} -> panic "haddock:doConstrArgsWithDocs"
 
-    ppOccInfix = case occ of
-      [one] -> ppBinderInfix False one
-      _     -> hsep (punctuate comma (map (ppBinderInfix False) occ))
-
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
-    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
-    forall_ = False
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
     mbDoc = lookup (unLoc $ head $ getConNames con) subdocs >>=
             combineDocumentation . fst
 
 
+-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
+ppConstrHdr :: Bool               -- ^ print explicit foralls
+            -> [Name]             -- ^ 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 ". "
+
+    ppCtxt
+      | null ctxt = noHtml
+      | otherwise = ppContextNoArrow ctxt unicode qual HideEmptyContexts
+                      <+> darrow unicode +++ toHtml " "
+
+
+-- | Pretty-print a record field
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
                   -> ConDeclField DocNameI -> SubDecl
-ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
-  ( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
+ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) =
+  ( hsep (punctuate comma [ ppBinder False (rdrNameOcc field)
+                          | L _ name <- names
+                          , let field = (unLoc . rdrNameFieldOcc) name
+                          ])
       <+> dcolon unicode
       <+> ppLType unicode qual HideEmptyContexts ltype
   , mbDoc
@@ -900,13 +1012,49 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     -- Where there is more than one name, they all have the same documentation
-    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
+    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
+ppSideBySideField _ _ _ (XConDeclField _) = panic "haddock:ppSideBySideField"
 
 
 ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
-ppShortField summary unicode qual (ConDeclField names ltype _)
+ppShortField summary unicode qual (ConDeclField _ names ltype _)
   = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))
     <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype
+ppShortField _ _ _ (XConDeclField _) = panic "haddock:ppShortField"
+
+
+-- | Pretty print an expanded pattern (for bundled patterns)
+ppSideBySidePat :: [(DocName, Fixity)] -> Unicode -> Qualification
+                   -> [Located DocName]    -- ^ pattern name(s)
+                   -> LHsSigType DocNameI  -- ^ type of pattern(s)
+                   -> DocForDecl DocName   -- ^ doc map
+                   -> SubDecl
+ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) =
+  ( decl
+  , combineDocumentation doc
+  , fieldPart
+  )
+  where
+    hasArgDocs = not $ Map.null argDocs
+    fixity = ppFixities fixities qual
+    ppOcc = hsep (punctuate comma (map (ppBinder False . getOccName) lnames))
+
+    decl | hasArgDocs = keyword "pattern" <+> ppOcc <+> fixity
+         | otherwise = hsep [ keyword "pattern"
+                            , ppOcc
+                            , dcolon unicode
+                            , ppPatSigType unicode qual (hsSigType typ)
+                            , fixity
+                            ]
+
+    fieldPart
+      | not hasArgDocs = []
+      | otherwise = [ subFields Nothing qual (ppSubSigLike unicode qual (unLoc patTy)
+                                                        argDocs [] (dcolon unicode)
+                                                        emptyCtxt) ]
+
+    patTy = hsSigType typ
+    emptyCtxt = patSigContext patTy
 
 
 -- | Print the LHS of a data\/newtype declaration.
@@ -987,11 +1135,12 @@ ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual e
 ppFunLhType  unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts
 
 ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html
-ppHsTyVarBndr _       qual (UserTyVar (L _ name)) =
+ppHsTyVarBndr _       qual (UserTyVar _ (L _ name)) =
     ppDocName qual Raw False name
-ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
+ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) =
     parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
             ppLKind unicode qual kind)
+ppHsTyVarBndr _ _ (XTyVarBndr _) = error "haddock:ppHsTyVarBndr"
 
 ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
@@ -999,29 +1148,32 @@ ppLKind unicode qual y = ppKind unicode qual (unLoc y)
 ppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html
 ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts
 
-ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
-ppPatSigType unicode qual typ =
-  let emptyCtxts =
-        if hasNonEmptyContext typ && isFirstContextEmpty typ
-          then ShowEmptyToplevelContexts
-          else HideEmptyContexts
-  in ppLType unicode qual emptyCtxts typ
+patSigContext :: LHsType name -> HideEmptyContexts
+patSigContext typ | hasNonEmptyContext typ && isFirstContextEmpty typ =  ShowEmptyToplevelContexts
+                  | otherwise = HideEmptyContexts
   where
     hasNonEmptyContext :: LHsType name -> Bool
     hasNonEmptyContext t =
       case unLoc t of
-        HsForAllTy _ s -> hasNonEmptyContext s
-        HsQualTy cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
-        HsFunTy _ s -> hasNonEmptyContext s
+        HsForAllTy _ _ s -> hasNonEmptyContext s
+        HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True
+        HsFunTy _ _ s    -> hasNonEmptyContext s
         _ -> False
     isFirstContextEmpty :: LHsType name -> Bool
     isFirstContextEmpty t =
       case unLoc t of
-        HsForAllTy _ s -> isFirstContextEmpty s
-        HsQualTy cxt _ -> null (unLoc cxt)
-        HsFunTy _ s -> isFirstContextEmpty s
+        HsForAllTy _ _ s -> isFirstContextEmpty s
+        HsQualTy _ cxt _ -> null (unLoc cxt)
+        HsFunTy _ _ s    -> isFirstContextEmpty s
         _ -> False
 
+
+-- | Pretty-print a pattern signature (all this does over 'ppLType' is slot in
+-- the right 'HideEmptyContext' value)
+ppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html
+ppPatSigType unicode qual typ =
+  let emptyCtxts = patSigContext typ in ppLType unicode qual emptyCtxts typ
+
 ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html
 ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot
 
@@ -1030,50 +1182,50 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
 
 ppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsForAllTy _ tvs ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
     ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsQualTy _ ctxt ty) unicode qual emptyCtxts
   = maybeParen ctxt_prec pREC_FUN $
     ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts
 
 -- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ _
+ppr_mono_ty _ (HsTyVar _ _ (L _ name)) True _ _
   | getOccString (getName name) == "*"    = toHtml "★"
   | getOccString (getName name) == "(->)" = toHtml "(→)"
 
-ppr_mono_ty _         (HsBangTy b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty
-ppr_mono_ty _         (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e
-ppr_mono_ty _         (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)
-ppr_mono_ty _         (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u q e =
+ppr_mono_ty _         (HsBangTy _ b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty
+ppr_mono_ty _         (HsTyVar _ _ (L _ name)) _ q _ = ppDocName q Prefix True name
+ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e
+ppr_mono_ty _         (HsTupleTy _ con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)
+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 pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind)
-ppr_mono_ty _         (HsListTy ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
-ppr_mono_ty _         (HsPArrTy ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
-ppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q _ =
+ppr_mono_ty _         (HsListTy _ ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty _         (HsPArrTy _ ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
+ppr_mono_ty ctxt_prec (HsIParamTy _ (L _ n) ty) u q _ =
     maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts
 ppr_mono_ty _         (HsSpliceTy {})     _ _ _ = error "ppr_mono_ty HsSpliceTy"
 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
        -- declarations.
-ppr_mono_ty _         (HsCoreTy {})       _ _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
-ppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (XHsType (NHsCoreTy {})) _ _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty _         (HsAppsTy {})       _ _ _ = error "ppr_mono_ty HsAppsTy"
 
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _
+ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode qual _
   = maybeParen ctxt_prec pREC_CTX $
     ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
 
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual _
+ppr_mono_ty ctxt_prec (HsAppTy _ fun_ty arg_ty) unicode qual _
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _
+ppr_mono_ty ctxt_prec (HsOpTy _ ty1 op ty2) unicode qual _
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts
   where
@@ -1084,15 +1236,15 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _
         | otherwise = ppr_op'
     ppr_op' = ppLDocName qual Infix op
 
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsParTy _ ty) unicode qual emptyCtxts
 --  = parens (ppr_mono_lty pREC_TOP ty)
   = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts
+ppr_mono_ty ctxt_prec (HsDocTy _ ty _) unicode qual emptyCtxts
   = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
 ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_'
-ppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n
+ppr_mono_ty _ (HsTyLit _ n) _ _ _ = ppr_tylit n
 
 ppr_tylit :: HsTyLit -> Html
 ppr_tylit (HsNumTy _ n) = toHtml (show n)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index a75c4b9a..7fbaec6d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -110,7 +110,7 @@ renderToString debug html
 
 hsep :: [Html] -> Html
 hsep [] = noHtml
-hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
+hsep htmls = foldr1 (<+>) htmls
 
 -- | Concatenate a series of 'Html' values vertically, with linebreaks in between.
 vcat :: [Html] -> Html
@@ -232,4 +232,4 @@ collapseToggle id_ classes = [ theclass cs, strAttr "data-details-id" id_ ]
 -- and displays a control.
 collapseControl :: String -> String -> [HtmlAttr]
 collapseControl id_ classes = collapseToggle id_ cs
-  where cs = unwords (words classes ++ ["details-toggle-control"])
\ No newline at end of file
+  where cs = unwords (words classes ++ ["details-toggle-control"])
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 8b227c50..4635c076 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, PatternGuards #-}
+{-# LANGUAGE CPP, PatternGuards, TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Convert
@@ -61,14 +61,14 @@ tyThingToLHsDecl t = case t of
   -- in a future code version we could turn idVarDetails = foreign-call
   -- into a ForD instead of a SigD if we wanted.  Haddock doesn't
   -- need to care.
-  AnId i -> allOK $ SigD (synifyIdSig ImplicitizeForAll i)
+  AnId i -> allOK $ SigD noExt (synifyIdSig ImplicitizeForAll i)
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
   ATyCon tc
     | Just cl <- tyConClass_maybe tc -- classes are just a little tedious
     -> let extractFamilyDecl :: TyClDecl a -> Either ErrMsg (LFamilyDecl a)
-           extractFamilyDecl (FamDecl d) = return $ noLoc d
+           extractFamilyDecl (FamDecl _ d) = return $ noLoc d
            extractFamilyDecl _           =
              Left "tyThingToLHsDecl: impossible associated tycon"
 
@@ -76,7 +76,7 @@ tyThingToLHsDecl t = case t of
            atFamDecls  = map extractFamilyDecl (rights atTyClDecls)
            tyClErrors = lefts atTyClDecls
            famDeclErrors = lefts atFamDecls
-       in withErrs (tyClErrors ++ famDeclErrors) . TyClD $ ClassDecl
+       in withErrs (tyClErrors ++ famDeclErrors) . TyClD noExt $ ClassDecl
          { tcdCtxt = synifyCtx (classSCTheta cl)
          , tcdLName = synifyName cl
          , tcdTyVars = synifyTyVars (tyConVisibleTyVars (classTyCon cl))
@@ -84,7 +84,7 @@ tyThingToLHsDecl t = case t of
          , tcdFDs = map (\ (l,r) -> noLoc
                         (map (noLoc . getName) l, map (noLoc . getName) r) ) $
                          snd $ classTvsFds cl
-         , tcdSigs = noLoc (MinimalSig NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) :
+         , tcdSigs = noLoc (MinimalSig noExt NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) :
                       map (noLoc . synifyTcIdSig DeleteTopLevelQuantification)
                         (classMethods cl)
          , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
@@ -92,20 +92,20 @@ tyThingToLHsDecl t = case t of
          , tcdATs = rights atFamDecls
          , tcdATDefs = [] --ignore associated type defaults
          , tcdDocs = [] --we don't have any docs at this point
-         , tcdFVs = placeHolderNamesTc }
+         , tcdCExt = placeHolderNamesTc }
     | otherwise
-    -> synifyTyCon Nothing tc >>= allOK . TyClD
+    -> synifyTyCon Nothing tc >>= allOK . TyClD noExt
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
   ACoAxiom ax -> synifyAxiom ax >>= allOK
 
   -- a data-constructor alone just gets rendered as a function:
-  AConLike (RealDataCon dc) -> allOK $ SigD (TypeSig [synifyName dc]
+  AConLike (RealDataCon dc) -> allOK $ SigD noExt (TypeSig noExt [synifyName dc]
     (synifySigWcType ImplicitizeForAll (dataConUserType dc)))
 
   AConLike (PatSynCon ps) ->
-    allOK . SigD $ PatSynSig [synifyName ps] (synifyPatSynSigType ps)
+    allOK . SigD noExt $ PatSynSig noExt [synifyName ps] (synifyPatSynSigType ps)
   where
     withErrs e x = return (e, x)
     allOK x = return (mempty, x)
@@ -118,9 +118,10 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
         annot_typats    = zipWith3 annotHsType (mkIsPolyTvs fam_tvs)
                                    args_types_only typats
         hs_rhs          = synifyType WithinType rhs
-    in HsIB { hsib_vars   = map tyVarName tkvs
-            , hsib_closed = True
-            , hsib_body   = FamEqn { feqn_tycon  = name
+    in HsIB { hsib_ext = HsIBRn { hsib_vars   = map tyVarName tkvs
+                                , hsib_closed = True }
+            , hsib_body   = FamEqn { feqn_ext    = noExt
+                                   , feqn_tycon  = name
                                    , feqn_pats   = annot_typats
                                    , feqn_fixity = Prefix
                                    , feqn_rhs    = hs_rhs } }
@@ -131,13 +132,13 @@ synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GhcRn)
 synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
   | isOpenTypeFamilyTyCon tc
   , Just branch <- coAxiomSingleBranch_maybe ax
-  = return $ InstD
-           $ TyFamInstD
+  = return $ InstD noExt
+           $ TyFamInstD noExt
            $ TyFamInstDecl { tfid_eqn = synifyAxBranch tc branch }
 
   | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc
   , getUnique ax' == getUnique ax   -- without the getUniques, type error
-  = synifyTyCon (Just ax) tc >>= return . TyClD
+  = synifyTyCon (Just ax) tc >>= return . TyClD noExt
 
   | otherwise
   = Left "synifyAxiom: closed/open family confusion"
@@ -150,16 +151,19 @@ synifyTyCon _coax tc
     DataDecl { tcdLName = synifyName tc
              , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
                          let mk_hs_tv realKind fakeTyVar
-                                = noLoc $ KindedTyVar (noLoc (getName fakeTyVar))
+                                = noLoc $ KindedTyVar noExt (noLoc (getName fakeTyVar))
                                                       (synifyKindSig realKind)
-                         in HsQTvs { hsq_implicit = []   -- No kind polymorphism
+                         in HsQTvs { hsq_ext =
+                                       HsQTvsRn { hsq_implicit = []   -- No kind polymorphism
+                                                , hsq_dependent = emptyNameSet }
                                    , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc)))
                                                                 alphaTyVars --a, b, c... which are unfortunately all kind *
-                                   , hsq_dependent = emptyNameSet }
+                                   }
 
            , tcdFixity = Prefix
 
-           , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither
+           , tcdDataDefn = HsDataDefn { dd_ext = noExt
+                                      , dd_ND = DataType  -- arbitrary lie, they are neither
                                                     -- algebraic data nor newtype:
                                       , dd_ctxt = noLoc []
                                       , dd_cType = Nothing
@@ -167,8 +171,7 @@ synifyTyCon _coax tc
                                                -- we have their kind accurately:
                                       , dd_cons = []  -- No constructors
                                       , dd_derivs = noLoc [] }
-           , tcdDataCusk = False
-           , tcdFVs = placeHolderNamesTc }
+           , tcdDExt = DataDeclRn False placeHolderNamesTc }
 
 synifyTyCon _coax tc
   | Just flav <- famTyConFlav_maybe tc
@@ -189,8 +192,9 @@ synifyTyCon _coax tc
         -> mkFamDecl DataFamily
   where
     resultVar = famTcResVar tc
-    mkFamDecl i = return $ FamDecl $
-      FamilyDecl { fdInfo = i
+    mkFamDecl i = return $ FamDecl noExt $
+      FamilyDecl { fdExt = noExt
+                 , fdInfo = i
                  , fdLName = synifyName tc
                  , fdTyVars = synifyTyVars (tyConVisibleTyVars tc)
                  , fdFixity = Prefix
@@ -203,11 +207,11 @@ synifyTyCon _coax tc
 
 synifyTyCon coax tc
   | Just ty <- synTyConRhs_maybe tc
-  = return $ SynDecl { tcdLName = synifyName tc
+  = return $ SynDecl { tcdSExt   = emptyNameSet
+                     , tcdLName  = synifyName tc
                      , tcdTyVars = synifyTyVars (tyConVisibleTyVars tc)
                      , tcdFixity = Prefix
-                     , tcdRhs = synifyType WithinType ty
-                     , tcdFVs = placeHolderNamesTc }
+                     , tcdRhs = synifyType WithinType ty }
   | otherwise =
   -- (closed) newtype and data
   let
@@ -240,7 +244,8 @@ synifyTyCon coax tc
   cons = rights consRaw
   -- "deriving" doesn't affect the signature, no need to specify any.
   alg_deriv = noLoc []
-  defn = HsDataDefn { dd_ND      = alg_nd
+  defn = HsDataDefn { dd_ext     = noExt
+                    , dd_ND      = alg_nd
                     , dd_ctxt    = alg_ctx
                     , dd_cType   = Nothing
                     , dd_kindSig = kindSig
@@ -250,7 +255,7 @@ synifyTyCon coax tc
   [] -> return $
         DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdFixity = Prefix
                  , tcdDataDefn = defn
-                 , tcdDataCusk = False, tcdFVs = placeHolderNamesTc }
+                 , tcdDExt = DataDeclRn False placeHolderNamesTc }
   dataConErrs -> Left $ unlines dataConErrs
 
 -- In this module, every TyCon being considered has come from an interface
@@ -284,9 +289,9 @@ synifyInjectivityAnn (Just lhs) tvs (Injective inj) =
 
 synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GhcRn
 synifyFamilyResultSig  Nothing    kind =
-   noLoc $ KindSig  (synifyKindSig kind)
+   noLoc $ KindSig  noExt (synifyKindSig kind)
 synifyFamilyResultSig (Just name) kind =
-   noLoc $ TyVarSig (noLoc $ KindedTyVar (noLoc name) (synifyKindSig kind))
+   noLoc $ TyVarSig noExt (noLoc $ KindedTyVar noExt (noLoc name) (synifyKindSig kind))
 
 -- User beware: it is your responsibility to pass True (use_gadt_syntax)
 -- for any constructor that would be misrepresented by omitting its
@@ -304,10 +309,6 @@ synifyDataCon use_gadt_syntax dc =
   -- con_qvars means a different thing depending on gadt-syntax
   (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc
 
-  qvars = if use_gadt_syntax
-          then synifyTyVars (univ_tvs ++ ex_tvs)
-          else synifyTyVars ex_tvs
-
   -- skip any EqTheta, use 'orig'inal syntax
   ctx = synifyCtx theta
 
@@ -316,12 +317,12 @@ synifyDataCon use_gadt_syntax dc =
                let tySyn = synifyType WithinType ty
                in case bang of
                     (HsSrcBang _ NoSrcUnpack NoSrcStrict) -> tySyn
-                    bang' -> noLoc $ HsBangTy bang' tySyn)
+                    bang' -> noLoc $ HsBangTy noExt bang' tySyn)
             arg_tys (dataConSrcBangs dc)
 
   field_tys = zipWith con_decl_field (dataConFieldLabels dc) linear_tys
   con_decl_field fl synTy = noLoc $
-    ConDeclField [noLoc $ FieldOcc (noLoc $ mkVarUnqual $ flLabel fl) (flSelector fl)] synTy
+    ConDeclField noExt [noLoc $ FieldOcc (flSelector fl) (noLoc $ mkVarUnqual $ flLabel fl)] synTy
                  Nothing
   hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
           (True,True) -> Left "synifyDataCon: contradiction!"
@@ -330,45 +331,51 @@ synifyDataCon use_gadt_syntax dc =
           (False,True) -> case linear_tys of
                            [a,b] -> return $ InfixCon a b
                            _ -> Left "synifyDataCon: infix with non-2 args?"
-  gadt_ty = HsIB [] (synifyType WithinType res_ty) False
  -- finally we get synifyDataCon's result!
  in hs_arg_tys >>=
       \hat ->
         if use_gadt_syntax
            then return $ noLoc $
-              ConDeclGADT { con_names = [name]
-                          , con_type = gadt_ty
-                          , con_doc =  Nothing }
+              ConDeclGADT { con_g_ext  = noExt
+                          , con_names  = [name]
+                          , con_forall = True
+                          , con_qvars  = synifyTyVars (univ_tvs ++ ex_tvs)
+                          , con_mb_cxt = Just ctx
+                          , con_args   =  hat
+                          , con_res_ty = synifyType WithinType res_ty
+                          , con_doc    =  Nothing }
            else return $ noLoc $
-              ConDeclH98 { con_name = name
-                         , con_qvars = Just qvars
-                         , con_cxt   = Just ctx
-                         , con_details =  hat
-                         , con_doc =  Nothing }
+              ConDeclH98 { con_ext    = noExt
+                         , con_name   = name
+                         , con_forall = True
+                         , con_ex_tvs = map synifyTyVar ex_tvs
+                         , con_mb_cxt = Just ctx
+                         , con_args   = hat
+                         , con_doc    = Nothing }
 
 synifyName :: NamedThing n => n -> Located Name
 synifyName n = L (srcLocSpan (getSrcLoc n)) (getName n)
 
 
 synifyIdSig :: SynifyTypeState -> Id -> Sig GhcRn
-synifyIdSig s i = TypeSig [synifyName i] (synifySigWcType s (varType i))
+synifyIdSig s i = TypeSig noExt [synifyName i] (synifySigWcType s (varType i))
 
 synifyTcIdSig :: SynifyTypeState -> Id -> Sig GhcRn
-synifyTcIdSig s i = ClassOpSig False [synifyName i] (synifySigType s (varType i))
+synifyTcIdSig s i = ClassOpSig noExt False [synifyName i] (synifySigType s (varType i))
 
 synifyCtx :: [PredType] -> LHsContext GhcRn
 synifyCtx = noLoc . map (synifyType WithinType)
 
 
 synifyTyVars :: [TyVar] -> LHsQTyVars GhcRn
-synifyTyVars ktvs = HsQTvs { hsq_implicit = []
-                           , hsq_explicit = map synifyTyVar ktvs
-                           , hsq_dependent = emptyNameSet }
+synifyTyVars ktvs = HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = []
+                                                , hsq_dependent = emptyNameSet }
+                           , hsq_explicit = map synifyTyVar ktvs }
 
 synifyTyVar :: TyVar -> LHsTyVarBndr GhcRn
 synifyTyVar tv
-  | isLiftedTypeKind kind = noLoc (UserTyVar (noLoc name))
-  | otherwise             = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind))
+  | isLiftedTypeKind kind = noLoc (UserTyVar noExt (noLoc name))
+  | otherwise             = noLoc (KindedTyVar noExt (noLoc name) (synifyKindSig kind))
   where
     kind = tyVarKind tv
     name = getName tv
@@ -385,7 +392,7 @@ annotHsType True ty hs_ty
   | not $ isEmptyVarSet $ filterVarSet isTyVar $ tyCoVarsOfType ty
   = let ki    = typeKind ty
         hs_ki = synifyType WithinType ki
-    in noLoc (HsKindSig hs_ty hs_ki)
+    in noLoc (HsKindSig noExt hs_ty hs_ki)
 annotHsType _    _ hs_ty = hs_ty
 
 -- | For every type variable in the input,
@@ -430,7 +437,7 @@ synifyPatSynSigType :: PatSyn -> LHsSigType GhcRn
 synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps)
 
 synifyType :: SynifyTypeState -> Type -> LHsType GhcRn
-synifyType _ (TyVarTy tv) = noLoc $ HsTyVar NotPromoted $ noLoc (getName tv)
+synifyType _ (TyVarTy tv) = noLoc $ HsTyVar noExt NotPromoted $ noLoc (getName tv)
 synifyType _ (TyConApp tc tys)
   = maybe_sig res_ty
   where
@@ -440,41 +447,43 @@ synifyType _ (TyConApp tc tys)
       | tc `hasKey` tYPETyConKey
       , [TyConApp lev []] <- tys
       , lev `hasKey` liftedRepDataConKey
-      = noLoc (HsTyVar NotPromoted (noLoc starKindTyConName))
+      = noLoc (HsTyVar noExt NotPromoted (noLoc starKindTyConName))
       -- Use non-prefix tuple syntax where possible, because it looks nicer.
       | Just sort <- tyConTuple_maybe tc
       , tyConArity tc == length tys
-      = noLoc $ HsTupleTy (case sort of
+      = noLoc $ HsTupleTy noExt
+                          (case sort of
                               BoxedTuple      -> HsBoxedTuple
                               ConstraintTuple -> HsConstraintTuple
                               UnboxedTuple    -> HsUnboxedTuple)
                            (map (synifyType WithinType) vis_tys)
       -- ditto for lists
       | getName tc == listTyConName, [ty] <- tys =
-         noLoc $ HsListTy (synifyType WithinType ty)
+         noLoc $ HsListTy noExt (synifyType WithinType ty)
       -- ditto for implicit parameter tycons
       | tc `hasKey` ipClassKey
       , [name, ty] <- tys
       , Just x <- isStrLitTy name
-      = noLoc $ HsIParamTy (noLoc $ HsIPName x) (synifyType WithinType ty)
+      = noLoc $ HsIParamTy noExt (noLoc $ HsIPName x) (synifyType WithinType ty)
       -- and equalities
       | tc `hasKey` eqTyConKey
       , [ty1, ty2] <- tys
-      = noLoc $ HsEqTy (synifyType WithinType ty1) (synifyType WithinType ty2)
+      = noLoc $ HsEqTy noExt (synifyType WithinType ty1) (synifyType WithinType ty2)
       -- and infix type operators
       | isSymOcc (nameOccName (getName tc))
       , ty1:ty2:tys_rest <- vis_tys
-      = mk_app_tys (HsOpTy (synifyType WithinType ty1)
+      = mk_app_tys (HsOpTy noExt
+                           (synifyType WithinType ty1)
                            (noLoc $ getName tc)
                            (synifyType WithinType ty2))
                    tys_rest
       -- Most TyCons:
       | otherwise
-      = mk_app_tys (HsTyVar NotPromoted $ noLoc (getName tc))
+      = mk_app_tys (HsTyVar noExt NotPromoted $ noLoc (getName tc))
                    vis_tys
       where
         mk_app_tys ty_app ty_args =
-          foldl (\t1 t2 -> noLoc $ HsAppTy t1 t2)
+          foldl (\t1 t2 -> noLoc $ HsAppTy noExt t1 t2)
                 (noLoc ty_app)
                 (map (synifyType WithinType) $
                  filterOut isCoercionTy ty_args)
@@ -488,7 +497,7 @@ synifyType _ (TyConApp tc tys)
       | needs_kind_sig
       = let full_kind  = typeKind (mkTyConApp tc tys)
             full_kind' = synifyType WithinType full_kind
-        in noLoc $ HsKindSig ty' full_kind'
+        in noLoc $ HsKindSig noExt ty' full_kind'
       | otherwise = ty'
 
     needs_kind_sig :: Bool
@@ -509,22 +518,24 @@ synifyType s (AppTy t1 (CoercionTy {})) = synifyType s t1
 synifyType _ (AppTy t1 t2) = let
   s1 = synifyType WithinType t1
   s2 = synifyType WithinType t2
-  in noLoc $ HsAppTy s1 s2
+  in noLoc $ HsAppTy noExt s1 s2
 synifyType _ (FunTy t1 t2) = let
   s1 = synifyType WithinType t1
   s2 = synifyType WithinType t2
-  in noLoc $ HsFunTy s1 s2
+  in noLoc $ HsFunTy noExt s1 s2
 synifyType s forallty@(ForAllTy _tv _ty) =
   let (tvs, ctx, tau) = tcSplitSigmaTy forallty
       sPhi = HsQualTy { hst_ctxt = synifyCtx ctx
+                      , hst_xqual   = noExt
                       , hst_body = synifyType WithinType tau }
   in case s of
     DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau
     WithinType        -> noLoc $ HsForAllTy { hst_bndrs = map synifyTyVar tvs
+                                            , hst_xforall = noExt
                                             , hst_body  = noLoc sPhi }
     ImplicitizeForAll -> noLoc sPhi
 
-synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t
+synifyType _ (LitTy t) = noLoc $ HsTyLit noExt $ synifyTyLit t
 synifyType s (CastTy t _) = synifyType s t
 synifyType _ (CoercionTy {}) = error "synifyType:Coercion"
 
@@ -537,10 +548,12 @@ synifyPatSynType ps = let
                -- possible by taking theta = [], as that will print no context at all
              | otherwise = req_theta
   sForAll []  s = s
-  sForAll tvs s = HsForAllTy { hst_bndrs = map synifyTyVar tvs
-                             , hst_body  = noLoc s }
-  sQual theta s = HsQualTy   { hst_ctxt  = synifyCtx theta
-                             , hst_body  = noLoc s }
+  sForAll tvs s = HsForAllTy { hst_bndrs   = map synifyTyVar tvs
+                             , hst_xforall = noExt
+                             , hst_body    = noLoc s }
+  sQual theta s = HsQualTy   { hst_ctxt    = synifyCtx theta
+                             , hst_xqual   = noExt
+                             , hst_body    = noLoc s }
   sTau = unLoc $ synifyType WithinType $ mkFunTys arg_tys res_ty
   in noLoc $ sForAll univ_tvs $ sQual req_theta' $ sForAll ex_tvs $ sQual prov_theta sTau
 
@@ -560,7 +573,7 @@ synifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead
         , clsiTyVars = synifyTyVars (tyConVisibleTyVars cls_tycon)
         , clsiSigs = map synifyClsIdSig $ classMethods cls
         , clsiAssocTys = do
-            (Right (FamDecl fam)) <- map (synifyTyCon Nothing) $ classATs cls
+            (Right (FamDecl _ fam)) <- map (synifyTyCon Nothing) $ classATs cls
             pure $ mkPseudoFamilyDecl fam
         }
     }
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index a1009c1f..2d254414 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns, FlexibleInstances, ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
@@ -17,6 +18,7 @@ module Haddock.GhcUtils where
 
 
 import Control.Arrow
+import Haddock.Types( DocNameI )
 
 import Exception
 import Outputable
@@ -27,6 +29,7 @@ import Module
 import HscTypes
 import GHC
 import Class
+import DynFlags
 
 
 moduleString :: Module -> String
@@ -44,57 +47,65 @@ isConSym = isLexConSym . occNameFS
 
 
 getMainDeclBinder :: HsDecl name -> [IdP name]
-getMainDeclBinder (TyClD d) = [tcdName d]
-getMainDeclBinder (ValD d) =
+getMainDeclBinder (TyClD _ d) = [tcdName d]
+getMainDeclBinder (ValD _ d) =
   case collectHsBindBinders d of
     []       -> []
     (name:_) -> [name]
-getMainDeclBinder (SigD d) = sigNameNoLoc d
-getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
-getMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []
+getMainDeclBinder (SigD _ d) = sigNameNoLoc d
+getMainDeclBinder (ForD _ (ForeignImport _ name _ _)) = [unLoc name]
+getMainDeclBinder (ForD _ (ForeignExport _ _ _ _)) = []
 getMainDeclBinder _ = []
 
 -- Extract the source location where an instance is defined. This is used
 -- to correlate InstDecls with their Instance/CoAxiom Names, via the
 -- instanceMap.
 getInstLoc :: InstDecl name -> SrcSpan
-getInstLoc (ClsInstD (ClsInstDecl { cid_poly_ty = ty })) = getLoc (hsSigType ty)
-getInstLoc (DataFamInstD (DataFamInstDecl
+getInstLoc (ClsInstD _ (ClsInstDecl { cid_poly_ty = ty })) = getLoc (hsSigType ty)
+getInstLoc (DataFamInstD _ (DataFamInstDecl
   { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}})) = l
-getInstLoc (TyFamInstD (TyFamInstDecl
+getInstLoc (TyFamInstD _ (TyFamInstDecl
   -- Since CoAxioms' Names refer to the whole line for type family instances
   -- in particular, we need to dig a bit deeper to pull out the entire
   -- equation. This does not happen for data family instances, for some reason.
   { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}})) = l
+getInstLoc (ClsInstD _ (XClsInstDecl _)) = panic "getInstLoc"
+getInstLoc (DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _)))) = panic "getInstLoc"
+getInstLoc (TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic "getInstLoc"
+getInstLoc (XInstDecl _) = panic "getInstLoc"
+getInstLoc (DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs _))) = panic "getInstLoc"
+getInstLoc (TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic "getInstLoc"
+
+
 
 -- Useful when there is a signature with multiple names, e.g.
 --   foo, bar :: Types..
 -- but only one of the names is exported and we have to change the
 -- type signature to only include the exported names.
-filterLSigNames :: (IdP name -> Bool) -> LSig name -> Maybe (LSig name)
+filterLSigNames :: (IdP (GhcPass p) -> Bool) -> LSig (GhcPass p) -> Maybe (LSig (GhcPass p))
 filterLSigNames p (L loc sig) = L loc <$> (filterSigNames p sig)
 
-filterSigNames :: (IdP name -> Bool) -> Sig name -> Maybe (Sig name)
-filterSigNames p orig@(SpecSig n _ _)          = ifTrueJust (p $ unLoc n) orig
-filterSigNames p orig@(InlineSig n _)          = ifTrueJust (p $ unLoc n) orig
-filterSigNames p (FixSig (FixitySig ns ty)) =
+filterSigNames :: (IdP (GhcPass p) -> Bool) -> Sig (GhcPass p) -> Maybe (Sig (GhcPass p))
+filterSigNames p orig@(SpecSig _ n _ _)          = ifTrueJust (p $ unLoc n) orig
+filterSigNames p orig@(InlineSig _ n _)          = ifTrueJust (p $ unLoc n) orig
+filterSigNames p (FixSig _ (FixitySig _ ns ty)) =
   case filter (p . unLoc) ns of
     []       -> Nothing
-    filtered -> Just (FixSig (FixitySig filtered ty))
-filterSigNames _ orig@(MinimalSig _ _)      = Just orig
-filterSigNames p (TypeSig ns ty) =
+    filtered -> Just (FixSig noExt (FixitySig noExt filtered ty))
+filterSigNames _ orig@(MinimalSig _ _ _)      = Just orig
+filterSigNames p (TypeSig _ ns ty) =
   case filter (p . unLoc) ns of
     []       -> Nothing
-    filtered -> Just (TypeSig filtered ty)
-filterSigNames p (ClassOpSig is_default ns ty) =
+    filtered -> Just (TypeSig noExt filtered ty)
+filterSigNames p (ClassOpSig _ is_default ns ty) =
   case filter (p . unLoc) ns of
     []       -> Nothing
-    filtered -> Just (ClassOpSig is_default filtered ty)
-filterSigNames p (PatSynSig ns ty) =
+    filtered -> Just (ClassOpSig noExt is_default filtered ty)
+filterSigNames p (PatSynSig _ ns ty) =
   case filter (p . unLoc) ns of
     []       -> Nothing
-    filtered -> Just (PatSynSig filtered ty)
-filterSigNames _ _                           = Nothing
+    filtered -> Just (PatSynSig noExt filtered ty)
+filterSigNames _ _                             = Nothing
 
 ifTrueJust :: Bool -> name -> Maybe name
 ifTrueJust True  = Just
@@ -104,13 +115,13 @@ sigName :: LSig name -> [IdP name]
 sigName (L _ sig) = sigNameNoLoc sig
 
 sigNameNoLoc :: Sig name -> [IdP name]
-sigNameNoLoc (TypeSig      ns _)       = map unLoc ns
-sigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns
-sigNameNoLoc (PatSynSig    ns _)       = map unLoc ns
-sigNameNoLoc (SpecSig      n _ _)      = [unLoc n]
-sigNameNoLoc (InlineSig    n _)        = [unLoc n]
-sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
-sigNameNoLoc _                         = []
+sigNameNoLoc (TypeSig    _   ns _)         = map unLoc ns
+sigNameNoLoc (ClassOpSig _ _ ns _)         = map unLoc ns
+sigNameNoLoc (PatSynSig  _   ns _)         = map unLoc ns
+sigNameNoLoc (SpecSig    _   n _ _)        = [unLoc n]
+sigNameNoLoc (InlineSig  _   n _)          = [unLoc n]
+sigNameNoLoc (FixSig _ (FixitySig _ ns _)) = map unLoc ns
+sigNameNoLoc _                             = []
 
 -- | Was this signature given by the user?
 isUserLSig :: LSig name -> Bool
@@ -121,16 +132,16 @@ isUserLSig _                    = False
 
 
 isClassD :: HsDecl a -> Bool
-isClassD (TyClD d) = isClassDecl d
+isClassD (TyClD _ d) = isClassDecl d
 isClassD _ = False
 
 isValD :: HsDecl a -> Bool
-isValD (ValD _) = True
+isValD (ValD _ _) = True
 isValD _ = False
 
 
 declATs :: HsDecl a -> [IdP a]
-declATs (TyClD d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d
+declATs (TyClD _ d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d
 declATs _ = []
 
 
@@ -148,6 +159,73 @@ nubByName f ns = go emptyNameSet ns
       where
         y = f x
 
+-- ---------------------------------------------------------------------
+
+-- This function is duplicated as getGADTConType and getGADTConTypeG,
+-- as I can't get the types to line up otherwise. AZ.
+
+getGADTConType :: ConDecl DocNameI -> LHsType DocNameI
+-- The full type of a GADT data constructor We really only get this in
+-- order to pretty-print it, and currently only in Haddock's code.  So
+-- we are cavalier about locations and extensions, hence the
+-- 'undefined's
+getGADTConType (ConDeclGADT { con_forall = has_forall
+                            , con_qvars = qtvs
+                            , con_mb_cxt = mcxt, con_args = args
+                            , con_res_ty = res_ty })
+ | has_forall = noLoc (HsForAllTy { hst_xforall = NoExt
+                                  , hst_bndrs = hsQTvExplicit qtvs
+                                  , hst_body  = theta_ty })
+ | otherwise  = theta_ty
+ where
+   theta_ty | Just theta <- mcxt
+            = noLoc (HsQualTy { hst_xqual = NoExt, hst_ctxt = theta, hst_body = tau_ty })
+            | otherwise
+            = tau_ty
+
+   tau_ty = case args of
+              RecCon flds -> noLoc (HsFunTy noExt (noLoc (HsRecTy noExt (unLoc flds))) res_ty)
+              PrefixCon pos_args -> foldr mkFunTy res_ty pos_args
+              InfixCon arg1 arg2 -> arg1 `mkFunTy` (arg2 `mkFunTy` res_ty)
+
+   mkFunTy a b = noLoc (HsFunTy noExt a b)
+
+getGADTConType (ConDeclH98 {}) = panic "getGADTConType"
+  -- Should only be called on ConDeclGADT
+getGADTConType (XConDecl {}) = panic "getGADTConType"
+
+-- -------------------------------------
+
+getGADTConTypeG :: ConDecl (GhcPass p) -> LHsType (GhcPass p)
+-- The full type of a GADT data constructor We really only get this in
+-- order to pretty-print it, and currently only in Haddock's code.  So
+-- we are cavalier about locations and extensions, hence the
+-- 'undefined's
+getGADTConTypeG (ConDeclGADT { con_forall = has_forall
+                            , con_qvars = qtvs
+                            , con_mb_cxt = mcxt, con_args = args
+                            , con_res_ty = res_ty })
+ | has_forall = noLoc (HsForAllTy { hst_xforall = NoExt
+                                  , hst_bndrs = hsQTvExplicit qtvs
+                                  , hst_body  = theta_ty })
+ | otherwise  = theta_ty
+ where
+   theta_ty | Just theta <- mcxt
+            = noLoc (HsQualTy { hst_xqual = NoExt, hst_ctxt = theta, hst_body = tau_ty })
+            | otherwise
+            = tau_ty
+
+   tau_ty = case args of
+              RecCon flds -> noLoc (HsFunTy noExt (noLoc (HsRecTy noExt (unLoc flds))) res_ty)
+              PrefixCon pos_args -> foldr mkFunTy res_ty pos_args
+              InfixCon arg1 arg2 -> arg1 `mkFunTy` (arg2 `mkFunTy` res_ty)
+
+   mkFunTy a b = noLoc (HsFunTy noExt a b)
+
+getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG"
+  -- Should only be called on ConDeclGADT
+getGADTConTypeG (XConDecl {}) = panic "getGADTConTypeG"
+
 -------------------------------------------------------------------------------
 -- * Located
 -------------------------------------------------------------------------------
@@ -179,8 +257,8 @@ class Parent a where
 
 instance Parent (ConDecl GhcRn) where
   children con =
-    case getConDetails con of
-      RecCon fields -> map (selectorFieldOcc . unL) $
+    case con_args con of
+      RecCon fields -> map (extFieldOcc . unL) $
                          concatMap (cd_fld_names . unL) (unL fields)
       _             -> []
 
@@ -190,7 +268,7 @@ instance Parent (TyClDecl GhcRn) where
                               $ (dd_cons . tcdDataDefn) $ d
     | isClassDecl d =
         map (unL . fdLName . unL) (tcdATs d) ++
-        [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ]
+        [ unL n | L _ (TypeSig _ ns _) <- tcdSigs d, n <- ns ]
     | otherwise = []
 
 
@@ -218,7 +296,7 @@ parentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ]
 
 -- | The parents of a subordinate in a declaration
 parents :: Name -> HsDecl GhcRn -> [Name]
-parents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ]
+parents n (TyClD _ d) = [ p | (c, p) <- parentMap d, c == n ]
 parents _ _ = []
 
 
@@ -255,7 +333,10 @@ minimalDef n = do
 setObjectDir, setHiDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags
 setObjectDir  f d = d{ objectDir  = Just f}
 setHiDir      f d = d{ hiDir      = Just f}
-setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
+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 . setStubDir f
+
+
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index d0ed1698..bf50ded3 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -86,7 +86,7 @@ attachToExportItem
   -> Ghc (ExportItem GhcRn)
 attachToExportItem index expInfo iface ifaceMap instIfaceMap export =
   case attachFixities export of
-    e@ExportDecl { expItemDecl = L eSpan (TyClD d) } -> do
+    e@ExportDecl { expItemDecl = L eSpan (TyClD _ d) } -> do
       insts <-
         let mb_instances  = lookupNameEnv index (tcdName d)
             cls_instances = maybeToList mb_instances >>= fst
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index a35e2053..8b929e15 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -61,7 +61,7 @@ import TcRnTypes
 import FastString ( concatFS, unpackFS )
 import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
-import HsDecls    ( getConDetails )
+import HsDecls ( getConArgs )
 
 
 -- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -135,7 +135,7 @@ createInterface tm flags modMap instIfaceMap = do
                         $  map getName instances
                         ++ map getName fam_instances
       -- Locations of all TH splices
-      splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]
+      splices = [ l | L l (SpliceD _ _) <- hsmodDecls hsm ]
 
   warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)
 
@@ -393,7 +393,7 @@ mkMaps dflags pkgName gre instances decls = do
             m'   <- traverse (processDocStringParas dflags pkgName gre) m
             pure (doc', m')
 
-      (doc, args) <- declDoc docStrs (typeDocs decl)
+      (doc, args) <- declDoc docStrs (declTypeDocs decl)
 
       let
           subs :: [(Name, [HsDocString], Map Int HsDocString)]
@@ -419,9 +419,9 @@ mkMaps dflags pkgName gre instances decls = do
     instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
 
     names :: SrcSpan -> HsDecl GhcRn -> [Name]
-    names l (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+    names l (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
       where loc = case d of
-              TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
+              TyFamInstD _ _ -> l -- The CoAx's loc is the whole line, but only for TFs
               _ -> getInstLoc d
     names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
     names _ decl = getMainDeclBinder decl
@@ -446,67 +446,82 @@ subordinates :: InstMap
              -> HsDecl GhcRn
              -> [(Name, [HsDocString], Map Int HsDocString)]
 subordinates instMap decl = case decl of
-  InstD (ClsInstD d) -> do
+  InstD _ (ClsInstD _ d) -> do
     DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
       FamEqn { feqn_tycon = L l _
              , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d
     [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn
 
-  InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body = d })))
+  InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body = d })))
     -> dataSubs (feqn_rhs d)
-  TyClD d | isClassDecl d -> classSubs d
-          | isDataDecl  d -> dataSubs (tcdDataDefn d)
+  TyClD _ d | isClassDecl d -> classSubs d
+            | isDataDecl  d -> dataSubs (tcdDataDefn d)
   _ -> []
   where
-    classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd
+    classSubs dd = [ (name, doc, declTypeDocs d) | (L _ d, doc) <- classDecls dd
                    , name <- getMainDeclBinder d, not (isValD d)
                    ]
     dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
     dataSubs dd = constrs ++ fields ++ derivs
       where
         cons = map unL $ (dd_cons dd)
-        constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
+        constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, conArgDocs c)
                   | c <- cons, cname <- getConNames c ]
-        fields  = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)
-                  | RecCon flds <- map getConDetails cons
-                  , L _ (ConDeclField ns _ doc) <- (unLoc flds)
+        fields  = [ (extFieldOcc n, maybeToList $ fmap unL doc, M.empty)
+                  | RecCon flds <- map getConArgs cons
+                  , L _ (ConDeclField _ ns _ doc) <- (unLoc flds)
                   , L _ n <- ns ]
         derivs  = [ (instName, [unL doc], M.empty)
-                  | HsIB { hsib_body = L l (HsDocTy _ doc) }
+                  | HsIB { hsib_body = L l (HsDocTy _ _ doc) }
                       <- concatMap (unLoc . deriv_clause_tys . unLoc) $
                            unLoc $ dd_derivs dd
                   , Just instName <- [M.lookup l instMap] ]
 
+-- | Extract constructor argument docs from inside constructor decls.
+conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
+conArgDocs con = case getConArgs con of
+                   PrefixCon args -> go 0 (map unLoc args ++ ret)
+                   InfixCon arg1 arg2 -> go 0 ([unLoc arg1, unLoc arg2] ++ ret)
+                   RecCon _ -> go 1 ret
+  where
+    go n (HsDocTy _ _ (L _ ds) : tys) = M.insert n ds $ go (n+1) tys
+    go n (_ : tys) = go (n+1) tys
+    go _ [] = M.empty
+
+    ret = case con of
+            ConDeclGADT { con_res_ty = res_ty } -> [ unLoc res_ty ]
+            _ -> []
+
+-- | Extract function argument docs from inside top-level decls.
+declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
+declTypeDocs (SigD  _ (TypeSig _ _ ty))          = typeDocs (unLoc (hsSigWcType ty))
+declTypeDocs (SigD  _ (ClassOpSig _ _ _ ty))     = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (SigD  _ (PatSynSig _ _ ty))        = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (ForD  _ (ForeignImport _ _ ty _))  = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (TyClD _ (SynDecl { tcdRhs = ty })) = typeDocs (unLoc ty)
+declTypeDocs _ = M.empty
+
 -- | Extract function argument docs from inside types.
-typeDocs :: HsDecl GhcRn -> Map Int HsDocString
-typeDocs d =
-  let docs = go 0 in
-  case d of
-    SigD (TypeSig _ ty)      -> docs (unLoc (hsSigWcType ty))
-    SigD (ClassOpSig _ _ ty) -> docs (unLoc (hsSigType ty))
-    SigD (PatSynSig _ ty)    -> docs (unLoc (hsSigType ty))
-    ForD (ForeignImport _ ty _ _)   -> docs (unLoc (hsSigType ty))
-    TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
-    _ -> M.empty
+typeDocs :: HsType GhcRn -> Map Int HsDocString
+typeDocs = go 0
   where
     go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty)
     go n (HsQualTy   { hst_body = ty }) = go n (unLoc ty)
-    go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
-    go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
-    go n (HsDocTy _ (L _ doc)) = M.singleton n doc
+    go n (HsFunTy _ (L _ (HsDocTy _ _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
+    go n (HsFunTy _ _ ty) = go (n+1) (unLoc ty)
+    go n (HsDocTy _ _ (L _ doc)) = M.singleton n doc
     go _ _ = M.empty
 
-
 -- | All the sub declarations of a class (that we handle), ordered by
 -- source location, with documentation attached if it exists.
 classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
 classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
   where
     decls = docs ++ defs ++ sigs ++ ats
-    docs  = mkDecls tcdDocs DocD class_
-    defs  = mkDecls (bagToList . tcdMeths) ValD class_
-    sigs  = mkDecls tcdSigs SigD class_
-    ats   = mkDecls tcdATs (TyClD . FamDecl) class_
+    docs  = mkDecls tcdDocs (DocD noExt) class_
+    defs  = mkDecls (bagToList . tcdMeths) (ValD noExt) class_
+    sigs  = mkDecls tcdSigs (SigD noExt) class_
+    ats   = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_
 
 
 -- | The top-level declarations of a module that we care about,
@@ -518,26 +533,26 @@ topDecls =
 -- | Extract a map of fixity declarations only
 mkFixMap :: HsGroup GhcRn -> FixMap
 mkFixMap group_ = M.fromList [ (n,f)
-                             | L _ (FixitySig ns f) <- hs_fixds group_,
+                             | L _ (FixitySig _ ns f) <- hs_fixds group_,
                                L _ n <- ns ]
 
 
 -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
 ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
 ungroup group_ =
-  mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD  group_ ++
-  mkDecls hs_derivds             DerivD group_ ++
-  mkDecls hs_defds               DefD   group_ ++
-  mkDecls hs_fords               ForD   group_ ++
-  mkDecls hs_docs                DocD   group_ ++
-  mkDecls (tyClGroupInstDecls . hs_tyclds) InstD  group_ ++
-  mkDecls (typesigs . hs_valds)  SigD   group_ ++
-  mkDecls (valbinds . hs_valds)  ValD   group_
+  mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt)  group_ ++
+  mkDecls hs_derivds             (DerivD noExt) group_ ++
+  mkDecls hs_defds               (DefD noExt)   group_ ++
+  mkDecls hs_fords               (ForD noExt)   group_ ++
+  mkDecls hs_docs                (DocD noExt)   group_ ++
+  mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt)  group_ ++
+  mkDecls (typesigs . hs_valds)  (SigD noExt)   group_ ++
+  mkDecls (valbinds . hs_valds)  (ValD noExt)   group_
   where
-    typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs
+    typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs
     typesigs _ = error "expected ValBindsOut"
 
-    valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds
+    valbinds (XValBindsLR (NValBinds binds _)) = concatMap bagToList . snd . unzip $ binds
     valbinds _ = error "expected ValBindsOut"
 
 
@@ -563,14 +578,14 @@ sortByLoc = sortBy (comparing getLoc)
 filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
 filterDecls = filter (isHandled . unL . fst)
   where
-    isHandled (ForD (ForeignImport {})) = True
+    isHandled (ForD _ (ForeignImport {})) = True
     isHandled (TyClD {})  = True
     isHandled (InstD {})  = True
     isHandled (DerivD {}) = True
-    isHandled (SigD d) = isUserLSig (reL d)
-    isHandled (ValD _) = True
+    isHandled (SigD _ d)  = isUserLSig (reL d)
+    isHandled (ValD {})   = True
     -- we keep doc declarations to be able to get at named docs
-    isHandled (DocD _) = True
+    isHandled (DocD {})   = True
     isHandled _ = False
 
 -- | Go through all class declarations and filter their sub-declarations
@@ -578,8 +593,8 @@ filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
 filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
                       | x@(L loc d, doc) <- decls ]
   where
-    filterClass (TyClD c) =
-      TyClD $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }
+    filterClass (TyClD x c) =
+      TyClD x $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }
     filterClass _ = error "expected TyClD"
 
 
@@ -598,10 +613,10 @@ collectDocs = go Nothing []
   where
     go Nothing _ [] = []
     go (Just prev) docs [] = finished prev docs []
-    go prev docs (L _ (DocD (DocCommentNext str)) : ds)
+    go prev docs (L _ (DocD _ (DocCommentNext str)) : ds)
       | Nothing <- prev = go Nothing (str:docs) ds
       | Just decl <- prev = finished decl docs (go Nothing [str] ds)
-    go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds
+    go prev docs (L _ (DocD _ (DocCommentPrev str)) : ds) = go prev (str:docs) ds
     go Nothing docs (d:ds) = go (Just d) docs ds
     go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
 
@@ -644,22 +659,22 @@ mkExportItems
         allExports
     Just exports -> liftM concat $ mapM lookupExport exports
   where
-    lookupExport (IEGroup lev docStr, _)  = liftErrMsg $ do
+    lookupExport (IEGroup _ lev docStr, _)  = liftErrMsg $ do
       doc <- processDocString dflags gre docStr
       return [ExportGroup lev "" doc]
 
-    lookupExport (IEDoc docStr, _)        = liftErrMsg $ do
+    lookupExport (IEDoc _ docStr, _)        = liftErrMsg $ do
       doc <- processDocStringParas dflags pkgName gre docStr
       return [ExportDoc doc]
 
-    lookupExport (IEDocNamed str, _)      = liftErrMsg $
+    lookupExport (IEDocNamed _ str, _)      = liftErrMsg $
       findNamedDoc str [ unL d | d <- decls ] >>= \case
         Nothing -> return  []
         Just docStr -> do
           doc <- processDocStringParas dflags pkgName gre docStr
           return [ExportDoc doc]
 
-    lookupExport (IEModuleContents (L _ mod_name), _)
+    lookupExport (IEModuleContents _ (L _ mod_name), _)
       -- only consider exporting a module if we are sure we
       -- are really exporting the whole module and not some
       -- subset. We also look through module aliases here.
@@ -696,7 +711,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
       let t = availName avail
       r    <- findDecl avail
       case r of
-        ([L l (ValD _)], (doc, _)) -> do
+        ([L l (ValD _ _)], (doc, _)) -> do
           -- Top-level binding without type signature
           export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap
           return [export]
@@ -721,17 +736,17 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
                   -- A single signature might refer to many names, but we
                   -- create an export item for a single name only.  So we
                   -- modify the signature to contain only that single name.
-                  L loc (SigD sig) ->
+                  L loc (SigD _ sig) ->
                     -- fromJust is safe since we already checked in guards
                     -- that 't' is a name declared in this declaration.
-                    let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
+                    let newDecl = L loc . SigD noExt . fromJust $ filterSigNames (== t) sig
                     in availExportDecl avail newDecl docs_
 
-                  L loc (TyClD cl@ClassDecl{}) -> do
+                  L loc (TyClD _ cl@ClassDecl{}) -> do
                     mdef <- liftGhcToErrMsgGhc $ minimalDef t
-                    let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef
+                    let sig = maybeToList $ fmap (noLoc . MinimalSig noExt NoSourceText . noLoc . fmap noLoc) mdef
                     availExportDecl avail
-                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_
+                      (L loc $ TyClD noExt cl { tcdSigs = sig ++ tcdSigs cl }) docs_
 
                   _ -> availExportDecl avail decl docs_
 
@@ -994,13 +1009,13 @@ fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNam
   let availEnv = availsToNameEnv (nubAvails avails)
   (concat . concat) `fmap` (for decls $ \decl -> do
     case decl of
-      (L _ (DocD (DocGroup lev docStr))) -> do
+      (L _ (DocD _ (DocGroup lev docStr))) -> do
         doc <- liftErrMsg (processDocString dflags gre docStr)
         return [[ExportGroup lev "" doc]]
-      (L _ (DocD (DocCommentNamed _ docStr))) -> do
+      (L _ (DocD _ (DocCommentNamed _ docStr))) -> do
         doc <- liftErrMsg (processDocStringParas dflags pkgName gre docStr)
         return [[ExportDoc doc]]
-      (L _ (ValD valDecl))
+      (L _ (ValD _ valDecl))
         | name:_ <- collectHsBindBinders valDecl
         , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap
         -> return []
@@ -1025,12 +1040,12 @@ extractDecl declMap name decl
   | name `elem` getMainDeclBinder (unLoc decl) = decl
   | otherwise  =
     case unLoc decl of
-      TyClD d@ClassDecl {} ->
+      TyClD _ d@ClassDecl {} ->
         let
           matchesMethod =
             [ lsig
             | lsig <- tcdSigs d
-            , ClassOpSig False _ _ <- pure $ unLoc lsig
+            , ClassOpSig _ False _ _ <- pure $ unLoc lsig
               -- Note: exclude `default` declarations (see #505)
             , name `elem` sigName lsig
             ]
@@ -1045,8 +1060,8 @@ extractDecl declMap name decl
         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 sig)
-          (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl))
+                       in L pos (SigD noExt sig)
+          (_, [L pos fam_decl]) -> L pos (TyClD noExt (FamDecl noExt fam_decl))
 
           ([], [])
             | Just (famInstDecl:_) <- M.lookup name declMap
@@ -1055,23 +1070,23 @@ extractDecl declMap name decl
                                          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 {} ->
+      TyClD _ d@DataDecl {} ->
         let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
         in if isDataConName name
-           then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
-           else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
-      TyClD FamDecl {}
+           then SigD noExt <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
+           else SigD noExt <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
+      TyClD _ FamDecl {}
         | isValName name
         , Just (famInst:_) <- M.lookup name declMap
         -> extractDecl declMap name famInst
-      InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body =
+      InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body =
                              FamEqn { feqn_tycon = L _ n
                                     , feqn_pats  = tys
                                     , feqn_rhs   = defn }}))) ->
         if isDataConName name
-        then SigD <$> extractPatternSyn name n tys (dd_cons defn)
-        else SigD <$> extractRecSel name n tys (dd_cons defn)
-      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts })
+        then SigD noExt <$> extractPatternSyn name n tys (dd_cons defn)
+        else SigD noExt <$> extractRecSel name n tys (dd_cons defn)
+      InstD _ (ClsInstD _ ClsInstDecl { cid_datafam_insts = insts })
         | isDataConName name ->
             let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body =
                                           FamEqn { feqn_rhs   = dd
@@ -1080,19 +1095,19 @@ extractDecl declMap name decl
                                , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))
                                ]
             in case matches of
-                [d0] -> extractDecl declMap name (noLoc (InstD (DataFamInstD d0)))
+                [d0] -> extractDecl declMap name (noLoc (InstD noExt (DataFamInstD noExt d0)))
                 _    -> error "internal: extractDecl (ClsInstD)"
         | otherwise ->
             let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
                                    <- insts
                                  -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
-                               , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
+                               , RecCon rec <- map (getConArgs . unLoc) (dd_cons (feqn_rhs d))
                                , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
                                , L _ n <- ns
-                               , selectorFieldOcc n == name
+                               , extFieldOcc n == name
                           ]
             in case matches of
-              [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
+              [d0] -> extractDecl declMap name (noLoc . InstD noExt $ DataFamInstD noExt d0)
               _ -> error "internal: extractDecl (ClsInstD)"
       _ -> error "internal: extractDecl"
 
@@ -1108,42 +1123,42 @@ extractPatternSyn nm t tvs cons =
   extract :: ConDecl GhcRn -> Sig GhcRn
   extract con =
     let args =
-          case getConDetails con of
+          case getConArgs con of
             PrefixCon args' -> args'
             RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
             InfixCon arg1 arg2 -> [arg1, arg2]
         typ = longArrow args (data_ty con)
         typ' =
           case con of
-            ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
+            ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy noExt cxt typ)
             _ -> typ
-        typ'' = noLoc (HsQualTy (noLoc []) typ')
-    in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')
+        typ'' = noLoc (HsQualTy noExt (noLoc []) typ')
+    in PatSynSig noExt [noLoc nm] (mkEmptyImplicitBndrs typ'')
 
-  longArrow :: [LHsType name] -> LHsType name -> LHsType name
-  longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs
+  longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
+  longArrow inputs output = foldr (\x y -> noLoc (HsFunTy noExt x y)) output inputs
 
   data_ty con
-    | ConDeclGADT{} <- con = hsib_body $ con_type con
-    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
+    | ConDeclGADT{} <- con = con_res_ty con
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs
 
 extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
               -> LSig GhcRn
 extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
 
 extractRecSel nm t tvs (L _ con : rest) =
-  case getConDetails con of
-    RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
-      L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty)))))
+  case getConArgs con of
+    RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
+      L l (TypeSig noExt [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExt data_ty (getBangType ty)))))
     _ -> extractRecSel nm t tvs rest
  where
   matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
-  matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
-                                 , L l n <- ns, selectorFieldOcc n == nm ]
+  matching_fields flds = [ (l,f) | f@(L _ (ConDeclField _ ns _ _)) <- flds
+                                 , L l n <- ns, extFieldOcc n == nm ]
   data_ty
     -- ResTyGADT _ ty <- con_res con = ty
-    | ConDeclGADT{} <- con = hsib_body $ con_type con
-    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
+    | ConDeclGADT{} <- con = con_res_ty con
+    | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs
 
 -- | Keep export items with docs.
 pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn]
@@ -1163,8 +1178,8 @@ mkVisibleNames (_, _, _, instMap) exports opts
       where subs    = map fst (expItemSubDocs e)
             patsyns = concatMap (getMainDeclBinder . fst) (expItemPats e)
             name = case unLoc $ expItemDecl e of
-              InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
-              decl    -> getMainDeclBinder decl
+              InstD _ d -> maybeToList $ M.lookup (getInstLoc d) instMap
+              decl      -> getMainDeclBinder decl
     exportName ExportNoDecl {} = [] -- we don't count these as visible, since
                                     -- we don't want links to go to them.
     exportName _ = []
@@ -1208,7 +1223,7 @@ findNamedDoc name = search
     search [] = do
       tell ["Cannot find documentation for: $" ++ name]
       return Nothing
-    search (DocD (DocCommentNamed name' doc) : rest)
+    search (DocD _ (DocCommentNamed name' doc) : rest)
       | name == name' = return (Just doc)
       | otherwise = search rest
     search (_other_decl : rest) = search rest
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index b2d0e1e1..7fb1f4b7 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -21,6 +21,7 @@ import Haddock.Types
 import Bag (emptyBag)
 import GHC hiding (NoLink)
 import Name
+import Outputable ( panic )
 import RdrName (RdrName(Exact))
 import PrelNames (eqTyCon_RDR)
 
@@ -197,14 +198,15 @@ renameMaybeLKind :: Maybe (LHsKind GhcRn) -> RnM (Maybe (LHsKind DocNameI))
 renameMaybeLKind = traverse renameLKind
 
 renameFamilyResultSig :: LFamilyResultSig GhcRn -> RnM (LFamilyResultSig DocNameI)
-renameFamilyResultSig (L loc NoSig)
-    = return (L loc NoSig)
-renameFamilyResultSig (L loc (KindSig ki))
+renameFamilyResultSig (L loc (NoSig _))
+    = return (L loc (NoSig noExt))
+renameFamilyResultSig (L loc (KindSig _ ki))
     = do { ki' <- renameLKind ki
-         ; return (L loc (KindSig ki')) }
-renameFamilyResultSig (L loc (TyVarSig bndr))
+         ; return (L loc (KindSig noExt ki')) }
+renameFamilyResultSig (L loc (TyVarSig _ bndr))
     = do { bndr' <- renameLTyVarBndr bndr
-         ; return (L loc (TyVarSig bndr')) }
+         ; return (L loc (TyVarSig noExt bndr')) }
+renameFamilyResultSig (L _ (XFamilyResultSig _)) = panic "haddock:renameFamilyResultSig"
 
 renameInjectivityAnn :: LInjectivityAnn GhcRn -> RnM (LInjectivityAnn DocNameI)
 renameInjectivityAnn (L loc (InjectivityAnn lhs rhs))
@@ -221,61 +223,61 @@ renameType t = case t of
   HsForAllTy { hst_bndrs = tyvars, hst_body = ltype } -> do
     tyvars'   <- mapM renameLTyVarBndr tyvars
     ltype'    <- renameLType ltype
-    return (HsForAllTy { hst_bndrs = tyvars', hst_body = ltype' })
+    return (HsForAllTy { hst_xforall = NoExt, hst_bndrs = tyvars', hst_body = ltype' })
 
   HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do
     lcontext' <- renameLContext lcontext
     ltype'    <- renameLType ltype
-    return (HsQualTy { hst_ctxt = lcontext', hst_body = ltype' })
+    return (HsQualTy { hst_xqual = NoExt, hst_ctxt = lcontext', hst_body = ltype' })
 
-  HsTyVar ip (L l n) -> return . HsTyVar ip . L l =<< rename n
-  HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
+  HsTyVar _ ip (L l n) -> return . HsTyVar NoExt ip . L l =<< rename n
+  HsBangTy _ b ltype -> return . HsBangTy NoExt b =<< renameLType ltype
 
-  HsAppTy a b -> do
+  HsAppTy _ a b -> do
     a' <- renameLType a
     b' <- renameLType b
-    return (HsAppTy a' b')
+    return (HsAppTy NoExt a' b')
 
-  HsFunTy a b -> do
+  HsFunTy _ a b -> do
     a' <- renameLType a
     b' <- renameLType b
-    return (HsFunTy a' b')
+    return (HsFunTy NoExt a' b')
 
-  HsListTy ty -> return . HsListTy =<< renameLType ty
-  HsPArrTy ty -> return . HsPArrTy =<< renameLType ty
-  HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty)
-  HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
+  HsListTy _ ty -> return . (HsListTy NoExt) =<< renameLType ty
+  HsPArrTy _ ty -> return . (HsPArrTy NoExt) =<< renameLType ty
+  HsIParamTy _ n ty -> liftM (HsIParamTy NoExt n) (renameLType ty)
+  HsEqTy _ ty1 ty2 -> liftM2 (HsEqTy NoExt) (renameLType ty1) (renameLType ty2)
 
-  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
-  HsSumTy ts -> HsSumTy <$> mapM renameLType ts
+  HsTupleTy _ b ts -> return . HsTupleTy NoExt b =<< mapM renameLType ts
+  HsSumTy _ ts -> HsSumTy NoExt <$> mapM renameLType ts
 
-  HsOpTy a (L loc op) b -> do
+  HsOpTy _ a (L loc op) b -> do
     op' <- rename op
     a'  <- renameLType a
     b'  <- renameLType b
-    return (HsOpTy a' (L loc op') b')
+    return (HsOpTy NoExt a' (L loc op') b')
 
-  HsParTy ty -> return . HsParTy =<< renameLType ty
+  HsParTy _ ty -> return . (HsParTy NoExt) =<< renameLType ty
 
-  HsKindSig ty k -> do
+  HsKindSig _ ty k -> do
     ty' <- renameLType ty
     k' <- renameLKind k
-    return (HsKindSig ty' k')
+    return (HsKindSig NoExt ty' k')
 
-  HsDocTy ty doc -> do
+  HsDocTy _ ty doc -> do
     ty' <- renameLType ty
     doc' <- renameLDocHsSyn doc
-    return (HsDocTy ty' doc')
+    return (HsDocTy NoExt ty' doc')
 
-  HsTyLit x -> return (HsTyLit x)
+  HsTyLit _ x -> return (HsTyLit NoExt x)
 
-  HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a
-  HsCoreTy a              -> pure (HsCoreTy a)
+  HsRecTy _ a               -> HsRecTy NoExt <$> mapM renameConDeclFieldField a
+  (XHsType (NHsCoreTy a))   -> pure (XHsType (NHsCoreTy a))
   HsExplicitListTy i a b  -> HsExplicitListTy i a <$> mapM renameLType b
   HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b
-  HsSpliceTy s _          -> renameHsSpliceTy s
+  HsSpliceTy _ s          -> renameHsSpliceTy s
   HsWildCardTy a          -> HsWildCardTy <$> renameWildCardInfo a
-  HsAppsTy _              -> error "renameType: HsAppsTy"
+  HsAppsTy _ _            -> error "renameType: HsAppsTy"
 
 -- | Rename splices, but _only_ those that turn out to be for types.
 -- I think this is actually safe for our possible inputs:
@@ -284,32 +286,34 @@ renameType t = case t of
 --  * the input is typechecked, and only 'HsSplicedTy' should get through that
 --
 renameHsSpliceTy :: HsSplice GhcRn -> RnM (HsType DocNameI)
-renameHsSpliceTy (HsSpliced _ (HsSplicedTy t)) = renameType t
-renameHsSpliceTy (HsSpliced _ _) = error "renameHsSpliceTy: not an HsSplicedTy"
+renameHsSpliceTy (HsSpliced _ _ (HsSplicedTy t)) = renameType t
+renameHsSpliceTy (HsSpliced _ _ _) = error "renameHsSpliceTy: not an HsSplicedTy"
 renameHsSpliceTy _ = error "renameHsSpliceTy: not an HsSpliced"
 
 renameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI)
-renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs })
+renameLHsQTyVars (HsQTvs { hsq_explicit = tvs })
   = do { tvs' <- mapM renameLTyVarBndr tvs
-       ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs', hsq_dependent = error "haddock:renameLHsQTyVars" }) }
-                -- This is rather bogus, but I'm not sure what else to do
+       ; return (HsQTvs { hsq_ext = noExt
+                        , hsq_explicit = tvs' }) }
+renameLHsQTyVars (XLHsQTyVars _) = panic "haddock:renameLHsQTyVars"
 
 renameLTyVarBndr :: LHsTyVarBndr GhcRn -> RnM (LHsTyVarBndr DocNameI)
-renameLTyVarBndr (L loc (UserTyVar (L l n)))
+renameLTyVarBndr (L loc (UserTyVar x (L l n)))
   = do { n' <- rename n
-       ; return (L loc (UserTyVar (L l n'))) }
-renameLTyVarBndr (L loc (KindedTyVar (L lv n) kind))
+       ; return (L loc (UserTyVar x (L l n'))) }
+renameLTyVarBndr (L loc (KindedTyVar x (L lv n) kind))
   = do { n' <- rename n
        ; kind' <- renameLKind kind
-       ; return (L loc (KindedTyVar (L lv n') kind')) }
+       ; return (L loc (KindedTyVar x (L lv n') kind')) }
+renameLTyVarBndr (L _ (XTyVarBndr _ )) = error "haddock:renameLTyVarBndr"
 
 renameLContext :: Located [LHsType GhcRn] -> RnM (Located [LHsType DocNameI])
 renameLContext (L loc context) = do
   context' <- mapM renameLType context
   return (L loc context')
 
-renameWildCardInfo :: HsWildCardInfo GhcRn -> RnM (HsWildCardInfo DocNameI)
-renameWildCardInfo (AnonWildCard  (L l name)) = AnonWildCard . L l <$> rename name
+renameWildCardInfo :: HsWildCardInfo -> RnM HsWildCardInfo
+renameWildCardInfo (AnonWildCard  (L l name)) = return (AnonWildCard (L l name))
 
 renameInstHead :: InstHead GhcRn -> RnM (InstHead DocNameI)
 renameInstHead InstHead {..} = do
@@ -340,21 +344,21 @@ renamePats = mapM
 
 renameDecl :: HsDecl GhcRn -> RnM (HsDecl DocNameI)
 renameDecl decl = case decl of
-  TyClD d -> do
+  TyClD _ d -> do
     d' <- renameTyClD d
-    return (TyClD d')
-  SigD s -> do
+    return (TyClD noExt d')
+  SigD _ s -> do
     s' <- renameSig s
-    return (SigD s')
-  ForD d -> do
+    return (SigD noExt s')
+  ForD _ d -> do
     d' <- renameForD d
-    return (ForD d')
-  InstD d -> do
+    return (ForD noExt d')
+  InstD _ d -> do
     d' <- renameInstD d
-    return (InstD d')
-  DerivD d -> do
+    return (InstD noExt d')
+  DerivD _ d -> do
     d' <- renameDerivD d
-    return (DerivD d')
+    return (DerivD noExt d')
   _ -> error "renameDecl"
 
 renameLThing :: (a GhcRn -> RnM (a DocNameI)) -> Located (a GhcRn) -> RnM (Located (a DocNameI))
@@ -365,19 +369,21 @@ renameTyClD d = case d of
 --  TyFamily flav lname ltyvars kind tckind -> do
   FamDecl { tcdFam = decl } -> do
     decl' <- renameFamilyDecl decl
-    return (FamDecl { tcdFam = decl' })
+    return (FamDecl { tcdFExt = noExt, tcdFam = decl' })
 
-  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs, tcdFVs = _fvs } -> do
+  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs } -> do
     lname'    <- renameL lname
     tyvars'   <- renameLHsQTyVars tyvars
     rhs'     <- renameLType rhs
-    return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdRhs = rhs', tcdFVs = placeHolderNames })
+    return (SynDecl { tcdSExt = noExt, tcdLName = lname', tcdTyVars = tyvars'
+                    , tcdFixity = fixity, tcdRhs = rhs' })
 
-  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn, tcdFVs = _fvs } -> do
+  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn } -> do
     lname'    <- renameL lname
     tyvars'   <- renameLHsQTyVars tyvars
     defn'     <- renameDataDefn defn
-    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
+    return (DataDecl { tcdDExt = noExt, tcdLName = lname', tcdTyVars = tyvars'
+                     , tcdFixity = fixity, tcdDataDefn = defn' })
 
   ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity
             , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
@@ -392,7 +398,8 @@ renameTyClD d = case d of
     return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
                       , tcdFixity = fixity
                       , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
-                      , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames })
+                      , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdCExt = NoExt })
+  XTyClDecl _ -> panic "haddock:renameTyClD"
 
   where
     renameLFunDep (L loc (xs, ys)) = do
@@ -413,11 +420,12 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
     ltyvars'     <- renameLHsQTyVars ltyvars
     result'      <- renameFamilyResultSig result
     injectivity' <- renameMaybeInjectivityAnn injectivity
-    return (FamilyDecl { fdInfo = info', fdLName = lname'
+    return (FamilyDecl { fdExt = noExt, fdInfo = info', fdLName = lname'
                        , fdTyVars = ltyvars'
                        , fdFixity = fixity
                        , fdResultSig = result'
                        , fdInjectivityAnn = injectivity' })
+renameFamilyDecl (XFamilyDecl _) = panic "renameFamilyDecl"
 
 
 renamePseudoFamilyDecl :: PseudoFamilyDecl GhcRn
@@ -443,107 +451,122 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
     k'        <- renameMaybeLKind k
     cons'     <- mapM (mapM renameCon) cons
     -- I don't think we need the derivings, so we return Nothing
-    return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
+    return (HsDataDefn { dd_ext = noExt
+                       , dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
                        , dd_kindSig = k', dd_cons = cons'
                        , dd_derivs = noLoc [] })
+renameDataDefn (XHsDataDefn _) = panic "haddock:renameDataDefn"
 
 renameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI)
-renameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars
-                           , con_cxt = lcontext, con_details = details
+renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars
+                           , con_mb_cxt = lcontext, con_args = details
                            , con_doc = mbldoc }) = do
       lname'    <- renameL lname
-      ltyvars'  <- traverse renameLHsQTyVars ltyvars
+      ltyvars'  <- mapM renameLTyVarBndr ltyvars
       lcontext' <- traverse renameLContext lcontext
       details'  <- renameDetails details
       mbldoc'   <- mapM renameLDocHsSyn mbldoc
-      return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
-                   , con_details = details', con_doc = mbldoc' })
+      return (decl { con_ext = noExt, con_name = lname', con_ex_tvs = ltyvars'
+                   , con_mb_cxt = lcontext'
+                   , con_args = details', con_doc = mbldoc' })
 
-  where
-    renameDetails (RecCon (L l fields)) = do
-      fields' <- mapM renameConDeclFieldField fields
-      return (RecCon (L l fields'))
-    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
-    renameDetails (InfixCon a b) = do
-      a' <- renameLType a
-      b' <- renameLType b
-      return (InfixCon a' b')
-
-renameCon decl@(ConDeclGADT { con_names = lnames
-                            , con_type = lty
+renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars
+                            , con_mb_cxt = lcontext, con_args = details
+                            , con_res_ty = res_ty
                             , con_doc = mbldoc }) = do
       lnames'   <- mapM renameL lnames
-      lty'      <- renameLSigType lty
+      ltyvars'  <- renameLHsQTyVars ltyvars
+      lcontext' <- traverse renameLContext lcontext
+      details'  <- renameDetails details
+      res_ty'   <- renameLType res_ty
       mbldoc'   <- mapM renameLDocHsSyn mbldoc
-      return (decl { con_names = lnames'
-                   , con_type = lty', con_doc = mbldoc' })
+      return (decl { con_g_ext = noExt, con_names = lnames', con_qvars = ltyvars'
+                   , con_mb_cxt = lcontext', con_args = details'
+                   , con_res_ty = res_ty', con_doc = mbldoc' })
+renameCon (XConDecl _) = panic "haddock:renameCon"
+
+renameDetails :: HsConDeclDetails GhcRn -> RnM (HsConDeclDetails DocNameI)
+renameDetails (RecCon (L l fields)) = do
+  fields' <- mapM renameConDeclFieldField fields
+  return (RecCon (L l fields'))
+renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+renameDetails (InfixCon a b) = do
+  a' <- renameLType a
+  b' <- renameLType b
+  return (InfixCon a' b')
 
 renameConDeclFieldField :: LConDeclField GhcRn -> RnM (LConDeclField DocNameI)
-renameConDeclFieldField (L l (ConDeclField names t doc)) = do
+renameConDeclFieldField (L l (ConDeclField _ names t doc)) = do
   names' <- mapM renameLFieldOcc names
   t'   <- renameLType t
   doc' <- mapM renameLDocHsSyn doc
-  return $ L l (ConDeclField names' t' doc')
+  return $ L l (ConDeclField noExt names' t' doc')
+renameConDeclFieldField (L _ (XConDeclField _)) = panic "haddock:renameConDeclFieldField"
 
 renameLFieldOcc :: LFieldOcc GhcRn -> RnM (LFieldOcc DocNameI)
-renameLFieldOcc (L l (FieldOcc lbl sel)) = do
+renameLFieldOcc (L l (FieldOcc sel lbl)) = do
   sel' <- rename sel
-  return $ L l (FieldOcc lbl sel')
+  return $ L l (FieldOcc sel' lbl)
+renameLFieldOcc (L _ (XFieldOcc _)) = error "haddock:renameLFieldOcc"
 
 renameSig :: Sig GhcRn -> RnM (Sig DocNameI)
 renameSig sig = case sig of
-  TypeSig lnames ltype -> do
+  TypeSig _ lnames ltype -> do
     lnames' <- mapM renameL lnames
     ltype' <- renameLSigWcType ltype
-    return (TypeSig lnames' ltype')
-  ClassOpSig is_default lnames sig_ty -> do
+    return (TypeSig noExt lnames' ltype')
+  ClassOpSig _ is_default lnames sig_ty -> do
     lnames' <- mapM renameL lnames
     ltype' <- renameLSigType sig_ty
-    return (ClassOpSig is_default lnames' ltype')
-  PatSynSig lnames sig_ty -> do
+    return (ClassOpSig noExt is_default lnames' ltype')
+  PatSynSig _ lnames sig_ty -> do
     lnames' <- mapM renameL lnames
     sig_ty' <- renameLSigType sig_ty
-    return $ PatSynSig lnames' sig_ty'
-  FixSig (FixitySig lnames fixity) -> do
+    return $ PatSynSig noExt lnames' sig_ty'
+  FixSig _ (FixitySig _ lnames fixity) -> do
     lnames' <- mapM renameL lnames
-    return $ FixSig (FixitySig lnames' fixity)
-  MinimalSig src (L l s) -> do
+    return $ FixSig noExt (FixitySig noExt lnames' fixity)
+  MinimalSig _ src (L l s) -> do
     s' <- traverse renameL s
-    return $ MinimalSig src (L l s')
+    return $ MinimalSig noExt src (L l s')
   -- we have filtered out all other kinds of signatures in Interface.Create
   _ -> error "expected TypeSig"
 
 
 renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)
-renameForD (ForeignImport lname ltype co x) = do
+renameForD (ForeignImport _ lname ltype x) = do
   lname' <- renameL lname
   ltype' <- renameLSigType ltype
-  return (ForeignImport lname' ltype' co x)
-renameForD (ForeignExport lname ltype co x) = do
+  return (ForeignImport noExt lname' ltype' x)
+renameForD (ForeignExport _ lname ltype x) = do
   lname' <- renameL lname
   ltype' <- renameLSigType ltype
-  return (ForeignExport lname' ltype' co x)
+  return (ForeignExport noExt lname' ltype' x)
+renameForD (XForeignDecl _) = panic "haddock:renameForD"
 
 
 renameInstD :: InstDecl GhcRn -> RnM (InstDecl DocNameI)
 renameInstD (ClsInstD { cid_inst = d }) = do
   d' <- renameClsInstD d
-  return (ClsInstD { cid_inst = d' })
+  return (ClsInstD { cid_d_ext = noExt, cid_inst = d' })
 renameInstD (TyFamInstD { tfid_inst = d }) = do
   d' <- renameTyFamInstD d
-  return (TyFamInstD { tfid_inst = d' })
+  return (TyFamInstD { tfid_ext = noExt, tfid_inst = d' })
 renameInstD (DataFamInstD { dfid_inst = d }) = do
   d' <- renameDataFamInstD d
-  return (DataFamInstD { dfid_inst = d' })
+  return (DataFamInstD { dfid_ext = noExt, dfid_inst = d' })
+renameInstD (XInstDecl _) = panic "haddock:renameInstD"
 
 renameDerivD :: DerivDecl GhcRn -> RnM (DerivDecl DocNameI)
 renameDerivD (DerivDecl { deriv_type = ty
                         , deriv_strategy = strat
                         , deriv_overlap_mode = omode }) = do
-  ty' <- renameLSigType ty
-  return (DerivDecl { deriv_type = ty'
+  ty' <- renameLSigWcType ty
+  return (DerivDecl { deriv_ext = noExt
+                    , deriv_type = ty'
                     , deriv_strategy = strat
                     , deriv_overlap_mode = omode })
+renameDerivD (XDerivDecl _) = panic "haddock:renameDerivD"
 
 renameClsInstD :: ClsInstDecl GhcRn -> RnM (ClsInstDecl DocNameI)
 renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
@@ -552,10 +575,11 @@ renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
   ltype' <- renameLSigType ltype
   lATs'  <- mapM (mapM renameTyFamInstD) lATs
   lADTs' <- mapM (mapM renameDataFamInstD) lADTs
-  return (ClsInstDecl { cid_overlap_mode = omode
+  return (ClsInstDecl { cid_ext = noExt, cid_overlap_mode = omode
                       , cid_poly_ty = ltype', cid_binds = emptyBag
                       , cid_sigs = []
                       , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })
+renameClsInstD (XClsInstDecl _) = panic "haddock:renameClsInstD"
 
 
 renameTyFamInstD :: TyFamInstDecl GhcRn -> RnM (TyFamInstDecl DocNameI)
@@ -575,10 +599,12 @@ renameTyFamInstEqn eqn
       = do { tc' <- renameL tc
            ; pats' <- mapM renameLType pats
            ; rhs' <- renameLType rhs
-           ; return (FamEqn { feqn_tycon  = tc'
+           ; return (FamEqn { feqn_ext    = noExt
+                            , feqn_tycon  = tc'
                             , feqn_pats   = pats'
                             , feqn_fixity = fixity
                             , feqn_rhs    = rhs' }) }
+    rename_ty_fam_eqn (XFamEqn _) = panic "haddock:renameTyFamInstEqn"
 
 renameLTyFamDefltEqn :: LTyFamDefltEqn GhcRn -> RnM (LTyFamDefltEqn DocNameI)
 renameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs
@@ -586,10 +612,12 @@ renameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs
   = do { tc'  <- renameL tc
        ; tvs' <- renameLHsQTyVars tvs
        ; rhs' <- renameLType rhs
-       ; return (L loc (FamEqn { feqn_tycon  = tc'
+       ; return (L loc (FamEqn { feqn_ext    = noExt
+                               , feqn_tycon  = tc'
                                , feqn_pats   = tvs'
                                , feqn_fixity = fixity
                                , feqn_rhs    = rhs' })) }
+renameLTyFamDefltEqn (L _ (XFamEqn _)) = panic "haddock:renameLTyFamDefltEqn"
 
 renameDataFamInstD :: DataFamInstDecl GhcRn -> RnM (DataFamInstDecl DocNameI)
 renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn })
@@ -604,10 +632,12 @@ renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn })
       = do { tc' <- renameL tc
            ; pats' <- mapM renameLType pats
            ; defn' <- renameDataDefn defn
-           ; return (FamEqn { feqn_tycon  = tc'
+           ; return (FamEqn { feqn_ext    = noExt
+                            , feqn_tycon  = tc'
                             , feqn_pats   = pats'
                             , feqn_fixity = fixity
                             , feqn_rhs    = defn' }) }
+    rename_data_fam_eqn (XFamEqn _) = panic "haddock:renameDataFamInstD"
 
 renameImplicit :: (in_thing -> RnM out_thing)
                -> HsImplicitBndrs GhcRn in_thing
@@ -615,8 +645,8 @@ renameImplicit :: (in_thing -> RnM out_thing)
 renameImplicit rn_thing (HsIB { hsib_body = thing })
   = do { thing' <- rn_thing thing
        ; return (HsIB { hsib_body = thing'
-                      , hsib_vars = PlaceHolder
-                      , hsib_closed = PlaceHolder }) }
+                      , hsib_ext = noExt }) }
+renameImplicit _ (XHsImplicitBndrs _) = panic "haddock:renameImplicit"
 
 renameWc :: (in_thing -> RnM out_thing)
          -> HsWildCardBndrs GhcRn in_thing
@@ -624,7 +654,8 @@ renameWc :: (in_thing -> RnM out_thing)
 renameWc rn_thing (HsWC { hswc_body = thing })
   = do { thing' <- rn_thing thing
        ; return (HsWC { hswc_body = thing'
-                      , hswc_wcs = PlaceHolder }) }
+                      , hswc_ext = noExt }) }
+renameWc _ (XHsWildCardBndrs _) = panic "haddock:renameWc"
 
 renameDocInstance :: DocInstance GhcRn -> RnM (DocInstance DocNameI)
 renameDocInstance (inst, idoc, L l n, m) = do
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index a54aad90..80fbc714 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -28,20 +28,18 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 
 -- | Instantiate all occurrences of given names with corresponding types.
-specialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name))
-            => Data a
-            => [(IdP name, HsType name)] -> a -> a
+specialize :: Data a => [(Name, HsType GhcRn)] -> a -> a
 specialize specs = go spec_map0
   where
-    go :: forall x. Data x => Map (IdP name) (HsType name) -> x -> x
-    go spec_map = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map
+    go :: forall x. Data x => Map Name (HsType GhcRn) -> x -> x
+    go spec_map = everywhereButType @Name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map
 
     strip_kind_sig :: HsType name -> HsType name
-    strip_kind_sig (HsKindSig (L _ t) _) = t
+    strip_kind_sig (HsKindSig _ (L _ t) _) = t
     strip_kind_sig typ = typ
 
-    specialize_ty_var :: Map (IdP name) (HsType name) -> HsType name -> HsType name
-    specialize_ty_var spec_map (HsTyVar _ (L _ name'))
+    specialize_ty_var :: Map Name (HsType GhcRn) -> HsType GhcRn -> HsType GhcRn
+    specialize_ty_var spec_map (HsTyVar _ _ (L _ name'))
       | Just t <- Map.lookup name' spec_map = t
     specialize_ty_var _ typ = typ
 
@@ -54,35 +52,33 @@ 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 :: (Ord (IdP name), DataId name, NamedThing (IdP name))
-                     => Data a
-                     => LHsQTyVars name -> [HsType name]
+specializeTyVarBndrs :: Data a
+                     => LHsQTyVars GhcRn -> [HsType GhcRn]
                      -> a -> a
 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 (UserTyVar _ (L _ name)) = name
+    bname (KindedTyVar _ (L _ name) _) = name
+    bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs"
 
 
-specializePseudoFamilyDecl :: (Ord (IdP name), DataId name, NamedThing (IdP name))
-                           => LHsQTyVars name -> [HsType name]
-                           -> PseudoFamilyDecl name
-                           -> PseudoFamilyDecl name
+specializePseudoFamilyDecl :: LHsQTyVars GhcRn -> [HsType GhcRn]
+                           -> PseudoFamilyDecl GhcRn
+                           -> PseudoFamilyDecl GhcRn
 specializePseudoFamilyDecl bndrs typs decl =
   decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)}
 
-specializeSig :: forall name . (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))
-              => LHsQTyVars name -> [HsType name]
-              -> Sig name
-              -> Sig name
-specializeSig bndrs typs (TypeSig lnames typ) =
-  TypeSig lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}})
+specializeSig :: LHsQTyVars GhcRn -> [HsType GhcRn]
+              -> Sig GhcRn
+              -> Sig GhcRn
+specializeSig bndrs typs (TypeSig _ lnames typ) =
+  TypeSig noExt lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}})
   where
-    true_type :: HsType name
+    true_type :: HsType GhcRn
     true_type = unLoc (hsSigWcType typ)
-    typ' :: HsType name
+    typ' :: HsType GhcRn
     typ' = rename fv $ specializeTyVarBndrs bndrs typs true_type
     fv = foldr Set.union Set.empty . map freeVariables $ typs
 specializeSig _ _ sig = sig
@@ -90,8 +86,7 @@ specializeSig _ _ sig = sig
 
 -- | Make all details of instance head (signatures, associated types)
 -- specialized to that particular instance type.
-specializeInstHead :: (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))
-                   => InstHead name -> InstHead name
+specializeInstHead :: InstHead GhcRn -> InstHead GhcRn
 specializeInstHead ihd@InstHead { ihdInstType = clsi@ClassInst { .. }, .. } =
     ihd { ihdInstType = instType' }
   where
@@ -110,27 +105,26 @@ specializeInstHead ihd = ihd
 -- and tuple literals resulting in types like @[] a@ or @(,,) a b c@. This
 -- can be fixed using 'sugar' function, that will turn such types into @[a]@
 -- and @(a, b, c)@.
-sugar :: forall name. (NamedThing (IdP name), DataId name)
-      => HsType name -> HsType name
+sugar :: HsType GhcRn -> HsType GhcRn
 sugar = sugarOperators . sugarTuples . sugarLists
 
-sugarLists :: NamedThing (IdP name) => HsType name -> HsType name
-sugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp)
-    | isBuiltInSyntax name' && strName == "[]" = HsListTy ltyp
+sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
+sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp)
+    | isBuiltInSyntax name' && strName == "[]" = HsListTy NoExt ltyp
   where
     name' = getName name
     strName = occNameString . nameOccName $ name'
 sugarLists typ = typ
 
 
-sugarTuples :: NamedThing (IdP name) => HsType name -> HsType name
+sugarTuples :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
 sugarTuples typ =
     aux [] typ
   where
-    aux apps (HsAppTy (L _ ftyp) atyp) = aux (atyp:apps) ftyp
-    aux apps (HsParTy (L _ typ')) = aux apps typ'
-    aux apps (HsTyVar _ (L _ name))
-        | isBuiltInSyntax name' && suitable = HsTupleTy HsBoxedTuple apps
+    aux apps (HsAppTy _ (L _ ftyp) atyp) = aux (atyp:apps) ftyp
+    aux apps (HsParTy _ (L _ typ')) = aux apps typ'
+    aux apps (HsTyVar _ _ (L _ name))
+        | isBuiltInSyntax name' && suitable = HsTupleTy NoExt HsBoxedTuple apps
       where
         name' = getName name
         strName = occNameString . nameOccName $ name'
@@ -140,10 +134,10 @@ sugarTuples typ =
     aux _ _ = typ
 
 
-sugarOperators :: NamedThing (IdP name) => HsType name -> HsType name
-sugarOperators (HsAppTy (L _ (HsAppTy (L _ (HsTyVar _ (L l name))) la)) lb)
+sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
+sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
     | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
-    | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy la lb
+    | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy NoExt la lb
   where
     name' = getName name
 sugarOperators typ = typ
@@ -208,15 +202,14 @@ setInternalOccName occ name =
 
 
 -- | Compute set of free variables of given type.
-freeVariables :: forall name. (NamedThing (IdP name), DataId name)
-              => HsType name -> Set Name
+freeVariables :: HsType GhcRn -> Set Name
 freeVariables =
     everythingWithState Set.empty Set.union query
   where
-    query term ctx = case cast term :: Maybe (HsType name) of
-        Just (HsForAllTy bndrs _) ->
+    query term ctx = case cast term :: Maybe (HsType GhcRn) of
+        Just (HsForAllTy _ bndrs _) ->
             (Set.empty, Set.union ctx (bndrsNames bndrs))
-        Just (HsTyVar _ (L _ name))
+        Just (HsTyVar _ _ (L _ name))
             | getName name `Set.member` ctx -> (Set.empty, ctx)
             | otherwise -> (Set.singleton $ getName name, ctx)
         _ -> (Set.empty, ctx)
@@ -231,8 +224,7 @@ freeVariables =
 -- different type variable than latter one. Applying 'rename' function
 -- will fix that type to be visually unambiguous again (making it something
 -- like @(a -> b0) -> b@).
-rename :: (Eq (IdP name), DataId name, SetName (IdP name))
-       => Set Name-> HsType name -> HsType name
+rename :: Set Name -> HsType GhcRn -> HsType GhcRn
 rename fv typ = evalState (renameType typ) env
   where
     env = RenameEnv
@@ -252,63 +244,58 @@ data RenameEnv name = RenameEnv
   }
 
 
-renameType :: (Eq (IdP name), SetName (IdP name))
-           => HsType name -> Rename (IdP name) (HsType name)
-renameType (HsForAllTy bndrs lt) =
-    HsForAllTy
+renameType :: HsType GhcRn -> Rename (IdP GhcRn) (HsType GhcRn)
+renameType (HsForAllTy x bndrs lt) =
+    HsForAllTy x
         <$> mapM (located renameBinder) bndrs
         <*> renameLType lt
-renameType (HsQualTy lctxt lt) =
-    HsQualTy
+renameType (HsQualTy x lctxt lt) =
+    HsQualTy x
         <$> located renameContext lctxt
         <*> renameLType lt
-renameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name
-renameType (HsAppTy lf la) = HsAppTy <$> renameLType lf <*> renameLType la
-renameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr
-renameType (HsListTy lt) = HsListTy <$> renameLType lt
-renameType (HsPArrTy lt) = HsPArrTy <$> renameLType lt
-renameType (HsTupleTy srt lt) = HsTupleTy srt <$> mapM renameLType lt
-renameType (HsSumTy lt) = HsSumTy <$> mapM renameLType lt
-renameType (HsOpTy la lop lb) =
-    HsOpTy <$> renameLType la <*> located renameName lop <*> renameLType lb
-renameType (HsParTy lt) = HsParTy <$> renameLType lt
-renameType (HsIParamTy ip lt) = HsIParamTy ip <$> renameLType lt
-renameType (HsEqTy la lb) = HsEqTy <$> renameLType la <*> renameLType lb
-renameType (HsKindSig lt lk) = HsKindSig <$> renameLType lt <*> pure lk
+renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name
+renameType (HsAppTy x lf la) = HsAppTy x <$> renameLType lf <*> renameLType la
+renameType (HsFunTy x la lr) = HsFunTy x <$> renameLType la <*> renameLType lr
+renameType (HsListTy x lt) = HsListTy x <$> renameLType lt
+renameType (HsPArrTy x lt) = HsPArrTy x <$> renameLType lt
+renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt
+renameType (HsSumTy x lt) = HsSumTy x <$> mapM renameLType lt
+renameType (HsOpTy x la lop lb) =
+    HsOpTy x <$> renameLType la <*> located renameName lop <*> renameLType lb
+renameType (HsParTy x lt) = HsParTy x <$> renameLType lt
+renameType (HsIParamTy x ip lt) = HsIParamTy x ip <$> renameLType lt
+renameType (HsEqTy x la lb) = HsEqTy x <$> renameLType la <*> renameLType lb
+renameType (HsKindSig x lt lk) = HsKindSig x <$> renameLType lt <*> pure lk
 renameType t@(HsSpliceTy _ _) = pure t
-renameType (HsDocTy lt doc) = HsDocTy <$> renameLType lt <*> pure doc
-renameType (HsBangTy bang lt) = HsBangTy bang <$> renameLType lt
-renameType t@(HsRecTy _) = pure t
-renameType t@(HsCoreTy _) = pure t
-renameType (HsExplicitListTy ip ph ltys) =
-    HsExplicitListTy ip ph <$> renameLTypes ltys
-renameType (HsExplicitTupleTy phs ltys) =
-    HsExplicitTupleTy phs <$> renameLTypes ltys
-renameType t@(HsTyLit _) = pure t
+renameType (HsDocTy x lt doc) = HsDocTy x <$> renameLType lt <*> pure doc
+renameType (HsBangTy x bang lt) = HsBangTy x bang <$> renameLType lt
+renameType t@(HsRecTy _ _) = pure t
+renameType t@(XHsType (NHsCoreTy _)) = pure t
+renameType (HsExplicitListTy x ip ltys) =
+    HsExplicitListTy x ip <$> renameLTypes ltys
+renameType (HsExplicitTupleTy x ltys) =
+    HsExplicitTupleTy x <$> renameLTypes ltys
+renameType t@(HsTyLit _ _) = pure t
 renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
-renameType (HsAppsTy _) = error "HsAppsTy: Only used before renaming"
+renameType (HsAppsTy _ _) = error "HsAppsTy: Only used before renaming"
 
 
-renameLType :: (Eq (IdP name), SetName (IdP name))
-            => LHsType name -> Rename (IdP name) (LHsType name)
+renameLType :: LHsType GhcRn -> Rename (IdP GhcRn) (LHsType GhcRn)
 renameLType = located renameType
 
 
-renameLTypes :: (Eq (IdP name), SetName (IdP name))
-             => [LHsType name] -> Rename (IdP name) [LHsType name]
+renameLTypes :: [LHsType GhcRn] -> Rename (IdP GhcRn) [LHsType GhcRn]
 renameLTypes = mapM renameLType
 
 
-renameContext :: (Eq (IdP name), SetName (IdP name))
-              => HsContext name -> Rename (IdP name) (HsContext name)
+renameContext :: HsContext GhcRn -> Rename (IdP GhcRn) (HsContext GhcRn)
 renameContext = renameLTypes
 
-renameBinder :: (Eq (IdP name), SetName (IdP name))
-             => HsTyVarBndr name -> Rename (IdP name) (HsTyVarBndr name)
-renameBinder (UserTyVar lname) = UserTyVar <$> located renameName lname
-renameBinder (KindedTyVar lname lkind) =
-  KindedTyVar <$> located renameName lname <*> located renameType lkind
-
+renameBinder :: HsTyVarBndr GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr GhcRn)
+renameBinder (UserTyVar x lname) = UserTyVar x <$> located renameName lname
+renameBinder (KindedTyVar x lname lkind) =
+  KindedTyVar x <$> located renameName lname <*> located renameType lkind
+renameBinder (XTyVarBndr _) = error "haddock:renameBinder"
 
 -- | Core renaming logic.
 renameName :: (Eq name, SetName name) => name -> Rename name name
@@ -363,5 +350,6 @@ located f (L loc e) = L loc <$> f e
 
 
 tyVarName :: HsTyVarBndr name -> IdP name
-tyVarName (UserTyVar name) = unLoc name
-tyVarName (KindedTyVar (L _ name) _) = 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 d5bbce2c..ce6ecc78 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -82,7 +82,7 @@ binaryInterfaceMagic = 0xD0Cface
 -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
 --
 binaryInterfaceVersion :: Word16
-#if (__GLASGOW_HASKELL__ >= 803) && (__GLASGOW_HASKELL__ < 805)
+#if (__GLASGOW_HASKELL__ >= 805) && (__GLASGOW_HASKELL__ < 807)
 binaryInterfaceVersion = 33
 
 binaryInterfaceVersionCompatibility :: [Word16]
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 36ed7baf..1115e829 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -347,7 +347,7 @@ data InstType name
   | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
   | DataInst (TyClDecl name)        -- ^ Data constructors
 
-instance (SourceTextX a, OutputableBndrId a)
+instance (a ~ GhcPass p,OutputableBndrId a)
          => Outputable (InstType a) where
   ppr (ClassInst { .. }) = text "ClassInst"
       <+> ppr clsiCtx
@@ -372,7 +372,7 @@ data PseudoFamilyDecl name = PseudoFamilyDecl
     }
 
 
-mkPseudoFamilyDecl :: FamilyDecl name -> PseudoFamilyDecl name
+mkPseudoFamilyDecl :: FamilyDecl (GhcPass p) -> PseudoFamilyDecl (GhcPass p)
 mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
     { pfdInfo = fdInfo
     , pfdLName = fdLName
@@ -380,11 +380,13 @@ mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
     , pfdKindSig = fdResultSig
     }
   where
-    mkType (KindedTyVar (L loc name) lkind) =
-        HsKindSig tvar lkind
+    mkType (KindedTyVar _ (L loc name) lkind) =
+        HsKindSig NoExt tvar lkind
       where
-        tvar = L loc (HsTyVar NotPromoted (L loc name))
-    mkType (UserTyVar name) = HsTyVar NotPromoted name
+        tvar = L loc (HsTyVar NoExt NotPromoted (L loc name))
+    mkType (UserTyVar _ name) = HsTyVar NoExt NotPromoted name
+    mkType (XTyVarBndr _ ) = panic "haddock:mkPseudoFamilyDecl"
+mkPseudoFamilyDecl (XFamilyDecl {}) = panic "haddock:mkPseudoFamilyDecl"
 
 
 -- | An instance head that may have documentation and a source location.
@@ -666,14 +668,77 @@ instance Monad ErrMsgGhc where
 -- * Pass sensitive types
 -----------------------------------------------------------------------------
 
-type instance PostRn DocNameI NameSet        = PlaceHolder
-type instance PostRn DocNameI Fixity         = PlaceHolder
-type instance PostRn DocNameI Bool           = PlaceHolder
-type instance PostRn DocNameI Name           = DocName
-type instance PostRn DocNameI (Located Name) = Located DocName
-type instance PostRn DocNameI [Name]         = PlaceHolder
-type instance PostRn DocNameI DocName        = DocName
-
-type instance PostTc DocNameI Kind     = PlaceHolder
-type instance PostTc DocNameI Type     = PlaceHolder
-type instance PostTc DocNameI Coercion = PlaceHolder
+type instance XForAllTy        DocNameI = NoExt
+type instance XQualTy          DocNameI = NoExt
+type instance XTyVar           DocNameI = NoExt
+type instance XAppsTy          DocNameI = NoExt
+type instance XAppTy           DocNameI = NoExt
+type instance XFunTy           DocNameI = NoExt
+type instance XListTy          DocNameI = NoExt
+type instance XPArrTy          DocNameI = NoExt
+type instance XTupleTy         DocNameI = NoExt
+type instance XSumTy           DocNameI = NoExt
+type instance XOpTy            DocNameI = NoExt
+type instance XParTy           DocNameI = NoExt
+type instance XIParamTy        DocNameI = NoExt
+type instance XEqTy            DocNameI = NoExt
+type instance XKindSig         DocNameI = NoExt
+type instance XSpliceTy        DocNameI = NoExt
+type instance XDocTy           DocNameI = NoExt
+type instance XBangTy          DocNameI = NoExt
+type instance XRecTy           DocNameI = NoExt
+type instance XExplicitListTy  DocNameI = NoExt
+type instance XExplicitTupleTy DocNameI = NoExt
+type instance XTyLit           DocNameI = NoExt
+type instance XWildCardTy      DocNameI = HsWildCardInfo
+type instance XXType           DocNameI = NewHsTypeX
+
+type instance XUserTyVar    DocNameI = NoExt
+type instance XKindedTyVar  DocNameI = NoExt
+type instance XXTyVarBndr   DocNameI = NoExt
+
+type instance XFieldOcc    DocNameI = DocName
+type instance XXFieldOcc   DocNameI = NoExt
+
+type instance XFixitySig   DocNameI = NoExt
+type instance XFixSig      DocNameI = NoExt
+type instance XPatSynSig   DocNameI = NoExt
+type instance XClassOpSig  DocNameI = NoExt
+type instance XTypeSig     DocNameI = NoExt
+type instance XMinimalSig  DocNameI = NoExt
+
+type instance XForeignExport  DocNameI = NoExt
+type instance XForeignImport  DocNameI = NoExt
+type instance XConDeclGADT    DocNameI = NoExt
+type instance XConDeclH98     DocNameI = NoExt
+
+type instance XDerivD     DocNameI = NoExt
+type instance XInstD      DocNameI = NoExt
+type instance XForD       DocNameI = NoExt
+type instance XSigD       DocNameI = NoExt
+type instance XTyClD      DocNameI = NoExt
+
+type instance XNoSig      DocNameI = NoExt
+type instance XCKindSig   DocNameI = NoExt
+type instance XTyVarSig   DocNameI = NoExt
+
+type instance XCFamEqn       DocNameI _ _ = NoExt
+
+type instance XCClsInstDecl DocNameI = NoExt
+type instance XCDerivDecl   DocNameI = NoExt
+type instance XDataFamInstD DocNameI = NoExt
+type instance XTyFamInstD   DocNameI = NoExt
+type instance XClsInstD     DocNameI = NoExt
+type instance XCHsDataDefn  DocNameI = NoExt
+type instance XCFamilyDecl  DocNameI = NoExt
+type instance XClassDecl    DocNameI = NoExt
+type instance XDataDecl     DocNameI = NoExt
+type instance XSynDecl      DocNameI = NoExt
+type instance XFamDecl      DocNameI = NoExt
+
+type instance XHsIB      DocNameI _ = NoExt
+type instance XHsWC      DocNameI _ = NoExt
+
+type instance XHsQTvs        DocNameI = NoExt
+type instance XConDeclField  DocNameI = NoExt
+
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 84f58ab8..e3cc9655 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -63,7 +63,8 @@ import Haddock.GhcUtils
 import GHC
 import Name
 import NameSet ( emptyNameSet )
-import HsTypes (selectorFieldOcc)
+import HsTypes (extFieldOcc)
+import Outputable ( panic )
 
 import Control.Monad ( liftM )
 import Data.Char ( isAlpha, isAlphaNum, isAscii, ord, chr )
@@ -131,16 +132,19 @@ 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 lname (mkEmptySigWcType (go (hsSigType ltype))))
+addClassContext cls tvs0 (L pos (ClassOpSig _ _ lname ltype))
+  = L pos (TypeSig noExt lname (mkEmptySigWcType (go (hsSigType ltype))))
           -- The mkEmptySigWcType is suspicious
   where
     go (L loc (HsForAllTy { hst_bndrs = tvs, hst_body = ty }))
-       = L loc (HsForAllTy { hst_bndrs = tvs, hst_body = go ty })
+       = L loc (HsForAllTy { hst_xforall = noExt
+                           , hst_bndrs = tvs, hst_body = go ty })
     go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty }))
-       = L loc (HsQualTy { hst_ctxt = add_ctxt ctxt, hst_body = ty })
+       = L loc (HsQualTy { hst_xqual = noExt
+                         , hst_ctxt = add_ctxt ctxt, hst_body = ty })
     go (L loc ty)
-       = L loc (HsQualTy { hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })
+       = L loc (HsQualTy { hst_xqual = noExt
+                         , hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })
 
     extra_pred = nlHsTyConApp cls (lHsQTyVarsToTypes tvs0)
     add_ctxt (L loc preds) = L loc (extra_pred : preds)
@@ -149,7 +153,7 @@ addClassContext _ _ sig = sig   -- E.g. a MinimalSig is fine
 
 lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsType GhcRn]
 lHsQTyVarsToTypes tvs
-  = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv)))
+  = [ noLoc (HsTyVar NoExt NotPromoted (noLoc (hsLTyVarName tv)))
     | tv <- hsQTvExplicit tvs ]
 
 --------------------------------------------------------------------------------
@@ -159,10 +163,10 @@ lHsQTyVarsToTypes tvs
 
 restrictTo :: [Name] -> LHsDecl GhcRn -> LHsDecl GhcRn
 restrictTo names (L loc decl) = L loc $ case decl of
-  TyClD d | isDataDecl d  ->
-    TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
-  TyClD d | isClassDecl d ->
-    TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
+  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
 
@@ -175,42 +179,28 @@ restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
       []    -> defn { dd_ND = DataType, dd_cons = [] }
       [con] -> defn { dd_cons = [con] }
       _ -> error "Should not happen"
+restrictDataDefn _ (XHsDataDefn _) = error "restrictDataDefn"
 
 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 getConDetails h98d of
+      case con_args d of
         PrefixCon _ -> Just d
         RecCon fields
           | all field_avail (unL fields) -> Just d
-          | otherwise -> Just (h98d { con_details = PrefixCon (field_types (map unL (unL fields))) })
+          | 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
-        h98d = h98ConDecl d
-        h98ConDecl c@ConDeclH98{} = c
-        h98ConDecl c@ConDeclGADT{} = c'
-          where
-            (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c)
-            c' :: ConDecl GhcRn
-            c' = ConDeclH98
-                   { con_name = head (con_names c)
-                   , con_qvars = Just $ HsQTvs { hsq_implicit = mempty
-                                               , hsq_explicit = tvs
-                                               , hsq_dependent = emptyNameSet }
-                   , con_cxt = Just cxt
-                   , con_details = details
-                   , con_doc = con_doc c
-                   }
-
         field_avail :: LConDeclField GhcRn -> Bool
-        field_avail (L _ (ConDeclField fs _ _))
-            = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs
-        field_types flds = [ t | ConDeclField _ t _ <- flds ]
+        field_avail (L _ (ConDeclField _ fs _ _))
+            = all (\f -> extFieldOcc (unLoc f) `elem` names) fs
+        field_avail (L _ (XConDeclField _)) = panic "haddock:field_avail"
+        field_types flds = [ t | ConDeclField _ _ t _ <- flds ]
 
     keep _ = Nothing
 
@@ -221,13 +211,14 @@ 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 Name
+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_implicit = error "haddock:emptyHsQTvs"
-                     , hsq_explicit = []
-                     , hsq_dependent = error "haddock:emptyHsQTvs" }
+emptyHsQTvs = HsQTvs { hsq_ext = HsQTvsRn
+                       { hsq_implicit = error "haddock:emptyHsQTvs"
+                       , hsq_dependent = error "haddock:emptyHsQTvs" }
+                     , hsq_explicit = [] }
 
 
 --------------------------------------------------------------------------------