diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 24 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 18 | 
2 files changed, 28 insertions, 14 deletions
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  | 
