diff options
| -rw-r--r-- | src/HaddockHtml.hs | 8 | ||||
| -rw-r--r-- | src/Html.hs | 38 |
2 files changed, 29 insertions, 17 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 527fe758..53d9a6c5 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -207,7 +207,7 @@ ppHtmlContents odir doctitle maybe_index_url s15 </> footer ) - writeFile (odir ++ pathSeparator:contentsHtmlFile) (renderHtml html) + writeFile (odir ++ pathSeparator:contentsHtmlFile) (prettyHtml html) ppPrologue :: String -> Maybe Doc -> HtmlTable ppPrologue title Nothing = Html.emptyTable @@ -265,7 +265,7 @@ ppHtmlIndex odir doctitle maybe_contents_url ifaces = do when split_indices $ mapM_ (do_sub_index index) initialChars - writeFile (odir ++ pathSeparator:indexHtmlFile) (renderHtml html) + writeFile (odir ++ pathSeparator:indexHtmlFile) (renderHtml html False) where split_indices = length index > 50 @@ -289,7 +289,7 @@ ppHtmlIndex odir doctitle maybe_contents_url ifaces = do do_sub_index this_ix c = unless (null index_part) $ writeFile (odir ++ pathSeparator:subIndexHtmlFile c) - (renderHtml html) + (renderHtml html False) where html = header (thetitle (toHtml (doctitle ++ " (Index)")) +++ thelink ! [href cssFile, @@ -378,7 +378,7 @@ ppHtmlModule odir doctitle source_url ifaceToHtml mdl iface </> s15 </> footer ) - writeFile (moduleHtmlFile odir mdl) (renderHtml html) + writeFile (moduleHtmlFile odir mdl) (renderHtml html False) ifaceToHtml :: String -> Interface -> HtmlTable ifaceToHtml _ iface diff --git a/src/Html.hs b/src/Html.hs index 995719c8..59331cb2 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Portability : portable -- --- $Id: Html.hs,v 1.4 2004/03/25 15:45:10 simonmar Exp $ +-- $Id: Html.hs,v 1.5 2004/03/25 16:00:37 simonmar Exp $ -- -- An Html combinator library -- @@ -962,10 +962,10 @@ gui act = form ! [action act,method "POST"] -- The output is quite messy, because space matters in -- HTML, so we must not generate needless spaces. -renderHtml :: (HTML html) => html -> String -renderHtml theHtml = +renderHtml :: (HTML html) => html -> Bool -> String +renderHtml theHtml pretty = renderMessage ++ - foldr (.) id (map (renderHtml' 0) + foldr (.) id (map (if pretty then renderHtml' 0 else unprettyHtml) (getHtmlElements (tag "HTML" << theHtml))) "\n" renderMessage :: String @@ -977,15 +977,6 @@ renderMessage = -- This is intentually very inefficent to "encorage" this, -- but the neater version in easier when debugging. --- Local Utilities -prettyHtml :: (HTML html) => html -> String -prettyHtml theHtml = - unlines - $ concat - $ map prettyHtml' - $ getHtmlElements - $ toHtml theHtml - renderHtml' :: Int -> HtmlElement -> ShowS renderHtml' _ (HtmlString str) = (++) str renderHtml' n (HtmlTag @@ -998,6 +989,27 @@ renderHtml' n (HtmlTag . foldr (.) id (map (renderHtml' (n+2)) (getHtmlElements html)) . renderTag False name0 [] n) +unprettyHtml :: HtmlElement -> ShowS +unprettyHtml (HtmlString str) = (++) str +unprettyHtml (HtmlTag + { markupTag = name0, + markupContent = html, + markupAttrs = markupAttrs0 }) + = if isNoHtml html && elem name0 validHtmlITags + then renderTag True name0 markupAttrs0 0 + else (renderTag True name0 markupAttrs0 0 + . foldr (.) id (map unprettyHtml (getHtmlElements html)) + . renderTag False name0 [] 0) + +-- Local Utilities +prettyHtml :: (HTML html) => html -> String +prettyHtml theHtml = + unlines + $ concat + $ map prettyHtml' + $ getHtmlElements + $ toHtml theHtml + prettyHtml' :: HtmlElement -> [String] prettyHtml' (HtmlString str) = [str] prettyHtml' (HtmlTag |