From 28bd97759174c9169b7633ee45d39c82fd069dd9 Mon Sep 17 00:00:00 2001 From: "simon.hengel" Date: Fri, 2 Apr 2010 14:08:40 +0000 Subject: Add markup support for interactive examples --- src/Haddock/Backends/Xhtml/DocMarkup.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'src/Haddock/Backends/Xhtml') 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 -- cgit v1.2.3