aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2013-09-03 01:29:27 +0100
committerAustin Seipp <austin@well-typed.com>2014-01-12 14:48:35 -0600
commitb11f371fdc9197cb45a6dafbcc0b095273d6614f (patch)
tree47dcee8f16e17903dfa059ed9236f276d6cdf1b0 /src/Haddock/Backends
parentef9aa98d6ccbe79888c501f94c9aa6688520c28e (diff)
Allow for headings inside function documentation.
LaTeX will treat the h3-h6 headings the same as we'd have to hack the style file heavily otherwise and it would make the headings tiny anyway. Hoogle upstream said they will put in the functionality on their end. Conflicts: src/Haddock/Interface/Rename.hs src/Haddock/Types.hs test/Haddock/ParserSpec.hs
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Hoogle.hs3
-rw-r--r--src/Haddock/Backends/LaTeX.hs9
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs13
3 files changed, 22 insertions, 3 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 521b0c90..1f098d6d 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -257,7 +257,8 @@ markupTag dflags = Markup {
markupHyperlink = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
markupAName = const $ str "",
markupProperty = box TagPre . str,
- markupExample = box TagPre . str . unlines . map exampleToString
+ markupExample = box TagPre . str . unlines . map exampleToString,
+ markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h
}
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index f4edb5fc..5f00d784 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1013,9 +1013,16 @@ parLatexMarkup ppId = Markup {
markupHyperlink = \l _ -> markupLink l,
markupAName = \_ _ -> empty,
markupProperty = \p _ -> quote $ verb $ text p,
- markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
+ markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
+ markupHeader = \(Header l h) p -> header l (h p)
}
where
+ header 1 d = text "\\section*" <> braces d
+ header 2 d = text "\\subsection*" <> braces d
+ header l d
+ | l > 0 && l <= 6 = text "\\subsubsection*" <> braces d
+ header l _ = error $ "impossible header level in LaTeX generation: " ++ show l
+
fixString Plain s = latexFilter s
fixString Verb s = s
fixString Mono s = latexMonoFilter s
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index ee77012f..ca963f48 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -53,9 +53,20 @@ parHtmlMarkup qual ppId = Markup {
markupAName = \aname -> namedAnchor aname << "",
markupPic = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),
markupProperty = pre . toHtml,
- markupExample = examplesToHtml
+ markupExample = examplesToHtml,
+ markupHeader = \(Header l t) -> makeHeader l t
}
where
+ makeHeader :: Int -> Html -> Html
+ makeHeader 1 mkup = h1 mkup
+ makeHeader 2 mkup = h2 mkup
+ makeHeader 3 mkup = h3 mkup
+ makeHeader 4 mkup = h4 mkup
+ makeHeader 5 mkup = h5 mkup
+ makeHeader 6 mkup = h6 mkup
+ makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
+
+
examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
exampleToHtml (Example expression result) = htmlExample