From fc7fd1875d31dbfd37eaa058177e534b4fc6bc25 Mon Sep 17 00:00:00 2001
From: Niklas Haas <git@nand.wakku.to>
Date: Sat, 22 Feb 2014 21:15:34 +0100
Subject: Strip a single leading space from bird tracks (#201)

This makes bird tracks in the form

> foo
> bar
> bat

parse as if they had been written as

>foo
>bar
>bat

ie. without the leading whitespace in front of every line.

Ideally we also want to look into how leading whitespace affects code
blocks written using the @ @ syntax, which are currently unaffected by
this patch.
---
 html-test/ref/Nesting.html                       | 24 +++++++++++++++---------
 html-test/ref/SpuriousSuperclassConstraints.html |  4 ++--
 html-test/ref/Test.html                          | 14 +++++++-------
 html-test/src/Nesting.hs                         |  6 ++++++
 src/Haddock/Parser.hs                            | 11 ++++++++++-
 test/Haddock/ParserSpec.hs                       | 18 ++++++++++++++++++
 6 files changed, 58 insertions(+), 19 deletions(-)

diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html
index 0d692791..41787675 100644
--- a/html-test/ref/Nesting.html
+++ b/html-test/ref/Nesting.html
@@ -166,9 +166,9 @@ the presence of this text pushes it out of nesting back to the top.</li
 	  ><ul
 	    ><li
 	      >Beginning of list<pre
-		> nested
- bird
- tracks</pre
+		>nested
+bird
+tracks</pre
 		></li
 	      ></ul
 	    ></div
@@ -183,9 +183,15 @@ the presence of this text pushes it out of nesting back to the top.</li
 	    ><li
 	      >Beginning of list
 This belongs to the list above!<pre
-		> nested
- bird
- tracks</pre
+		>nested
+bird
+tracks
+
+another line
+  with indentation</pre
+		><pre
+		>nested bird tracks
+  without leading space</pre
 		><ul
 		><li
 		  >Next list
@@ -221,9 +227,9 @@ More of the indented list.<ul
 	      ><dd
 	      >Works for
 definition lists too.<pre
-		> nested
- bird
- tracks</pre
+		>nested
+bird
+tracks</pre
 		><ul
 		><li
 		  >Next list
diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html
index 77e13467..171e3d22 100644
--- a/html-test/ref/SpuriousSuperclassConstraints.html
+++ b/html-test/ref/SpuriousSuperclassConstraints.html
@@ -63,8 +63,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_SpuriousSuperclassCons
 	  ><p
 	  >It has been fixed in:</p
 	  ><pre
-	  > 6ccf78e15a525282fef61bc4f58a279aa9c21771
- Fix spurious superclass constraints bug.</pre
+	  >6ccf78e15a525282fef61bc4f58a279aa9c21771
+Fix spurious superclass constraints bug.</pre
 	  ></div
 	></div
       ><div id="interface"
diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html
index bd447ea1..7d229b52 100644
--- a/html-test/ref/Test.html
+++ b/html-test/ref/Test.html
@@ -1663,7 +1663,7 @@ using double quotes: <a href=""
                  significant
 </pre
 	    ><pre
-	    > this is another block of code</pre
+	    >this is another block of code</pre
 	    ><p
 	    >We can also include URLs in documentation: <a href=""
 	      >http://www.haskell.org/</a
@@ -1765,17 +1765,17 @@ test2
 	  ></div
 	><div class="doc"
 	><pre
-	  > foo</pre
+	  >foo</pre
 	  ><pre
-	  > bar</pre
+	  >bar</pre
 	  ></div
 	><div class="doc"
 	><p
 	  >This is some inline documentation in the export list</p
 	  ><pre
-	  > a code block using bird-tracks
- each line must begin with &gt; (which isn't significant unless it
- is at the beginning of the line).</pre
+	  >a code block using bird-tracks
+each line must begin with &gt; (which isn't significant unless it
+is at the beginning of the line).</pre
 	  ></div
 	><h1 id="g:7"
 	>A hidden module</h1
@@ -2085,7 +2085,7 @@ test2
 	>A subsection</h2
 	><div class="doc"
 	><pre
-	  > a literal line</pre
+	  >a literal line</pre
 	  ><p
 	  >$ a non <em
 	    >literal</em
diff --git a/html-test/src/Nesting.hs b/html-test/src/Nesting.hs
index 5ab27ec0..34177442 100644
--- a/html-test/src/Nesting.hs
+++ b/html-test/src/Nesting.hs
@@ -65,6 +65,12 @@ This belongs to the list above!
     > nested
     > bird
     > tracks
+    >
+    > another line
+    >   with indentation
+
+    >nested bird tracks
+    >  without leading space
 
     * Next list
     More of the indented list.
diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs
index e9bed2a5..a6ad817c 100644
--- a/src/Haddock/Parser.hs
+++ b/src/Haddock/Parser.hs
@@ -302,10 +302,19 @@ takeNonEmptyLine = do
     (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n"
 
 birdtracks :: Parser (Doc a)
-birdtracks = DocCodeBlock . DocString . intercalate "\n" <$> many1 line
+birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line
   where
     line = skipHorizontalSpace *> ">" *> takeLine
 
+-- | Strip leading spaces, but ignore blank lines. If any of the lines don't
+--   start with a ' ', however, we don't touch the block.
+stripSpace :: [String] -> [String]
+stripSpace = fromMaybe <*> mapM strip
+  where
+    strip (' ':xs) = Just xs
+    strip "" = Just ""
+    strip _  = Nothing
+
 -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line).
 -- Consecutive examples are accepted.
 examples :: Parser (Doc a)
diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs
index 455a67f1..ac57b644 100644
--- a/test/Haddock/ParserSpec.hs
+++ b/test/Haddock/ParserSpec.hs
@@ -360,6 +360,24 @@ spec = before initStaticOpts $ do
           ]
         `shouldParseTo` DocCodeBlock "foo\nbar\nbaz"
 
+      it "ignores single leading spaces" $ do
+        unlines [
+            "> foo"
+          , "> bar"
+          , "> baz"
+          ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz"
+
+        unlines [
+            "> foo"
+          , ">"
+          , "> bar"
+          ] `shouldParseTo` DocCodeBlock "foo\n\nbar"
+
+        unlines [
+            ">foo"
+          , ">  bar"
+          ] `shouldParseTo` DocCodeBlock "foo\n  bar"
+
       it "ignores nested markup" $ do
         unlines [
             ">/foo/"
-- 
cgit v1.2.3