aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs131
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs222
-rw-r--r--haddock-api/src/Haddock/Convert.hs10
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs2
-rw-r--r--haddock-api/src/Haddock/Options.hs2
6 files changed, 221 insertions, 152 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 40da7ceb..d294b612 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -75,6 +75,7 @@ import Packages
import Panic (handleGhcException)
import Module
import FastString
+import qualified DynamicLoading
--------------------------------------------------------------------------------
-- * Exception handling
@@ -448,7 +449,10 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do
-- that may need to be re-linked: Haddock doesn't do any
-- dynamic or static linking at all!
_ <- setSessionDynFlags dynflags''
- ghcActs dynflags''
+ hscenv <- GHC.getSession
+ dynflags''' <- liftIO (DynamicLoading.initializePlugins hscenv dynflags'')
+ _ <- setSessionDynFlags dynflags'''
+ ghcActs dynflags'''
where
-- ignore sublists of flags that start with "+RTS" and end in "-RTS"
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 4a3e9d03..4e0e6eba 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -12,10 +12,9 @@
-- Portability : portable
-----------------------------------------------------------------------------
module Haddock.Backends.LaTeX (
- ppLaTeX
+ ppLaTeX,
) where
-
import Documentation.Haddock.Markup
import Haddock.Types
import Haddock.Utils
@@ -285,7 +284,7 @@ ppDecl :: LHsDecl DocNameI -- ^ decl to print
-> LaTeX
ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
- TyClD _ d@FamDecl {} -> ppTyFam False doc d unicode
+ TyClD _ d@FamDecl {} -> ppFamDecl doc instances d unicode
TyClD _ d@DataDecl {} -> ppDataDecl pats instances subdocs (Just doc) d unicode
TyClD _ d@SynDecl {} -> ppTySyn (doc, fnArgsDoc) d unicode
-- Family instances happen via FamInst now
@@ -303,12 +302,6 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
unicode = False
-ppTyFam :: Bool -> Documentation DocName ->
- TyClDecl DocNameI -> Bool -> LaTeX
-ppTyFam _ _ _ _ =
- error "type family declarations are currently not supported by --latex"
-
-
ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
ppFunSig doc [name] (hsSigType typ) unicode
@@ -317,6 +310,83 @@ ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
-------------------------------------------------------------------------------
+-- * Type families
+-------------------------------------------------------------------------------
+
+-- | Pretty-print a data\/type family declaration
+ppFamDecl :: Documentation DocName -- ^ this decl's docs
+ -> [DocInstance DocNameI] -- ^ relevant instances
+ -> TyClDecl DocNameI -- ^ family to print
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppFamDecl doc instances decl unicode =
+ declWithDoc (ppFamHeader (tcdFam decl) unicode <+> whereBit)
+ (if null body then Nothing else Just (vcat body))
+ $$ instancesBit
+ where
+ body = catMaybes [familyEqns, documentationToLaTeX doc]
+
+ whereBit = case fdInfo (tcdFam decl) of
+ ClosedTypeFamily _ -> keyword "where"
+ _ -> empty
+
+ familyEqns
+ | FamilyDecl { fdInfo = ClosedTypeFamily (Just eqns) } <- tcdFam decl
+ = Just (text "\\haddockbeginargs" $$
+ vcat [ decltt (ppFamDeclEqn eqn) <+> nl | L _ eqn <- eqns ] $$
+ text "\\end{tabulary}\\par")
+ | otherwise = Nothing
+
+ -- Individual equations of a closed type family
+ ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX
+ ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n
+ , feqn_rhs = rhs
+ , feqn_pats = ts } })
+ = hsep [ ppAppNameTypes n (map unLoc ts) unicode
+ , equals
+ , ppType unicode (unLoc rhs)
+ ]
+ ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"
+ ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl"
+
+ instancesBit = ppDocInstances unicode instances
+
+-- | Print the LHS of a type\/data family declaration.
+ppFamHeader :: FamilyDecl DocNameI -- ^ family header to print
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppFamHeader (XFamilyDecl _) _ = panic "haddock;ppFamHeader"
+ppFamHeader (FamilyDecl { fdLName = L _ name
+ , fdTyVars = tvs
+ , fdInfo = info
+ , fdResultSig = L _ result
+ , fdInjectivityAnn = injectivity })
+ unicode =
+ leader <+> keyword "family" <+> famName <+> famSig <+> injAnn
+ where
+ leader = case info of
+ OpenTypeFamily -> keyword "type"
+ ClosedTypeFamily _ -> keyword "type"
+ DataFamily -> keyword "data"
+
+ famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs)
+
+ famSig = case result of
+ NoSig _ -> empty
+ KindSig _ kind -> dcolon unicode <+> ppLKind unicode kind
+ TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode bndr
+ XFamilyResultSig _ -> panic "haddock:ppFamHeader"
+
+ injAnn = case injectivity of
+ Nothing -> empty
+ Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( decltt (text "|")
+ : ppLDocName lhs
+ : arrow unicode
+ : map ppLDocName rhs)
+
+
+
+-------------------------------------------------------------------------------
-- * Type Synonyms
-------------------------------------------------------------------------------
@@ -538,12 +608,14 @@ ppClassDecl instances doc subdocs
| otherwise = error "LaTeX.ppClassDecl"
methodTable =
- text "\\haddockpremethods{}\\textbf{Methods}" $$
- vcat [ ppFunSig doc [name] (hsSigWcType typ) unicode
+ text "\\haddockpremethods{}" <> emph (text "Methods") $$
+ vcat [ ppFunSig doc names (hsSigWcType typ) unicode
| L _ (TypeSig _ lnames typ) <- lsigs
- , name <- map unLoc lnames
- , let doc = lookupAnySubdoc name subdocs
- ]
+ , let doc = lookupAnySubdoc (head names) subdocs
+ names = map unLoc lnames ]
+ -- FIXME: is taking just the first name ok? Is it possible that
+ -- there are different subdocs for different names in a single
+ -- type signature?
instancesBit = ppDocInstances unicode instances
@@ -573,14 +645,13 @@ ppDocInstance unicode (instHead, doc, _, _) =
ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX
-ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
-
-
-ppInstHead :: Bool -> InstHead DocNameI -> LaTeX
-ppInstHead unicode (InstHead {..}) = case ihdInstType of
- ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
- TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
- DataInst _ -> error "data instances not supported by --latex yet"
+ppInstDecl unicode (InstHead {..}) = case ihdInstType of
+ ClassInst ctx _ _ _ -> keyword "instance" <+> ppContextNoLocs ctx unicode <+> typ
+ TypeInst rhs -> keyword "type" <+> keyword "instance" <+> typ <+> tibody rhs
+ DataInst dd ->
+ let nd = dd_ND (tcdDataDefn dd)
+ pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }
+ in pref <+> keyword "instance" <+> typ
where
typ = ppAppNameTypes ihdClsName ihdTypes unicode
tibody = maybe empty (\t -> equals <+> ppType unicode t)
@@ -613,7 +684,7 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
cons = dd_cons (tcdDataDefn dataDecl)
resTy = (unLoc . head) cons
- body = catMaybes [constrBit,patternBit, doc >>= documentationToLaTeX]
+ body = catMaybes [doc >>= documentationToLaTeX, constrBit,patternBit]
(whereBit, leaders)
| null cons
@@ -823,6 +894,12 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument"
-- * Type applications
--------------------------------------------------------------------------------
+ppAppDocNameTyVarBndrs :: Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX
+ppAppDocNameTyVarBndrs unicode n vs =
+ ppTypeApp n vs ppDN (ppHsTyVarBndr unicode . unLoc)
+ where
+ ppDN = ppBinder . nameOccName . getName
+
-- | Print an application of a DocName to its list of HsTypes
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX
@@ -917,6 +994,12 @@ ppType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
ppFunLhType unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode
+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 _) = panic "haddock:ppHsTyVarBndr"
+
ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
ppLKind unicode y = ppKind unicode (unLoc y)
@@ -973,7 +1056,7 @@ ppr_mono_ty (HsParTy _ ty) unicode
ppr_mono_ty (HsDocTy _ ty _) unicode
= ppr_mono_lty ty unicode
-ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = char '_'
+ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = text "\\_"
ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index cc271fef..12e65716 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -15,9 +15,7 @@
-----------------------------------------------------------------------------
module Haddock.Backends.Xhtml.Decl (
ppDecl,
-
- ppTyName, ppTyFamHeader, ppTypeApp, ppOrphanInstances,
- tyvarNames
+ ppOrphanInstances,
) where
import Haddock.Backends.Xhtml.DocMarkup
@@ -56,7 +54,7 @@ ppDecl :: Bool -- ^ print summary info only
-> 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 _ (FamDecl _ d) -> ppFamDecl 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
@@ -67,7 +65,7 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc
ForD _ d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
InstD _ _ -> noHtml
DerivD _ _ -> noHtml
- _ -> error "declaration not supported by ppDecl"
+ _ -> error "declaration not supported by ppDecl"
ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
@@ -222,9 +220,6 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs
-tyvarNames :: LHsQTyVars DocNameI -> [Name]
-tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
-
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
-> ForeignDecl DocNameI -> [(DocName, Fixity)]
@@ -283,111 +278,111 @@ ppSimpleSig links splice unicode qual emptyCtxts loc names typ =
--------------------------------------------------------------------------------
-ppFamilyInfo :: Bool -> FamilyInfo DocNameI -> Html
-ppFamilyInfo assoc OpenTypeFamily
- | assoc = keyword "type"
- | otherwise = keyword "type family"
-ppFamilyInfo assoc DataFamily
- | assoc = keyword "data"
- | otherwise = keyword "data family"
-ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family"
-
-
-ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocNameI
- -> Unicode -> Qualification -> Html
-ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
- , fdResultSig = L _ result
- , fdInjectivityAnn = injectivity })
- unicode qual =
- (case info of
- OpenTypeFamily
- | associated -> keyword "type"
- | otherwise -> keyword "type family"
- DataFamily
- | associated -> keyword "data"
- | otherwise -> keyword "data family"
- ClosedTypeFamily _
- -> keyword "type family"
- ) <+>
-
- ppFamDeclBinderWithVars summary unicode qual d <+>
- ppResultSig result unicode qual <+>
-
- (case injectivity of
- Nothing -> noHtml
- Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn
- ) <+>
-
- (case info of
- 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
- XFamilyResultSig _ -> panic "haddock:ppResultSig"
-
-ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI
- -> Html
-ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
- ppFamilyInfo True pfdInfo <+>
- ppAppNameTypes (unLoc pfdLName) (map unLoc pfdTyVars) unicode qual <+>
- ppResultSig (unLoc pfdKindSig) unicode qual
-
-ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocNameI -> Html
-ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
- char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>
- hsep (map (ppLDocName qual Raw) rhs)
-
-
-ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->
- [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
- FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->
- Qualification -> Html
-ppTyFam summary associated links instances fixities loc doc decl splice unicode
- pkg qual
-
- | summary = ppTyFamHeader True associated decl unicode qual
+-- | Print a data\/type family declaration
+ppFamDecl :: Bool -- ^ is a summary
+ -> Bool -- ^ is an associated type
+ -> LinksInfo
+ -> [DocInstance DocNameI] -- ^ relevant instances
+ -> [(DocName, Fixity)] -- ^ relevant fixities
+ -> SrcSpan
+ -> Documentation DocName -- ^ this decl's documentation
+ -> FamilyDecl DocNameI -- ^ this decl
+ -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppFamDecl summary associated links instances fixities loc doc decl splice unicode pkg qual
+ | summary = ppFamHeader True associated decl unicode qual
| otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit
where
docname = unLoc $ fdLName decl
header_ = topDeclElem links loc splice [docname] $
- ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
+ ppFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
instancesBit
| FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl
, not summary
- = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
+ = subEquations pkg qual $ map (ppFamDeclEqn . unLoc) $ fromMaybe [] mb_eqns
| otherwise
= ppInstances links (OriginFamily docname) instances splice unicode pkg qual
-- Individual equation of a closed type family
- ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl
- ppTyFamEqn (HsIB { hsib_body = FamEqn { feqn_tycon = n, feqn_rhs = rhs
- , feqn_pats = ts } })
- = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual
+ ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
+ ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n
+ , feqn_rhs = rhs
+ , feqn_pats = ts } })
+ = ( ppAppNameTypes 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"
-
+ , Nothing
+ , []
+ )
+ ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"
+ ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl"
-ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification
- -> PseudoFamilyDecl DocNameI
- -> Html
-ppPseudoFamilyDecl links splice unicode qual
- decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =
- wrapper $ ppPseudoFamilyHeader unicode qual decl
+-- | Print a pseudo family declaration
+ppPseudoFamDecl :: LinksInfo -> Splice
+ -> PseudoFamilyDecl DocNameI -- ^ this decl
+ -> Unicode -> Qualification -> Html
+ppPseudoFamDecl links splice
+ (PseudoFamilyDecl { pfdInfo = info
+ , pfdKindSig = L _ kindSig
+ , pfdTyVars = tvs
+ , pfdLName = L loc name })
+ unicode qual =
+ topDeclElem links loc splice [name] leader
+ where
+ leader = hsep [ ppFamilyLeader True info
+ , ppAppNameTypes name (map unLoc tvs) unicode qual
+ , ppResultSig kindSig unicode qual
+ ]
+
+-- | Print the LHS of a type\/data family declaration
+ppFamHeader :: Bool -- ^ is a summary
+ -> Bool -- ^ is an associated type
+ -> FamilyDecl DocNameI -- ^ family declaration
+ -> Unicode -> Qualification -> Html
+ppFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppFamHeader"
+ppFamHeader summary associated (FamilyDecl { fdInfo = info
+ , fdResultSig = L _ result
+ , fdInjectivityAnn = injectivity
+ , fdLName = L _ name
+ , fdTyVars = tvs })
+ unicode qual =
+ hsep [ ppFamilyLeader associated info
+ , ppAppDocNameTyVarBndrs summary unicode qual name (hsq_explicit tvs)
+ , ppResultSig result unicode qual
+ , injAnn
+ , whereBit
+ ]
where
- wrapper = topDeclElem links loc splice [name]
+ whereBit = case info of
+ ClosedTypeFamily _ -> keyword "where ..."
+ _ -> noHtml
+
+ injAnn = case injectivity of
+ Nothing -> noHtml
+ Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( keyword "|"
+ : ppLDocName qual Raw lhs
+ : arrow unicode
+ : map (ppLDocName qual Raw) rhs)
+
+-- | Print the keywords that begin the family declaration
+ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
+ppFamilyLeader assoc info = keyword (typ ++ if assoc then "" else " family")
+ where
+ typ = case info of
+ OpenTypeFamily -> "type"
+ ClosedTypeFamily _ -> "type"
+ DataFamily -> "data"
+
+-- | Print the signature attached to a family
+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
+ XFamilyResultSig _ -> panic "haddock:ppResultSig"
--------------------------------------------------------------------------------
@@ -399,25 +394,10 @@ ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI
-> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package
-> Qualification -> Html
ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =
- ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
+ ppFamDecl summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
--------------------------------------------------------------------------------
--- * TyClDecl helpers
---------------------------------------------------------------------------------
-
--- | Print a type family and its variables
-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
-ppDataBinderWithVars summ unicode qual decl =
- ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)
-
---------------------------------------------------------------------------------
-- * Type applications
--------------------------------------------------------------------------------
@@ -672,7 +652,9 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) m
, mdoc
, [subFamInstDetails iid pdecl mname])
where
- pdata = keyword "data" <+> typ
+ nd = dd_ND (tcdDataDefn dd)
+ pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }
+ pdata = pref <+> typ
pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
where
mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl
@@ -684,9 +666,7 @@ ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
-> [PseudoFamilyDecl DocNameI]
-> [Html]
ppInstanceAssocTys links splice unicode qual =
- map ppFamilyDecl'
- where
- ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual
+ map (\pseudo -> ppPseudoFamDecl links splice pseudo unicode qual)
ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
@@ -1060,10 +1040,12 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) =
-- | Print the LHS of a data\/newtype declaration.
-- Currently doesn't handle 'data instance' decls or kind signatures
ppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html
-ppDataHeader summary decl@(DataDecl { tcdDataDefn =
- HsDataDefn { dd_ND = nd
- , dd_ctxt = ctxt
- , dd_kindSig = ks } })
+ppDataHeader summary (DataDecl { tcdDataDefn =
+ HsDataDefn { dd_ND = nd
+ , dd_ctxt = ctxt
+ , dd_kindSig = ks }
+ , tcdLName = L _ name
+ , tcdTyVars = tvs })
unicode qual
= -- newtype or data
(case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
@@ -1071,7 +1053,7 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn =
-- context
ppLContext ctxt unicode qual HideEmptyContexts <+>
-- T a b c ..., or a :+: b
- ppDataBinderWithVars summary unicode qual decl
+ ppAppDocNameTyVarBndrs summary unicode qual name (hsQTvExplicit tvs)
<+> case ks of
Nothing -> mempty
Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
@@ -1120,7 +1102,7 @@ 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 _) = error "haddock:ppHsTyVarBndr"
+ppHsTyVarBndr _ _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr"
ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
ppLKind unicode qual y = ppKind unicode qual (unLoc y)
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 6eee353b..044e1e11 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -36,9 +36,10 @@ import TyCon
import Type
import TyCoRep
import TysPrim ( alphaTyVars )
-import TysWiredIn ( listTyConName, liftedTypeKindTyConName, unitTy )
-import PrelNames ( hasKey, eqTyConKey, eqTyConName, ipClassKey
- , tYPETyConKey, liftedRepDataConKey )
+import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName
+ , unitTy )
+import PrelNames ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey
+ , liftedRepDataConKey )
import Unique ( getUnique )
import Util ( chkAppend, compareLength, dropList, filterByList, filterOut
, splitAtList )
@@ -118,8 +119,7 @@ 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_ext = HsIBRn { hsib_vars = map tyVarName tkvs
- , hsib_closed = True }
+ in HsIB { hsib_ext = map tyVarName tkvs
, hsib_body = FamEqn { feqn_ext = noExt
, feqn_tycon = name
, feqn_pats = annot_typats
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 1c976410..351a39d1 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -23,7 +23,7 @@ import GHC hiding (NoLink)
import Name
import Outputable ( panic )
import RdrName (RdrName(Exact))
-import PrelNames (eqTyCon_RDR)
+import TysWiredIn (eqTyCon_RDR)
import Control.Applicative
import Control.Monad hiding (mapM)
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index e89fcbde..46db572b 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -189,7 +189,7 @@ options backwardsCompat =
Option [] ["gen-index"] (NoArg Flag_GenIndex)
"generate an HTML index from specified\ninterfaces",
Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports)
- "behave as if all modules have the\nignore-exports atribute",
+ "behave as if all modules have the\nignore-exports attribute",
Option [] ["hide"] (ReqArg Flag_HideModule "MODULE")
"behave as if MODULE has the hide attribute",
Option [] ["show"] (ReqArg Flag_ShowModule "MODULE")
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-28 12:16:46 +0000