diff options
| author | Mark Lentczner <markl@glyphic.com> | 2010-07-14 23:43:42 +0000 | 
|---|---|---|
| committer | Mark Lentczner <markl@glyphic.com> | 2010-07-14 23:43:42 +0000 | 
| commit | 26a6eaaed227afbd5c8d47c04c72827c60d3935f (patch) | |
| tree | c3ff6d89de97ced562aab211152a22b0ba0d18bb /src/Haddock/Backends | |
| parent | ab2ec30f12e283f4d28d1aa52b0980c96b0a7036 (diff) | |
clean up synopsis lists
Diffstat (limited to 'src/Haddock/Backends')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 30 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 15 | 
2 files changed, 22 insertions, 23 deletions
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]  | 
