aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorMark Lentczner <markl@glyphic.com>2010-07-14 16:00:54 +0000
committerMark Lentczner <markl@glyphic.com>2010-07-14 16:00:54 +0000
commit21d6bb713fac1fbbc988a9939d7b0b1edc7a5f64 (patch)
treebf59dbcba77c6e69037460c3fb73baa88189492c /src/Haddock/Backends
parentcd869b6a41463f6fd0c979bafe09ce06cbc05ee2 (diff)
convert args to SubDecl format
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs34
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs5
2 files changed, 18 insertions, 21 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index ffee5bd7..f5aa4fcf 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -67,40 +67,32 @@ ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep)
| summary = declElem pref1
| Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocToHtml doc
| otherwise = topDeclElem links loc docname pref2 +++
- (vanillaTable << (
- do_args 0 sep typ </>
- (case doc of
- Just d -> ndocBox (docToHtml d)
- Nothing -> emptyTable)
- ))
+ subArguments (do_args 0 sep typ) +++ maybeDocToHtml doc
where
- argDocHtml n = case Map.lookup n argDocs of
- Just adoc -> docToHtml adoc
- Nothing -> noHtml
+ argDoc n = Map.lookup n argDocs
do_largs n leader (L _ t) = do_args n leader t
- do_args :: Int -> Html -> (HsType DocName) -> HtmlTable
+ do_args :: Int -> Html -> (HsType DocName) -> [SubDecl]
do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
- = (argBox (
- leader <+>
+ = (leader <+>
hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
- ppLContextNoArrow lctxt unicode)
- <-> rdocBox noHtml) </>
- do_largs n (darrow unicode) ltype
+ ppLContextNoArrow lctxt unicode,
+ Nothing, [])
+ : do_largs n (darrow unicode) ltype
do_args n leader (HsForAllTy Implicit _ lctxt ltype)
| not (null (unLoc lctxt))
- = (argBox (leader <+> ppLContextNoArrow lctxt unicode)
- <-> rdocBox noHtml) </>
- do_largs n (darrow unicode) ltype
+ = (leader <+> ppLContextNoArrow lctxt unicode,
+ Nothing, [])
+ : do_largs n (darrow unicode) ltype
-- if we're not showing any 'forall' or class constraints or
-- anything, skip having an empty line for the context.
| otherwise
= do_largs n leader ltype
do_args n leader (HsFunTy lt r)
- = (argBox (leader <+> ppLFunLhType unicode lt) <-> rdocBox (argDocHtml n))
- </> do_largs (n+1) (arrow unicode) r
+ = (leader <+> ppLFunLhType unicode lt, argDoc n, [])
+ : do_largs (n+1) (arrow unicode) r
do_args n leader t
- = argBox (leader <+> ppType unicode t) <-> rdocBox (argDocHtml n)
+ = (leader <+> ppType unicode t, argDoc n, []) : []
ppTyVars :: [LHsTyVarBndr DocName] -> [Html]
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 3c695042..440d8e1e 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -20,6 +20,7 @@ module Haddock.Backends.Xhtml.Layout (
divTopDecl,
SubDecl,
+ subArguments,
subConstructors, subFields,
topDeclElem, declElem,
@@ -98,6 +99,10 @@ subTable decls = Just $ table << aboves (concatMap subRow decls)
td << nonEmpty (fmap docToHtml mdoc))
: map (cell . (td <<)) subs
+
+subArguments :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subArguments = divSubDecls "arguments" "Arguments" . subTable
+
subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html
subConstructors = divSubDecls "constructors" "Constructors" . subTable