aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorsimon.hengel <simon.hengel@wiktory.org>2010-04-02 14:08:40 +0000
committersimon.hengel <simon.hengel@wiktory.org>2010-04-02 14:08:40 +0000
commit28bd97759174c9169b7633ee45d39c82fd069dd9 (patch)
tree676af721ca72c1058d3e7e4c2c27c90d37b4d095 /src/Haddock/Backends
parent0ff11e2b1d741e05d0fdb457ab104c8fc438d40b (diff)
Add markup support for interactive examples
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Hoogle.hs3
-rw-r--r--src/Haddock/Backends/Html.hs11
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs11
3 files changed, 22 insertions, 3 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 25c5d91e..2d4ece4b 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -240,7 +240,8 @@ markupTag = Markup {
markupDefList = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
markupCodeBlock = box TagPre,
markupURL = box (TagInline "a") . str,
- markupAName = const $ str ""
+ markupAName = const $ str "",
+ markupExample = box TagPre . str . unlines . (map exampleToString)
}
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 47930ed4..68d1da42 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -1725,7 +1725,8 @@ parHtmlMarkup ppId isTyCon = Markup {
markupDefList = dlist . concatHtml . map markupDef,
markupCodeBlock = pre,
markupURL = \url -> anchor ! [href url] << toHtml url,
- markupAName = \aname -> namedAnchor aname << toHtml ""
+ markupAName = \aname -> namedAnchor aname << toHtml "",
+ markupExample = examplesToHtml
}
where
-- If an id can refer to multiple things, we give precedence to type
@@ -1739,6 +1740,14 @@ parHtmlMarkup ppId isTyCon = Markup {
| isTyCon x = x
| otherwise = y
+ examplesToHtml l = (pre $ concatHtml $ map exampleToHtml l) ! [theclass "screen"]
+
+ exampleToHtml (Example expression result) = htmlExample
+ where
+ htmlExample = htmlPrompt +++ htmlExpression +++ (toHtml $ unlines result)
+ htmlPrompt = (thecode . toHtml $ "ghci> ") ! [theclass "prompt"]
+ htmlExpression = (strong . thecode . toHtml $ expression ++ "\n") ! [theclass "userinput"]
+
markupDef :: (HTML a, HTML b) => (a, b) -> Html
markupDef (a,b) = dterm << a +++ ddef << b
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 72314aec..5ecd0aea 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -42,7 +42,8 @@ parHtmlMarkup ppId isTyCon = Markup {
markupDefList = dlist . concatHtml . map markupDef,
markupCodeBlock = pre,
markupURL = \url -> anchor ! [href url] << toHtml url,
- markupAName = \aname -> namedAnchor aname << toHtml ""
+ markupAName = \aname -> namedAnchor aname << toHtml "",
+ markupExample = examplesToHtml
}
where
-- If an id can refer to multiple things, we give precedence to type
@@ -56,6 +57,14 @@ parHtmlMarkup ppId isTyCon = Markup {
| isTyCon x = x
| otherwise = y
+ examplesToHtml l = (pre $ concatHtml $ map exampleToHtml l) ! [theclass "screen"]
+
+ exampleToHtml (Example expression result) = htmlExample
+ where
+ htmlExample = htmlPrompt +++ htmlExpression +++ (toHtml $ unlines result)
+ htmlPrompt = (thecode . toHtml $ "ghci> ") ! [theclass "prompt"]
+ htmlExpression = (strong . thecode . toHtml $ expression ++ "\n") ! [theclass "userinput"]
+
markupDef :: (HTML a, HTML b) => (a, b) -> Html
markupDef (a,b) = dterm << a +++ ddef << b