aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Xhtml/Layout.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends/Xhtml/Layout.hs')
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs38
1 files changed, 28 insertions, 10 deletions
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 3ab93b82..80dd5ec8 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -18,7 +18,9 @@ module Haddock.Backends.Xhtml.Layout (
shortDeclList,
divTopDecl,
- subDecls,
+
+ SubDecl,
+ subConstructors, subFields,
topDeclElem, declElem,
@@ -33,7 +35,6 @@ import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Util
import Haddock.Types
-import Data.Char (isLetter, toLower)
import Text.XHtml hiding ( name, title, p, quote )
import FastString ( unpackFS )
@@ -65,15 +66,32 @@ shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
divTopDecl :: Html -> Html
divTopDecl = thediv ! [theclass "top"]
-subDecls :: String -> [(Html, Maybe Html)] -> Html
-subDecls _ [] = noHtml
-subDecls name decls = subSection << (subCaption +++ subList)
+
+type SubDecl = (Html, Maybe (Doc DocName), [Html])
+
+divSubDecls :: String -> String -> Maybe Html -> Html
+divSubDecls cssClass captionName = maybe noHtml wrap
+ where
+ wrap = (subSection <<) . (subCaption +++)
+ subSection = thediv ! [theclass $ unwords ["subs", cssClass]]
+ subCaption = paragraph ! [theclass "caption"] << captionName
+
+subDlist :: [SubDecl] -> Maybe Html
+subDlist [] = Nothing
+subDlist decls = Just $ dlist << map subEntry decls
where
- subSection = thediv ! [theclass $ unwords ["subs", subClass]]
- subClass = map (\c -> if isLetter c then toLower c else '-') name
- subCaption = paragraph ! [theclass "caption"] << name
- subList = dlist << map subEntry decls
- subEntry (dt,dd) = [dterm ! [theclass "src"] << dt, ddef << nonEmpty dd]
+ subEntry (decl, mdoc, subs) = Just $
+ dterm ! [theclass "src"] << decl
+ +++ ddef << (fmap docToHtml mdoc `with` subs)
+ Nothing `with` [] = spaceHtml
+ ma `with` bs = ma +++ bs
+
+subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subConstructors = divSubDecls "constructors" "Constructors" . subDlist
+
+subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subFields = divSubDecls "fields" "Fields" . subDlist
+
-- a box for displaying code
declElem :: Html -> Html