diff options
| author | Mark Lentczner <markl@glyphic.com> | 2010-04-05 05:02:43 +0000 |
|---|---|---|
| committer | Mark Lentczner <markl@glyphic.com> | 2010-04-05 05:02:43 +0000 |
| commit | c3990a4db747458bc54606d416cd1e973546cf16 (patch) | |
| tree | e93f67ae39eb9783a2c78c68518d129c3b85036a /src/Haddock/Backends/Xhtml.hs | |
| parent | 1ea671418f3e6650bf6b30f5efb0a364f043093d (diff) | |
clean up processExport and place a div around each decl
Diffstat (limited to 'src/Haddock/Backends/Xhtml.hs')
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 31 |
1 files changed, 16 insertions, 15 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index a83bc6ae..01b4c861 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -40,7 +40,6 @@ import Control.Exception ( bracket ) import Control.Monad ( when, unless ) import Control.Monad.Instances ( ) -- for Functor Either a import Data.Char ( toUpper ) -import Data.Either import Data.List ( sortBy, groupBy ) import Data.Maybe import Foreign.Marshal.Alloc ( allocaBytes ) @@ -628,8 +627,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode | otherwise = h1 << "Synopsis" +++ unordList ( - rights $ - map (processExport True linksInfo unicode) exports + mapMaybe (processExport True linksInfo unicode) exports ) ! [theclass "synopsis"] -- if the documentation doesn't begin with a section header, then @@ -642,8 +640,8 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode bdy = foldr (+++) noHtml $ - map (either id (paragraph ! [theclass "decl"] <<)) $ - map (processExport False linksInfo unicode) exports + map (thediv ! [theclass "decldoc"]) $ + mapMaybe (processExport False linksInfo unicode) exports linksInfo = (maybe_source_url, maybe_wiki_url) @@ -731,20 +729,23 @@ numberSectionHeadings exports = go 1 exports go n (other:es) = other : go n es -processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) - -> Either Html Html -- Right is a decl, Left is a "extra" (doc or group) -processExport _ _ _ (ExportGroup lev id0 doc) - = Left $ groupTag lev << namedAnchor id0 << docToHtml doc +processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) -> Maybe Html +processExport summary _ _ (ExportGroup lev id0 doc) + = nothingIf summary $ groupTag lev << namedAnchor id0 << docToHtml doc processExport summary links unicode (ExportDecl decl doc subdocs insts) - = Right $ ppDecl summary links decl doc insts subdocs unicode + = Just $ ppDecl summary links decl doc insts subdocs unicode processExport _ _ _ (ExportNoDecl y []) - = Right $ ppDocName y + = Just $ ppDocName y processExport _ _ _ (ExportNoDecl y subs) - = Right $ ppDocName y +++ parenList (map ppDocName subs) -processExport _ _ _ (ExportDoc doc) - = Left $ docToHtml doc + = Just $ ppDocName y +++ parenList (map ppDocName subs) +processExport summary _ _ (ExportDoc doc) + = nothingIf summary $ docToHtml doc processExport _ _ _ (ExportModule mdl) - = Right $ toHtml "module" +++ ppModule mdl "" + = Just $ toHtml "module" +++ ppModule mdl "" + +nothingIf :: Bool -> a -> Maybe a +nothingIf True _ = Nothing +nothingIf False a = Just a groupTag :: Int -> Html -> Html groupTag lev |