aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-03-31 12:25:23 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-04-07 19:32:47 -0400
commit5ec817a3e41b7eaa50c74701ab2d7642df86464c (patch)
tree15a6639360ecc3a5c72503932a52862b4a17292b /haddock-api/src/Haddock/Backends
parentcb65d6f3d452f46dcdd87347f50ce1548aa3fbbb (diff)
Make NoExtCon fields strict
These changes are a part of a fix for [GHC#17992](https://gitlab.haskell.org/ghc/ghc/issues/17992).
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs8
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs12
3 files changed, 0 insertions, 22 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 93ca4cfd..36001714 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -196,7 +196,6 @@ ppFam dflags decl@(FamilyDecl { fdInfo = info })
-- for Hoogle, so pretend it doesn't have any.
ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily }
_ -> decl
-ppFam _ (XFamilyDecl nec) = noExtCon nec
ppInstance :: DynFlags -> ClsInst -> [String]
ppInstance dflags x =
@@ -269,7 +268,6 @@ ppCtor dflags _dat subdocs con@(ConDeclGADT { })
typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty)
name = out dflags $ map unL $ getConNames con
-ppCtor _ _ _ (XConDecl nec) = noExtCon nec
ppFixity :: DynFlags -> (Name, Fixity) -> [String]
ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExtField [noLoc name] fixity) :: FixitySig GhcRn)]
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 98b13756..560a0f40 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -349,8 +349,6 @@ ppFamDecl doc instances decl unicode =
, equals
, ppType unicode (unLoc rhs)
]
- ppFamDeclEqn (XHsImplicitBndrs nec) = noExtCon nec
- ppFamDeclEqn (HsIB { hsib_body = XFamEqn nec}) = noExtCon nec
instancesBit = ppDocInstances unicode instances
@@ -358,7 +356,6 @@ ppFamDecl doc instances decl unicode =
ppFamHeader :: FamilyDecl DocNameI -- ^ family header to print
-> Bool -- ^ unicode
-> LaTeX
-ppFamHeader (XFamilyDecl nec) _ = noExtCon nec
ppFamHeader (FamilyDecl { fdLName = L _ name
, fdTyVars = tvs
, fdInfo = info
@@ -378,7 +375,6 @@ ppFamHeader (FamilyDecl { fdLName = L _ name
NoSig _ -> empty
KindSig _ kind -> dcolon unicode <+> ppLKind unicode kind
TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode bndr
- XFamilyResultSig nec -> noExtCon nec
injAnn = case injectivity of
Nothing -> empty
@@ -797,7 +793,6 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
-- ++AZ++ make this prepend "{..}" when it is a record style GADT
, ppLType unicode (getGADTConType con)
]
- XConDecl nec -> noExtCon nec
fieldPart = case (con, getConArgs con) of
-- Record style GADTs
@@ -831,7 +826,6 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
[ l <+> text "\\enspace" <+> r
| (l,r) <- ppSubSigLike unicode (unLoc (getGADTConType con)) argDocs subdocs (dcolon unicode)
]
- XConDecl nec -> noExtCon nec
-- don't use "con_doc con", in case it's reconstructed from a .hi file,
@@ -851,7 +845,6 @@ ppSideBySideField subdocs unicode (ConDeclField _ names ltype _) =
-- 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 (extFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst
-ppSideBySideField _ _ (XConDeclField nec) = noExtCon nec
-- | Pretty-print a bundled pattern synonym
@@ -1018,7 +1011,6 @@ ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name
ppHsTyVarBndr unicode (KindedTyVar _ (L _ name) kind) =
parens (ppDocName name) <+> dcolon unicode <+> ppLKind unicode kind
-ppHsTyVarBndr _ (XTyVarBndr nec) = noExtCon nec
ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
ppLKind unicode y = ppKind unicode (unLoc y)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 97db7b86..c22afeed 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -327,8 +327,6 @@ ppFamDecl summary associated links instances fixities loc doc decl splice unicod
, Nothing
, []
)
- ppFamDeclEqn (XHsImplicitBndrs nec) = noExtCon nec
- ppFamDeclEqn (HsIB { hsib_body = XFamEqn nec}) = noExtCon nec
-- | Print a pseudo family declaration
@@ -353,7 +351,6 @@ ppFamHeader :: Bool -- ^ is a summary
-> Bool -- ^ is an associated type
-> FamilyDecl DocNameI -- ^ family declaration
-> Unicode -> Qualification -> Html
-ppFamHeader _ _ (XFamilyDecl nec) _ _ = noExtCon nec
ppFamHeader summary associated (FamilyDecl { fdInfo = info
, fdResultSig = L _ result
, fdInjectivityAnn = injectivity
@@ -393,7 +390,6 @@ 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
- XFamilyResultSig nec -> noExtCon nec
--------------------------------------------------------------------------------
@@ -751,7 +747,6 @@ 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
@@ -785,7 +780,6 @@ 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
@@ -868,7 +862,6 @@ ppShortConstrParts summary dataInst con unicode qual
, noHtml
, noHtml
)
- XConDecl nec -> noExtCon nec
where
occ = map (nameOccName . getName . unLoc) $ getConNamesI con
@@ -938,7 +931,6 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
, ppLType unicode qual HideEmptyContexts (getGADTConType con)
, fixity
]
- XConDecl nec -> noExtCon nec
fieldPart = case (con, getConArgs con) of
-- Record style GADTs
@@ -967,7 +959,6 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
ConDeclGADT{} ->
ppSubSigLike unicode qual (unLoc (getGADTConType con))
argDocs subdocs (dcolon unicode) HideEmptyContexts
- XConDecl nec -> noExtCon nec
-- 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.
@@ -1011,14 +1002,12 @@ ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) =
-- 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 (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst
-ppSideBySideField _ _ _ (XConDeclField nec) = noExtCon nec
ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
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 nec) = noExtCon nec
-- | Pretty print an expanded pattern (for bundled patterns)
@@ -1125,7 +1114,6 @@ ppHsTyVarBndr _ qual (UserTyVar _ (L _ name)) =
ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) =
parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
ppLKind unicode qual kind)
-ppHsTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec
ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
ppLKind unicode qual y = ppKind unicode qual (unLoc y)