Changes to compile with 8.0

8 files changed, 82 insertions, 82 deletions

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index ef873500..70cdf8a3 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -269,7 +269,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
       (Map.map SrcExternal extSrcMap)
       (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ])
 
-    pkgSrcMap = Map.mapKeys modulePackageKey extSrcMap
+    pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap
     pkgSrcMap'
       | Flag_HyperlinkedSource `elem` flags =
           Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index a8882fe2..1adcddfc 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -122,8 +122,8 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl
         f (TyClD d@DataDecl{})  = ppData dflags d subdocs
         f (TyClD d@SynDecl{})   = ppSynonym dflags d
         f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs
-        f (ForD (ForeignImport name typ _ _)) = pp_sig dflags [name] (hsSigType typ)
-        f (ForD (ForeignExport name typ _ _)) = pp_sig dflags [name] (hsSigType typ)
+        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 _ = []
 
@@ -157,10 +157,10 @@ ppClass :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
 ppClass dflags decl subdocs = (out dflags decl{tcdSigs=[]} ++ ppTyFams) :  ppMethods
     where
 
-        ppMethods = concat . map (ppSig' . unL . add_ctxt) $ tcdSigs decl
-        ppSig' = flip (ppSigWithDoc dflags) subdocs . addContext
+        ppMethods = concat . map (ppSig' . unLoc . add_ctxt) $ tcdSigs decl
+        ppSig' = flip (ppSigWithDoc dflags) subdocs
 
-        add_ctxt = addClassContext (tcdName x) (tyClDeclTyVars x)
+        add_ctxt = addClassContext (tcdName decl) (tyClDeclTyVars decl)
 
         ppTyFams
             | null $ tcdATs decl = ""
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 5eca973e..060534bf 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
 
 
 module Haddock.Backends.Hyperlinker.Ast (enrich) where
@@ -10,6 +11,7 @@ import Haddock.Syb
 import Haddock.Backends.Hyperlinker.Types
 
 import qualified GHC
+import qualified FieldLabel as GHC
 
 import Control.Applicative
 import Data.Data
@@ -56,8 +58,8 @@ variables =
   where
     var term = case cast term of
         (Just (GHC.L sspan (GHC.HsVar name))) ->
-            pure (sspan, RtkVar name)
-        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _))) ->
+            pure (sspan, RtkVar (GHC.unLoc name))
+        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->
             pure (sspan, RtkVar name)
         _ -> empty
     rec term = case cast term of
@@ -72,7 +74,7 @@ types =
   where
     ty term = case cast term of
         (Just (GHC.L sspan (GHC.HsTyVar name))) ->
-            pure (sspan, RtkType name)
+            pure (sspan, RtkType (GHC.unLoc name))
         _ -> empty
 
 -- | Obtain details map for identifier bindings.
@@ -85,12 +87,12 @@ binds =
     everything (<|>) (fun `combine` pat `combine` tvar)
   where
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name)) ->
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) ->
             pure (sspan, RtkBind name)
         _ -> empty
     pat term = case cast term of
         (Just (GHC.L sspan (GHC.VarPat name))) ->
-            pure (sspan, RtkBind name)
+            pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
             [(sspan, RtkVar name)] ++ everything (<|>) rec recs
         (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
@@ -102,7 +104,7 @@ binds =
         _ -> empty
     tvar term = case cast term of
         (Just (GHC.L sspan (GHC.UserTyVar name))) ->
-            pure (sspan, RtkBind name)
+            pure (sspan, RtkBind (GHC.unLoc name))
         (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
             pure (sspan, RtkBind name)
         _ -> empty
@@ -121,7 +123,7 @@ decls (group, _, _, _) = concatMap ($ group)
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
     con term = case cast term of
@@ -134,9 +136,10 @@ decls (group, _, _, _) = concatMap ($ group)
             pure . tyref $ GHC.tfe_tycon eqn
         _ -> empty
     fld term = case cast term of
-        Just field -> map decl $ GHC.cd_fld_names field
+        Just (field :: GHC.ConDeclField GHC.Name)
+          -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
-    sig (GHC.L _ (GHC.TypeSig names _ _)) = map decl names
+    sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
     sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
@@ -153,7 +156,8 @@ imports src@(_, imps, _, _) =
         (Just (GHC.IEVar v)) -> pure $ var v
         (Just (GHC.IEThingAbs t)) -> pure $ typ t
         (Just (GHC.IEThingAll t)) -> pure $ typ t
-        (Just (GHC.IEThingWith t vs)) -> [typ t] ++ map var vs
+        (Just (GHC.IEThingWith t _ vs _fls)) ->
+          [typ t] ++ map var vs
         _ -> 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/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 124debfb..ae1905bf 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -270,24 +270,25 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
   ) <+>
 
   ppFamDeclBinderWithVars summary d <+>
-
-  (case result of
-    NoSig               -> noHtml
-    KindSig kind        -> dcolon unicode  <+> ppLKind unicode qual kind
-    TyVarSig (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
-  ) <+>
+  ppResultSig result unicode qual <+>
 
   (case injectivity of
      Nothing                   -> noHtml
      Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn
   )
 
+ppResultSig :: FamilyResultSig DocName -> 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
+
 ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocName
                      -> Html
 ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
     ppFamilyInfo True pfdInfo <+>
     ppAppNameTypes (unLoc pfdLName) [] (map unLoc pfdTyVars) unicode qual <+>
-    ppFamilyKind unicode qual pfdKindSig
+    ppResultSig (unLoc pfdKindSig) unicode qual
 
 ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocName -> Html
 ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
@@ -530,7 +531,7 @@ ppClassDecl summary links instances fixities loc d subdocs
     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
@@ -612,9 +613,12 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
               -> [Sig DocName]
               -> [Html]
 ppInstanceSigs links splice unicode qual sigs = do
-    TypeSig lnames (L loc typ) _ <- sigs
+    TypeSig lnames typ <- sigs
     let names = map unLoc lnames
-    return $ ppSimpleSig links splice unicode qual loc names typ
+        L loc rtyp = get_type typ
+    return $ ppSimpleSig links splice unicode qual loc names rtyp
+    where
+      get_type = hswc_body . hsib_body
 
 
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 664598ab..4a7ad162 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -100,14 +100,8 @@ tyThingToLHsDecl t = case t of
     (synifySigWcType ImplicitizeForAll (dataConUserType dc)))
 
   AConLike (PatSynCon ps) ->
-      let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps
-          qtvs = univ_tvs ++ ex_tvs
-          ty = mkFunTys arg_tys res_ty
-      in allOK . SigD $ PatSynSig (synifyName ps)
-                          (Implicit, synifyTyVars qtvs)
-                          (synifyCtx req_theta)
-                          (synifyCtx prov_theta)
-                          (synifyType WithinType ty)
+    allOK . SigD $ PatSynSig (synifyName ps) (synifySigType WithinType
+                                  (patSynType ps))
   where
     withErrs e x = return (e, x)
     allOK x = return (mempty, x)
@@ -457,5 +451,5 @@ synifyFamInst fi opaque = do
         return . TypeInst . Just . unLoc . synifyType WithinType $ fi_rhs fi
     ityp (DataFamilyInst c) =
         DataInst <$> synifyTyCon (Just $ famInstAxiom fi) c
-    (ks,ts) = partitionInvisibles (classTyCon cls) id $ fi_tys fi
+    (ks,ts) = partitionInvisibles (famInstTyCon fi) id $ fi_tys fi
     synifyTypes = map (unLoc. synifyType WithinType)
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index e3a5a7d5..859afe6e 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -294,7 +294,7 @@ renameInstHead InstHead {..} = do
   itype <- case ihdInstType of
     ClassInst { .. } -> ClassInst
         <$> mapM renameType clsiCtx
-        <*> renameLTyVarBndrs clsiTyVars
+        <*> renameLHsQTyVars clsiTyVars
         <*> mapM renameSig clsiSigs
         <*> mapM renamePseudoFamilyDecl clsiAssocTys
     TypeInst  ts -> TypeInst  <$> traverse renameType ts
@@ -390,7 +390,7 @@ renamePseudoFamilyDecl (PseudoFamilyDecl { .. }) =  PseudoFamilyDecl
     <$> renameFamilyInfo pfdInfo
     <*> renameL pfdLName
     <*> mapM renameLType pfdTyVars
-    <*> renameMaybeLKind pfdKindSig
+    <*> renameFamilyResultSig pfdKindSig
 
 
 renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index d6466570..e9b9c60a 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -36,7 +36,7 @@ specialize :: (Eq name, Typeable name)
 specialize name details =
     everywhere $ mkT step
   where
-    step (HsTyVar name') | name == name' = details
+    step (HsTyVar (L _ name')) | name == name' = details
     step typ = typ
 
 
@@ -56,18 +56,18 @@ specialize' = flip $ foldr (uncurry specialize)
 -- length of type list should be the same as the number of binders.
 specializeTyVarBndrs :: (Eq name, Typeable name, DataId name)
                      => Data a
-                     => LHsTyVarBndrs name -> [HsType name]
+                     => LHsQTyVars name -> [HsType name]
                      -> a -> a
 specializeTyVarBndrs bndrs typs =
     specialize' $ zip bndrs' typs
   where
-    bndrs' = map (bname . unLoc) . hsq_tvs $ bndrs
-    bname (UserTyVar name) = name
+    bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs
+    bname (UserTyVar (L _ name)) = name
     bname (KindedTyVar (L _ name) _) = name
 
 
 specializePseudoFamilyDecl :: (Eq name, Typeable name, DataId name)
-                           => LHsTyVarBndrs name -> [HsType name]
+                           => LHsQTyVars name -> [HsType name]
                            -> PseudoFamilyDecl name
                            -> PseudoFamilyDecl name
 specializePseudoFamilyDecl bndrs typs decl =
@@ -76,14 +76,17 @@ specializePseudoFamilyDecl bndrs typs decl =
     specializeTyVars = specializeTyVarBndrs bndrs typs
 
 
-specializeSig :: (Eq name, Typeable name, DataId name, SetName name)
-              => LHsTyVarBndrs name -> [HsType name]
+specializeSig :: forall name . (Eq name, Typeable name, DataId name, SetName name)
+              => LHsQTyVars name -> [HsType name]
               -> Sig name
               -> Sig name
-specializeSig bndrs typs (TypeSig lnames (L loc typ) prn) =
-    TypeSig lnames (L loc typ') prn
+specializeSig bndrs typs (TypeSig lnames typ) =
+    TypeSig lnames (typ { hsib_body = (hsib_body typ) { hswc_body = noLoc typ'}})
   where
-    typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs typ
+    true_type :: HsType name
+    true_type = unLoc (hswc_body (hsib_body typ))
+    typ' :: HsType name
+    typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs true_type
     fv = foldr Set.union Set.empty . map freeVariables $ typs
 specializeSig _ _ sig = sig
 
@@ -120,7 +123,7 @@ sugar =
 
 
 sugarLists :: NamedThing name => HsType name -> HsType name
-sugarLists (HsAppTy (L _ (HsTyVar name)) ltyp)
+sugarLists (HsAppTy (L _ (HsTyVar (L _ name))) ltyp)
     | isBuiltInSyntax name' && strName == "[]" = HsListTy ltyp
   where
     name' = getName name
@@ -134,7 +137,7 @@ sugarTuples typ =
   where
     aux apps (HsAppTy (L _ ftyp) atyp) = aux (atyp:apps) ftyp
     aux apps (HsParTy (L _ typ')) = aux apps typ'
-    aux apps (HsTyVar name)
+    aux apps (HsTyVar (L _ name))
         | isBuiltInSyntax name' && suitable = HsTupleTy HsBoxedTuple apps
       where
         name' = getName name
@@ -146,8 +149,8 @@ sugarTuples typ =
 
 
 sugarOperators :: NamedThing name => HsType name -> HsType name
-sugarOperators (HsAppTy (L _ (HsAppTy (L loc (HsTyVar name)) la)) lb)
-    | isSymOcc $ getOccName name' = mkHsOpTy la (L loc name) lb
+sugarOperators (HsAppTy (L _ (HsAppTy (L loc (HsTyVar (L l name))) la)) lb)
+    | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
     | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy la lb
   where
     name' = getName name
@@ -219,13 +222,13 @@ freeVariables =
     everythingWithState Set.empty Set.union query
   where
     query term ctx = case cast term :: Maybe (HsType name) of
-        Just (HsForAllTy _ _ bndrs _ _) ->
+        Just (HsForAllTy bndrs _) ->
             (Set.empty, Set.union ctx (bndrsNames bndrs))
-        Just (HsTyVar name)
+        Just (HsTyVar (L _ name))
             | getName name `Set.member` ctx -> (Set.empty, ctx)
             | otherwise -> (Set.singleton $ getNameRep name, ctx)
         _ -> (Set.empty, ctx)
-    bndrsNames = Set.fromList . map (getName . tyVarName . unLoc) . hsq_tvs
+    bndrsNames = Set.fromList . map (getName . tyVarName . unLoc)
 
 
 -- | Make given type visually unambiguous.
@@ -256,26 +259,26 @@ data RenameEnv name = RenameEnv
 
 
 renameType :: SetName name => HsType name -> Rename name (HsType name)
-renameType (HsForAllTy ex mspan lbndrs lctx lt) = rebind lbndrs $ \lbndrs' ->
+renameType (HsForAllTy bndrs lt) = rebind bndrs $ \bndrs' ->
     HsForAllTy
-        <$> pure ex
-        <*> pure mspan
-        <*> pure lbndrs'
-        <*> located renameContext lctx
+        <$> pure bndrs'
         <*> renameLType lt
-renameType (HsTyVar name) = HsTyVar <$> renameName name
+renameType (HsQualTy lctxt lt) =
+  HsQualTy
+        <$> located renameContext lctxt
+        <*> renameLType lt
+renameType (HsTyVar name) = HsTyVar <$> 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 (HsOpTy la lop lb) =
-    HsOpTy <$> renameLType la <*> renameLTyOp lop <*> renameLType 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 t@(HsQuasiQuoteTy _) = pure t
 renameType t@(HsSpliceTy _ _) = pure t
 renameType (HsDocTy lt doc) = HsDocTy <$> renameLType lt <*> pure doc
 renameType (HsBangTy bang lt) = HsBangTy bang <$> renameLType lt
@@ -286,9 +289,7 @@ renameType (HsExplicitListTy ph ltys) =
 renameType (HsExplicitTupleTy phs ltys) =
     HsExplicitTupleTy phs <$> renameLTypes ltys
 renameType t@(HsTyLit _) = pure t
-renameType (HsWrapTy wrap t) = HsWrapTy wrap <$> renameType t
-renameType HsWildcardTy = pure HsWildcardTy
-renameType (HsNamedWildcardTy name) = HsNamedWildcardTy <$> renameName name
+renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
 
 
 renameLType :: SetName name => LHsType name -> Rename name (LHsType name)
@@ -302,21 +303,20 @@ renameLTypes = mapM renameLType
 renameContext :: SetName name => HsContext name -> Rename name (HsContext name)
 renameContext = renameLTypes
 
-
+{-
 renameLTyOp :: SetName name => LHsTyOp name -> Rename name (LHsTyOp name)
 renameLTyOp (wrap, lname) = (,) wrap <$> located renameName lname
+-}
 
 
 renameName :: SetName name => name -> Rename name name
 renameName name = do
     RenameEnv { rneCtx = ctx } <- ask
-    pure $ case Map.lookup (getName name) ctx of
-        Just name' -> name'
-        Nothing -> name
+    pure $ fromMaybe name (Map.lookup (getName name) ctx)
 
 
 rebind :: SetName name
-       => LHsTyVarBndrs name -> (LHsTyVarBndrs name -> Rename name a)
+       => [LHsTyVarBndr name] -> ([LHsTyVarBndr name] -> Rename name a)
        -> Rename name a
 rebind lbndrs action = do
     (lbndrs', env') <- runState (rebindLTyVarBndrs lbndrs) <$> ask
@@ -324,16 +324,14 @@ rebind lbndrs action = do
 
 
 rebindLTyVarBndrs :: SetName name
-                  => LHsTyVarBndrs name -> Rebind name (LHsTyVarBndrs name)
-rebindLTyVarBndrs lbndrs = do
-    tys' <- mapM (located rebindTyVarBndr) $ hsq_tvs lbndrs
-    pure $ lbndrs { hsq_tvs = tys' }
+                  => [LHsTyVarBndr name] -> Rebind name [LHsTyVarBndr name]
+rebindLTyVarBndrs lbndrs = mapM (located rebindTyVarBndr) lbndrs
 
 
 rebindTyVarBndr :: SetName name
                 => HsTyVarBndr name -> Rebind name (HsTyVarBndr name)
-rebindTyVarBndr (UserTyVar name) =
-    UserTyVar <$> rebindName name
+rebindTyVarBndr (UserTyVar (L l name)) =
+    UserTyVar . L l <$> rebindName name
 rebindTyVarBndr (KindedTyVar name kinds) =
     KindedTyVar <$> located rebindName name <*> pure kinds
 
@@ -403,5 +401,5 @@ located f (L loc e) = L loc <$> f e
 
 
 tyVarName :: HsTyVarBndr name -> name
-tyVarName (UserTyVar name) = name
+tyVarName (UserTyVar name) = unLoc name
 tyVarName (KindedTyVar (L _ name) _) = name
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index e07f55f1..6bc00f63 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -326,7 +326,7 @@ instance SetName DocName where
 data InstType name
   = ClassInst
       { clsiCtx :: [HsType name]
-      , clsiTyVars :: LHsTyVarBndrs name
+      , clsiTyVars :: LHsQTyVars name
       , clsiSigs :: [Sig name]
       , clsiAssocTys :: [PseudoFamilyDecl name]
       }
@@ -353,7 +353,7 @@ data PseudoFamilyDecl name = PseudoFamilyDecl
     { pfdInfo :: FamilyInfo name
     , pfdLName :: Located name
     , pfdTyVars :: [LHsType name]
-    , pfdKindSig :: Maybe (LHsKind name)
+    , pfdKindSig :: LFamilyResultSig name
     }
 
 
@@ -361,14 +361,14 @@ mkPseudoFamilyDecl :: FamilyDecl name -> PseudoFamilyDecl name
 mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
     { pfdInfo = fdInfo
     , pfdLName = fdLName
-    , pfdTyVars = [ L loc (mkType bndr) | L loc bndr <- hsq_tvs fdTyVars ]
-    , pfdKindSig = fdKindSig
+    , pfdTyVars = [ L loc (mkType bndr) | L loc bndr <- hsq_explicit fdTyVars ]
+    , pfdKindSig = fdResultSig
     }
   where
     mkType (KindedTyVar (L loc name) lkind) =
         HsKindSig tvar lkind
       where
-        tvar = L loc (HsTyVar name)
+        tvar = L loc (HsTyVar (L loc name))
     mkType (UserTyVar name) = HsTyVar name