From 26a6eaaed227afbd5c8d47c04c72827c60d3935f Mon Sep 17 00:00:00 2001 From: Mark Lentczner Date: Wed, 14 Jul 2010 23:43:42 +0000 Subject: clean up synopsis lists --- src/Haddock/Backends/Xhtml/Decl.hs | 30 +++++++++++++++--------------- src/Haddock/Backends/Xhtml/Layout.hs | 15 +++++++-------- 2 files changed, 22 insertions(+), 23 deletions(-) (limited to 'src') diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index ef7d01d4..fc0fce5c 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -64,7 +64,7 @@ ppFunSig summary links loc doc docname typ unicode = ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> DocName -> HsType DocName -> DocForDecl DocName -> (Html, Html, Html) -> Bool -> Html ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) unicode - | summary = declElem pref1 + | summary = pref1 | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocToHtml doc | otherwise = topDeclElem links loc docname pref2 +++ subArguments (do_args 0 sep typ) +++ maybeDocToHtml doc @@ -159,7 +159,7 @@ ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Html ppTyFam summary associated links loc mbDoc decl unicode - | summary = declElem (ppTyFamHeader True associated decl unicode) + | summary = ppTyFamHeader True associated decl unicode | otherwise = header_ +++ maybeDocToHtml mbDoc +++ instancesBit where @@ -199,7 +199,7 @@ ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Html ppTyInst summary associated links loc mbDoc decl unicode - | summary = declElem(ppTyInstHeader True associated decl unicode) + | summary = ppTyInstHeader True associated decl unicode | otherwise = header_ +++ maybeDocToHtml mbDoc where @@ -331,14 +331,14 @@ ppFds fds unicode = ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, DocForDecl DocName)] -> Bool -> Html ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc subdocs unicode = if null sigs && null ats - then (if summary then declElem else topDeclElem links loc nm) hdr - else (if summary then declElem else topDeclElem links loc nm) (hdr <+> keyword "where") - +++ vanillaTable << aboves + then (if summary then id else topDeclElem links loc nm) hdr + else (if summary then id else topDeclElem links loc nm) (hdr <+> keyword "where") + +++ shortSubDecls ( - [ argBox $ ppAssocType summary links doc at unicode | at <- ats + [ ppAssocType summary links doc at unicode | at <- ats , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ] ++ - [ argBox $ ppFunSig summary links loc doc n typ unicode + [ ppFunSig summary links loc doc n typ unicode | L _ (TypeSig (L _ n) (L _ typ)) <- sigs , let doc = lookupAnySubdoc n subdocs ] ) @@ -407,17 +407,17 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool -> Html ppShortDataDecl summary _links _loc dataDecl unicode - | [] <- cons = declElem dataHeader + | [] <- cons = dataHeader | [lcon] <- cons, ResTyH98 <- resTy, (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode - = declElem (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot + = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot - | ResTyH98 <- resTy = declElem dataHeader - +++ unordList (zipWith doConstr ('=':repeat '|') cons) + | ResTyH98 <- resTy = dataHeader + +++ shortSubDecls (zipWith doConstr ('=':repeat '|') cons) - | otherwise = declElem (dataHeader <+> keyword "where") - +++ unordList (map doGADTConstr cons) + | otherwise = (dataHeader <+> keyword "where") + +++ shortSubDecls (map doGADTConstr cons) where dataHeader = ppDataHeader summary dataDecl unicode @@ -493,7 +493,7 @@ ppShortConstrParts summary con unicode = case con_res con of InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml) where - doRecordFields fields = unordList (map (ppShortField summary unicode) fields) + doRecordFields fields = shortSubDecls (map (ppShortField summary unicode) fields) doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [ ppForAll forall ltvs lcontext unicode, ppLType unicode (foldr mkFunTy resTy args) ] diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index d9b1c250..86e75740 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -17,6 +17,8 @@ module Haddock.Backends.Xhtml.Layout ( sectionName, shortDeclList, + shortSubDecls, + divTopDecl, SubDecl, @@ -29,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout ( topDeclElem, declElem, - argBox, vanillaTable, vanillaTable2 + vanillaTable, vanillaTable2 ) where import Haddock.Backends.Xhtml.DocMarkup @@ -65,6 +67,10 @@ sectionName = paragraph ! [theclass "caption"] shortDeclList :: [Html] -> Html shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items +shortSubDecls :: [Html] -> Html +shortSubDecls items = ulist ! [theclass "subs"] << map (li <<) items + + divTopDecl :: Html -> Html divTopDecl = thediv ! [theclass "top"] @@ -163,13 +169,6 @@ topDeclElem ((_,_,maybe_source_url), (_,_,maybe_wiki_url)) loc name html = --- a box for displaying an 'argument' (some code which has text to the --- right of it). Wrapping is not allowed in these boxes, whereas it is --- in a declBox. -argBox :: Html -> HtmlTable -argBox html = tda [theclass "arg"] << html - - -- a vanilla table has width 100%, no border, no padding, no spacing vanillaTable, vanillaTable2 :: Html -> Html vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0] -- cgit v1.2.3