aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Hengel <simon.hengel@wiktory.org>2011-04-08 17:09:28 +0000
committerSimon Hengel <simon.hengel@wiktory.org>2011-04-08 17:09:28 +0000
commit6889ef69d6ffad53a292555615df2c2b336f93db (patch)
tree5a5bed955ecc1261aee6f88e8200f05b88627793
parent3a048f0e823f21133ee7d24d066ddf6bd053379d (diff)
Add support for blank lines in the result of examples
Result lines that only contain the string "<BLANKLINE>" are treated as a blank line.
-rw-r--r--src/Haddock/Parse.y15
-rw-r--r--tests/html-tests/tests/Examples.hs5
-rw-r--r--tests/html-tests/tests/Examples.html.ref12
-rw-r--r--tests/unit-tests/parsetests.hs6
4 files changed, 34 insertions, 4 deletions
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index 4a0f8f99..e36e8416 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -129,14 +129,21 @@ makeExample prompt expression result =
-- whitespace in expressions, so drop them
result'
where
- -- drop trailing whitespace from the prompt, remember the prefix
+ -- 1. drop trailing whitespace from the prompt, remember the prefix
(prefix, _) = span isSpace prompt
- -- drop, if possible, the exact same sequence of whitespace characters
- -- from each result line
- result' = map (tryStripPrefix prefix) result
+
+ -- 2. drop, if possible, the exact same sequence of whitespace
+ -- characters from each result line
+ --
+ -- 3. interpret lines that only contain the string "<BLANKLINE>" as an
+ -- empty line
+ result' = map (substituteBlankLine . tryStripPrefix prefix) result
where
tryStripPrefix xs ys = fromMaybe ys $ stripPrefix xs ys
+ substituteBlankLine "<BLANKLINE>" = ""
+ substituteBlankLine line = line
+
-- | Remove all leading and trailing whitespace
strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
diff --git a/tests/html-tests/tests/Examples.hs b/tests/html-tests/tests/Examples.hs
index 7b703428..c8c450f1 100644
--- a/tests/html-tests/tests/Examples.hs
+++ b/tests/html-tests/tests/Examples.hs
@@ -28,6 +28,11 @@ module Examples where
-- >>> isSpace 'a'
-- False
--
+-- >>> putStrLn "foo\n\nbar"
+-- foo
+-- <BLANKLINE>
+-- bar
+--
fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
diff --git a/tests/html-tests/tests/Examples.html.ref b/tests/html-tests/tests/Examples.html.ref
index 69b2fda4..61fcff1c 100644
--- a/tests/html-tests/tests/Examples.html.ref
+++ b/tests/html-tests/tests/Examples.html.ref
@@ -136,6 +136,18 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");};
></strong
>False
</pre
+ ><pre class="screen"
+ ><code class="prompt"
+ >&gt;&gt;&gt; </code
+ ><strong class="userinput"
+ ><code
+ >putStrLn &quot;foo\n\nbar&quot;
+</code
+ ></strong
+ >foo
+
+bar
+</pre
></div
></div
></div
diff --git a/tests/unit-tests/parsetests.hs b/tests/unit-tests/parsetests.hs
index a76e476e..e0645401 100644
--- a/tests/unit-tests/parsetests.hs
+++ b/tests/unit-tests/parsetests.hs
@@ -41,6 +41,12 @@ tests = [
input = "foobar\n> some code"
, result = Nothing -- parse error
}
+
+ -- test <BLANKLINE> support
+ , ParseTest {
+ input = ">>> putFooBar\nfoo\n<BLANKLINE>\nbar"
+ , result = Just $ DocExamples $ [Example "putFooBar" ["foo","","bar"]]
+ }
]