diff options
author | Mark Lentczner <markl@glyphic.com> | 2010-07-17 05:35:16 +0000 |
---|---|---|
committer | Mark Lentczner <markl@glyphic.com> | 2010-07-17 05:35:16 +0000 |
commit | 84d0217a797e03b7b86af50de772931d5e3caae5 (patch) | |
tree | d5a6ddd8a6589a71ed6bdc92d92f7371ea607e29 /src/Haddock/Backends/Xhtml | |
parent | 8f6355a0ad885c1d2872d619670b1cb90f6696c4 (diff) |
clean up Util.hs
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 18 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Util.hs | 24 |
2 files changed, 11 insertions, 31 deletions
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 -- |