aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--haddock-api/src/Haddock/Convert.hs9
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs4
-rw-r--r--haddock-api/src/Haddock/Utils.hs7
6 files changed, 17 insertions, 11 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index e8baae88..be17cb8b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -117,7 +117,7 @@ decls (group, _, _, _) = concatMap ($ group)
]
where
typ (GHC.L _ t) = case t of
- GHC.DataDecl name _ _ _ -> pure . decl $ name
+ GHC.DataDecl { tcdLName = name } -> pure . decl $ name
GHC.SynDecl name _ _ _ -> pure . decl $ name
GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index b7be7ffb..81a23a1b 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -641,7 +641,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
ppOcc = case occ of
[one] -> ppBinder one
_ -> cat (punctuate comma (map ppBinder occ))
- tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+ 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,
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 2f802aef..b354658d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -776,7 +776,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con of
[one] -> ppBinderInfix summary one
_ -> hsep (punctuate comma (map (ppBinderInfix summary) occ))
- ltvs = fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)
+ ltvs = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)
tyVars = tyvarNames ltvs
lcontext = fromMaybe (noLoc []) (con_cxt con)
context = unLoc lcontext
@@ -846,7 +846,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
[one] -> ppBinderInfix False one
_ -> hsep (punctuate comma (map (ppBinderInfix False) occ))
- tyVars = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con))
+ 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,
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 3ad5c164..283803a3 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -27,6 +27,7 @@ import DataCon
import FamInstEnv
import HsSyn
import Name
+import NameSet ( emptyNameSet )
import RdrName ( mkVarUnqual )
import PatSyn
import SrcLoc ( Located, noLoc, unLoc )
@@ -145,7 +146,7 @@ synifyTyCon _coax tc
in HsQTvs { hsq_implicit = [] -- No kind polymorphism
, hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc)))
alphaTyVars --a, b, c... which are unfortunately all kind *
- }
+ , hsq_dependent = emptyNameSet }
, tcdDataDefn = HsDataDefn { dd_ND = DataType -- arbitrary lie, they are neither
-- algebraic data nor newtype:
@@ -155,6 +156,7 @@ synifyTyCon _coax tc
-- we have their kind accurately:
, dd_cons = [] -- No constructors
, dd_derivs = Nothing }
+ , tcdDataCusk = False
, tcdFVs = placeHolderNamesTc }
synifyTyCon _coax tc
@@ -234,7 +236,7 @@ synifyTyCon coax tc
in case lefts consRaw of
[] -> return $
DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
- , tcdFVs = placeHolderNamesTc }
+ , tcdDataCusk = False, tcdFVs = placeHolderNamesTc }
dataConErrs -> Left $ unlines dataConErrs
synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity
@@ -323,7 +325,8 @@ synifyCtx = noLoc . map (synifyType WithinType)
synifyTyVars :: [TyVar] -> LHsQTyVars Name
synifyTyVars ktvs = HsQTvs { hsq_implicit = []
- , hsq_explicit = map synifyTyVar ktvs }
+ , hsq_explicit = map synifyTyVar ktvs
+ , hsq_dependent = emptyNameSet }
synifyTyVar :: TyVar -> LHsTyVarBndr Name
synifyTyVar tv
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 0f97ee3b..3054e2f9 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -270,7 +270,7 @@ renameType t = case t of
renameLHsQTyVars :: LHsQTyVars Name -> RnM (LHsQTyVars DocName)
renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs })
= do { tvs' <- mapM renameLTyVarBndr tvs
- ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = 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
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
@@ -350,7 +350,7 @@ renameTyClD d = case d of
lname' <- renameL lname
tyvars' <- renameLHsQTyVars tyvars
defn' <- renameDataDefn defn
- return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames })
+ return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })
ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 325dd710..58a7ef90 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -64,6 +64,7 @@ import Haddock.GhcUtils
import GHC
import Name
+import NameSet ( emptyNameSet )
import HsTypes (selectorFieldOcc)
import Control.Monad ( liftM )
@@ -201,7 +202,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
c' = ConDeclH98
{ con_name = head (con_names c)
, con_qvars = Just $ HsQTvs { hsq_implicit = mempty
- , hsq_explicit = tvs }
+ , hsq_explicit = tvs
+ , hsq_dependent = emptyNameSet }
, con_cxt = Just cxt
, con_details = details
, con_doc = con_doc c
@@ -226,7 +228,8 @@ emptyHsQTvs :: LHsQTyVars Name
-- 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_explicit = []
+ , hsq_dependent = error "haddock:emptyHsQTvs" }
--------------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 06:28:57 +0000