From 6889ef69d6ffad53a292555615df2c2b336f93db Mon Sep 17 00:00:00 2001
From: Simon Hengel <simon.hengel@wiktory.org>
Date: Fri, 8 Apr 2011 17:09:28 +0000
Subject: Add support for blank lines in the result of examples

Result lines that only contain the string "<BLANKLINE>" are treated as a blank
line.
---
 src/Haddock/Parse.y                      | 15 +++++++++++----
 tests/html-tests/tests/Examples.hs       |  5 +++++
 tests/html-tests/tests/Examples.html.ref | 12 ++++++++++++
 tests/unit-tests/parsetests.hs           |  6 ++++++
 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
@@ -135,6 +135,18 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");};
 </code
 		></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
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"]]
+    }
   ]
 
 
-- 
cgit v1.2.3