Add markup support for interactive examples

1 files changed, 10 insertions, 1 deletions

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