aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/LaTeX.hs16
-rw-r--r--src/Haddock/Backends/Xhtml.hs1
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs42
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs5
4 files changed, 40 insertions, 24 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 94adc558..2185340b 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -284,7 +284,7 @@ ppDecl :: LHsDecl DocName
ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
TyClD d@(FamDecl {}) -> ppTyFam False loc doc d unicode
TyClD d@(DataDecl {})
- -> ppDataDecl instances subdocs loc doc d unicode
+ -> ppDataDecl instances subdocs loc (Just doc) d unicode
TyClD d@(SynDecl {}) -> ppTySyn loc (doc, fnArgsDoc) d unicode
-- Family instances happen via FamInst now
-- TyClD d@(TySynonym {})
@@ -560,9 +560,11 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
ppInstHead :: Bool -> InstHead DocName -> LaTeX
-ppInstHead unicode ([], n, ts) = ppAppNameTypes n ts unicode
-ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode
-
+ppInstHead unicode (n, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ts unicode
+ppInstHead unicode (n, ts, TypeInst rhs) = keyword "type"
+ <+> ppAppNameTypes n ts unicode <+> equals <+> ppType unicode rhs
+ppInstHead _unicode (_n, _ts, DataInst _dd) =
+ error "data instances not supported by --latex yet"
lookupAnySubdoc :: (Eq name1) =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
@@ -577,8 +579,8 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
ppDataDecl :: [DocInstance DocName] ->
- [(DocName, DocForDecl DocName)] ->
- SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
+ [(DocName, DocForDecl DocName)] -> SrcSpan ->
+ Maybe (Documentation DocName) -> TyClDecl DocName -> Bool ->
LaTeX
ppDataDecl instances subdocs _loc doc dataDecl unicode
@@ -590,7 +592,7 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
cons = dd_cons (tcdDataDefn dataDecl)
resTy = (con_res . unLoc . head) cons
- body = catMaybes [constrBit, documentationToLaTeX doc]
+ body = catMaybes [constrBit, doc >>= documentationToLaTeX]
(whereBit, leaders)
| null cons = (empty,[])
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 3168c7b0..53b106a2 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -648,6 +648,7 @@ numberSectionHeadings = go 1
processExport :: Bool -> LinksInfo -> Bool -> Qualification
-> ExportItem DocName -> Maybe Html
+processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _) = Nothing -- Hide empty instances
processExport summary _ _ qual (ExportGroup lev id0 doc)
= nothingIf summary $ groupHeading lev id0 << docToHtml qual doc
processExport summary links unicode qual (ExportDecl decl doc subdocs insts)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index acde5a0f..9180c3c3 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -41,7 +41,7 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] ->
Bool -> Qualification -> Html
ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of
- TyClD (FamDecl d) -> ppTyFam summ False links loc mbDoc d unicode qual
+ TyClD (FamDecl d) -> ppTyFam summ False links instances loc mbDoc d unicode qual
TyClD d@(DataDecl {}) -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
TyClD d@(SynDecl {}) -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual
@@ -212,9 +212,9 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
Nothing -> noHtml
)
-ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
+ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan -> Documentation DocName ->
FamilyDecl DocName -> Bool -> Qualification -> Html
-ppTyFam summary associated links loc doc decl unicode qual
+ppTyFam summary associated links instances loc doc decl unicode qual
| summary = ppTyFamHeader True associated decl unicode qual
| otherwise = header_ +++ docSection qual doc +++ instancesBit
@@ -225,16 +225,19 @@ ppTyFam summary associated links loc doc decl unicode qual
header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
instancesBit
- | FamilyDecl { fdInfo = ClosedTypeFamily _eqns } <- decl
+ | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
, not summary
- = noHtml -- TODO: print eqns
+ = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
| otherwise
= ppInstances instances docname unicode qual
- -- TODO: get the instances
- instances = []
-
+ -- Individual equation of a closed type family
+ ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs
+ , tfie_pats = HsWB { hswb_cts = ts }}
+ = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual
+ <+> equals <+> ppType unicode qual (unLoc rhs)
+ , Nothing, [] )
--------------------------------------------------------------------------------
-- * Associated Types
@@ -244,7 +247,7 @@ ppTyFam summary associated links loc doc decl unicode qual
ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName -> Bool
-> Qualification -> Html
ppAssocType summ links doc (L loc decl) unicode qual =
- ppTyFam summ True links loc (fst doc) decl unicode qual
+ ppTyFam summ True links [] loc (fst doc) decl unicode qual
--------------------------------------------------------------------------------
@@ -423,10 +426,14 @@ ppInstances instances baseName unicode qual
instName = getOccString $ getName baseName
instDecl :: DocInstance DocName -> SubDecl
instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
- instHead ([], n, ts) = ppAppNameTypes n ts unicode qual
- instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode qual
+ instHead (n, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
<+> ppAppNameTypes n ts unicode qual
-
+ instHead (n, ts, TypeInst rhs) = keyword "type"
+ <+> ppAppNameTypes n ts unicode qual
+ <+> equals <+> ppType unicode qual rhs
+ instHead (n, ts, DataInst dd) = keyword "data"
+ <+> ppAppNameTypes n ts unicode qual
+ <+> ppShortDataDecl False True dd unicode qual
lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
@@ -438,9 +445,8 @@ lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-- TODO: print contexts
-ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool
- -> Qualification -> Html
-ppShortDataDecl summary _links _loc dataDecl unicode qual
+ppShortDataDecl :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
+ppShortDataDecl summary dataInst dataDecl unicode qual
| [] <- cons = dataHeader
@@ -455,7 +461,9 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
+++ shortSubDecls (map doGADTConstr cons)
where
- dataHeader = ppDataHeader summary dataDecl unicode qual
+ dataHeader
+ | dataInst = noHtml
+ | otherwise = ppDataHeader summary dataDecl unicode qual
doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
@@ -469,7 +477,7 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
Qualification -> Html
ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
- | summary = ppShortDataDecl summary links loc dataDecl unicode qual
+ | summary = ppShortDataDecl summary False dataDecl unicode qual
| otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
where
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 4584fd82..dbc043be 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -29,6 +29,7 @@ module Haddock.Backends.Xhtml.Layout (
subArguments,
subAssociatedTypes,
subConstructors,
+ subEquations,
subFields,
subInstances,
subMethods,
@@ -165,6 +166,10 @@ subFields :: Qualification -> [SubDecl] -> Html
subFields qual = divSubDecls "fields" "Fields" . subDlist qual
+subEquations :: Qualification -> [SubDecl] -> Html
+subEquations qual = divSubDecls "equations" "Equations" . subTable qual
+
+
subInstances :: Qualification -> String -> [SubDecl] -> Html
subInstances qual nm = maybe noHtml wrap . instTable
where
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 12:51:59 +0000