aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
authorMark Lentczner <markl@glyphic.com>2010-04-05 05:02:43 +0000
committerMark Lentczner <markl@glyphic.com>2010-04-05 05:02:43 +0000
commitc3990a4db747458bc54606d416cd1e973546cf16 (patch)
treee93f67ae39eb9783a2c78c68518d129c3b85036a /src/Haddock
parent1ea671418f3e6650bf6b30f5efb0a364f043093d (diff)
clean up processExport and place a div around each decl
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Xhtml.hs31
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