diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 24 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 18 |
4 files changed, 30 insertions, 16 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..fab6bf8d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -607,20 +607,26 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = , [subInstDetails iid ats sigs] ) where - iid = instanceId origin no orphan ihd sigs = ppInstanceSigs links splice unicode qual clsiSigs ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys TypeInst rhs -> - (ptype, mdoc, []) + ( subInstHead iid ptype + , mdoc + , [subFamInstDetails iid prhs] + ) where - ptype = keyword "type" <+> typ <+> prhs - prhs = maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs + ptype = keyword "type" <+> typ + prhs = ptype <+> maybe noHtml + (\t -> equals <+> ppType unicode qual t) rhs DataInst dd -> - (pdata, mdoc, []) + ( subInstHead iid pdata + , mdoc + , [subFamInstDetails iid pdecl]) where - pdata = keyword "data" <+> typ <+> pdecl - pdecl = ppShortDataDecl False True dd unicode qual + pdata = keyword "data" <+> typ + pdecl = pdata <+> ppShortDataDecl False True dd unicode qual where + iid = instanceId origin no orphan ihd typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual @@ -776,7 +782,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 +852,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/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 26aeaff8..41457f72 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -31,7 +31,8 @@ module Haddock.Backends.Xhtml.Layout ( subConstructors, subEquations, subFields, - subInstances, subOrphanInstances, subInstHead, subInstDetails, + subInstances, subOrphanInstances, + subInstHead, subInstDetails, subFamInstDetails, subMethods, subMinimal, @@ -179,7 +180,6 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc subConstructors :: Qualification -> [SubDecl] -> Html subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual - subFields :: Qualification -> [SubDecl] -> Html subFields qual = divSubDecls "fields" "Fields" . subDlist qual @@ -226,10 +226,18 @@ subInstDetails :: String -- ^ Instance unique id (for anchor generation) -> [Html] -- ^ Method contents (pretty-printed signatures) -> Html subInstDetails iid ats mets = - section << (subAssociatedTypes ats <+> subMethods mets) - where - section = thediv ! collapseSection (instAnchorId iid) False "inst-details" + subInstSection iid << (subAssociatedTypes ats <+> subMethods mets) + +subFamInstDetails :: String -- ^ Instance unique id (for anchor generation) + -> Html -- ^ Type or data family instance + -> Html +subFamInstDetails iid fi = + subInstSection iid << thediv ! [theclass "src"] << fi +subInstSection :: String -- ^ Instance unique id (for anchor generation) + -> Html + -> Html +subInstSection iid = thediv ! collapseSection (instAnchorId iid) False "inst-details" instAnchorId :: String -> String instAnchorId iid = makeAnchorId $ "i:" ++ iid |