Add markup support for interactive examples

1 files changed, 10 insertions, 1 deletions

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