From 84d0217a797e03b7b86af50de772931d5e3caae5 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Sat, 17 Jul 2010 05:35:16 +0000
Subject: clean up Util.hs
---
src/Haddock/Backends/Xhtml/Decl.hs | 18 +++++++++---------
src/Haddock/Backends/Xhtml/Util.hs | 24 ++----------------------
2 files changed, 11 insertions(+), 31 deletions(-)
(limited to 'src/Haddock/Backends')
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index fc0fce5c..211395bd 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -152,7 +152,7 @@ ppTyFamHeader summary associated decl unicode =
case tcdKind decl of
Just kind -> dcolon unicode <+> ppKind kind
- Nothing -> empty
+ Nothing -> noHtml
ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
@@ -279,12 +279,12 @@ ppLContextNoArrow = ppContextNoArrow . unLoc
ppContextNoArrow :: HsContext DocName -> Bool -> Html
-ppContextNoArrow [] _ = empty
+ppContextNoArrow [] _ = noHtml
ppContextNoArrow cxt unicode = pp_hs_context (map unLoc cxt) unicode
ppContextNoLocs :: [HsPred DocName] -> Bool -> Html
-ppContextNoLocs [] _ = empty
+ppContextNoLocs [] _ = noHtml
ppContextNoLocs cxt unicode = pp_hs_context cxt unicode <+> darrow unicode
@@ -293,7 +293,7 @@ ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
pp_hs_context :: [HsPred DocName] -> Bool -> Html
-pp_hs_context [] _ = empty
+pp_hs_context [] _ = noHtml
pp_hs_context [p] unicode = ppPred unicode p
pp_hs_context cxt unicode = parenList (map (ppPred unicode) cxt)
@@ -315,7 +315,7 @@ ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName
-> Bool -> Html
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
- <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else empty)
+ <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else noHtml)
<+> ppAppDocNameNames summ n (tyvarNames $ tvs)
<+> ppFds fds unicode
@@ -444,10 +444,10 @@ ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode
<+> whereBit)
whereBit
- | null cons = empty
+ | null cons = noHtml
| otherwise = case resTy of
ResTyGADT _ -> keyword "where"
- _ -> empty
+ _ -> noHtml
constrBit = subConstructors
(map (ppSideBySideConstr subdocs unicode) cons)
@@ -520,7 +520,7 @@ ppConstrHdr forall tvs ctxt unicode
where
ppForall = case forall of
Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> toHtml ". "
- Implicit -> empty
+ Implicit -> noHtml
ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LConDecl DocName -> SubDecl
ppSideBySideConstr subdocs unicode (L _ con) = (decl, mbDoc, fieldPart)
@@ -608,7 +608,7 @@ ppKind k = toHtml $ showSDoc (ppr k)
ppBang :: HsBang -> Html
-ppBang HsNoBang = empty
+ppBang HsNoBang = noHtml
ppBang _ = toHtml "!" -- Unpacked args is an implementation detail,
-- so we just show the strictness annotation
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index d4ead8d8..9db73742 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -16,14 +16,13 @@ module Haddock.Backends.Xhtml.Util (
namedAnchor, linkedAnchor,
spliceURL,
- (<+>), char, empty, nonEmpty,
+ (<+>), char, nonEmpty,
keyword, punctuate,
braces, brackets, pabrackets, parens, parenList, ubxParenList,
arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote,
- tda, emptyTable, s8,
- abovesSep, hsep,
+ hsep,
collapsebutton, collapseId,
documentCharacterEncoding,
@@ -109,9 +108,6 @@ comma = char ','
char :: Char -> Html
char c = toHtml [c]
-empty :: Html
-empty = noHtml
-
-- | ensure content contains at least something (a non-breaking space)
nonEmpty :: (HTML a) => a -> Html
nonEmpty a = if isNoHtml h then spaceHtml else h
@@ -135,13 +131,6 @@ punctuate h (d0:ds) = go d0 ds
go d [] = [d]
go d (e:es) = (d +++ h) : go e es
-abovesSep :: HtmlTable -> [HtmlTable] -> HtmlTable
-abovesSep _ [] = emptyTable
-abovesSep h (d0:ds) = go d0 ds
- where
- go d [] = d
- go d (e:es) = d </> h </> go e es
-
parenList :: [Html] -> Html
parenList = parens . hsep . punctuate comma
@@ -152,12 +141,6 @@ ubxparens :: Html -> Html
ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
-tda :: [HtmlAttr] -> Html -> HtmlTable
-tda as = cell . (td ! as)
-
-emptyTable :: HtmlTable
-emptyTable = cell noHtml
-
onclick :: String -> HtmlAttr
onclick = strAttr "onclick"
@@ -173,9 +156,6 @@ dot :: Html
dot = toHtml "."
-s8 :: HtmlTable
-s8 = tda [ theclass "s8" ] << noHtml
-
-- | Generate a named anchor
--
--
cgit v1.2.3