diff options
-rw-r--r-- | html/xhaddock.css | 16 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 14 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 29 |
3 files changed, 36 insertions, 23 deletions
diff --git a/html/xhaddock.css b/html/xhaddock.css index 731eee8a..d5e86c61 100644 --- a/html/xhaddock.css +++ b/html/xhaddock.css @@ -286,6 +286,22 @@ div.subs { margin-top: 0; } +.subs.associated-types, +.subs.methods { + margin-left: 20px; +} + +.subs.associated-types .caption, +.subs.methods .caption { + margin-top: 0.5em; + margin-left: -10px; +} + +.subs.associated-types .src + .src, +.subs.methods .src + .src { + margin-top: 8px; +} + p.arg { margin-bottom: 0; } diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 6e0c5601..ef7d01d4 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -366,23 +366,13 @@ ppClassDecl summary links instances loc mbDoc subdocs hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds - atBit - | null ats = noHtml - | otherwise = atHdr +++ ( - thediv ! [theclass "subdecl"] << - concatHtml [ ppAssocType summary links doc at unicode + atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode | at <- ats , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ] - ) - methodBit - | null lsigs = noHtml - | otherwise = methHdr +++ ( - thediv ! [theclass "subdecl"] << - concatHtml [ ppFunSig summary links loc doc n typ unicode + methodBit = subMethods [ ppFunSig summary links loc doc n typ unicode | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs , let doc = lookupAnySubdoc n subdocs ] - ) instancesBit = ppInstances instances nm unicode diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 205f659c..d9b1c250 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -21,13 +21,14 @@ module Haddock.Backends.Xhtml.Layout ( SubDecl, subArguments, + subAssociatedTypes, subConstructors, subFields, subInstances, + subMethods, topDeclElem, declElem, - atHdr, methHdr, argBox, vanillaTable, vanillaTable2 ) where @@ -98,23 +99,34 @@ subTable decls = Just $ table << aboves (concatMap subRow decls) <-> td << nonEmpty (fmap docToHtml mdoc)) : map (cell . (td <<)) subs - -subArguments :: [(Html, Maybe (Doc DocName), [Html])] -> Html +subBlock :: [Html] -> Maybe Html +subBlock [] = Nothing +subBlock hs = Just $ toHtml hs + + +subArguments :: [SubDecl] -> Html subArguments = divSubDecls "arguments" "Arguments" . subTable -subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html +subAssociatedTypes :: [Html] -> Html +subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock + +subConstructors :: [SubDecl] -> Html subConstructors = divSubDecls "constructors" "Constructors" . subTable -subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html +subFields :: [SubDecl] -> Html subFields = divSubDecls "fields" "Fields" . subTable -subInstances :: String -> [(Html, Maybe (Doc DocName), [Html])] -> Html +subInstances :: String -> [SubDecl] -> Html subInstances id_ = divSubDecls "instances" instCaption . instTable where instCaption = collapsebutton id_ +++ " Instances" instTable = (collapsed thediv id_ `fmap`) . subTable +subMethods :: [Html] -> Html +subMethods = divSubDecls "methods" "Methods" . subBlock + + -- a box for displaying code declElem :: Html -> Html declElem = paragraph ! [theclass "src"] @@ -162,8 +174,3 @@ argBox html = tda [theclass "arg"] << html vanillaTable, vanillaTable2 :: Html -> Html vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0] vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0] - - -methHdr, atHdr :: Html -methHdr = h5 << "Methods" -atHdr = h5 << "Associated Types" |