diff options
| author | Simon Hengel <sol@typeful.net> | 2013-09-08 10:33:38 +0200 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2014-01-12 14:48:35 -0600 |
| commit | 2448bd71609688be7b8bfe362a8534959531cd79 (patch) | |
| tree | 66f23e3cc5fd6c97da832e8704f8f633e508b64b | |
| parent | 27876dc77ff259e27a71ea6f30662a668adfd134 (diff) | |
Fix totality, unicode, examples, paragraph parsing
Also simplify specs and parsers while we're at it. Some parsers were
made more generic.
This commit is a part of GHC pre-merge squash, email
fuuzetsu@fuuzetsu.co.uk if you need the full commit history.
48 files changed, 871 insertions, 1190 deletions
diff --git a/html-test/ref/A.html b/html-test/ref/A.html index 4d55ba16..0346574f 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -123,8 +123,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");}; ></p ><div class="doc" ><p - >Doc for test2 -</p + >Doc for test2</p ></div ></div ><div class="top" @@ -136,8 +135,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");}; > </p ><div class="doc" ><p - >Should show up on the page for both modules A and B -</p + >Should show up on the page for both modules A and B</p ></div ><div class="subs constructors" ><p class="caption" @@ -150,8 +148,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");}; ></td ><td class="doc" ><p - >Doc for consructor -</p + >Doc for consructor</p ></td ></tr ></table @@ -166,8 +163,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");}; ></p ><div class="doc" ><p - >Should show up on the page for both modules A and B -</p + >Should show up on the page for both modules A and B</p ></div ></div ></div diff --git a/html-test/ref/B.html b/html-test/ref/B.html index 4dd5d339..ea408d0b 100644 --- a/html-test/ref/B.html +++ b/html-test/ref/B.html @@ -115,8 +115,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");}; >. Module link: <a href="" >Prelude</a - >. -</p + >.</p ></div ></div ><div class="top" @@ -128,8 +127,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");}; ></p ><div class="doc" ><p - >Should show up on the page for both modules A and B -</p + >Should show up on the page for both modules A and B</p ></div ></div ><div class="top" @@ -141,8 +139,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");}; > </p ><div class="doc" ><p - >Should show up on the page for both modules A and B -</p + >Should show up on the page for both modules A and B</p ></div ><div class="subs constructors" ><p class="caption" @@ -155,8 +152,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");}; ></td ><td class="doc" ><p - >Doc for consructor -</p + >Doc for consructor</p ></td ></tr ></table diff --git a/html-test/ref/Bug1.html b/html-test/ref/Bug1.html index d784fbfa..80e83425 100644 --- a/html-test/ref/Bug1.html +++ b/html-test/ref/Bug1.html @@ -72,8 +72,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug1.html");}; ><a href="" >T</a ></code - >. -</p + >.</p ></div ><div class="subs constructors" ><p class="caption" diff --git a/html-test/ref/Bug3.html b/html-test/ref/Bug3.html index fa9000a6..f5b12e5f 100644 --- a/html-test/ref/Bug3.html +++ b/html-test/ref/Bug3.html @@ -66,8 +66,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug3.html");}; ><div class="doc" ><p >/multi-line - emphasis/ -</p + emphasis/</p ></div ></div ></div diff --git a/html-test/ref/Bug4.html b/html-test/ref/Bug4.html index f97f375e..ba64535f 100644 --- a/html-test/ref/Bug4.html +++ b/html-test/ref/Bug4.html @@ -65,8 +65,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug4.html");}; ></p ><div class="doc" ><p - >don't use apostrophe's in the wrong place's -</p + >don't use apostrophe's in the wrong place's</p ></div ></div ></div diff --git a/html-test/ref/Bug6.html b/html-test/ref/Bug6.html index 384e4dc8..2fde3f10 100644 --- a/html-test/ref/Bug6.html +++ b/html-test/ref/Bug6.html @@ -46,8 +46,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; >Description</p ><div class="doc" ><p - >Exporting records. -</p + >Exporting records.</p ></div ></div ><div id="synopsis" @@ -138,8 +137,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; > </p ><div class="doc" ><p - >This record is exported without its field -</p + >This record is exported without its field</p ></div ><div class="subs constructors" ><p class="caption" @@ -168,8 +166,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; ><div class="doc" ><p >.. with its field, but the field is named separately in the export list - (the field isn't documented separately since it is already documented here) -</p + (the field isn't documented separately since it is already documented here)</p ></div ><div class="subs constructors" ><p class="caption" @@ -215,8 +212,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; > </p ><div class="doc" ><p - >.. with fields names as subordinate names in the export -</p + >.. with fields names as subordinate names in the export</p ></div ><div class="subs constructors" ><p class="caption" @@ -271,8 +267,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; ><div class="doc" ><p >.. with only some of the fields exported (we can't handle this one - - how do we render the declaration?) -</p + how do we render the declaration?)</p ></div ><div class="subs constructors" ><p class="caption" @@ -302,8 +297,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug6.html");}; > </p ><div class="doc" ><p - >a newtype with a field -</p + >a newtype with a field</p ></div ><div class="subs constructors" ><p class="caption" diff --git a/html-test/ref/Bug7.html b/html-test/ref/Bug7.html index d3d6ac7d..9f964576 100644 --- a/html-test/ref/Bug7.html +++ b/html-test/ref/Bug7.html @@ -47,8 +47,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug7.html");}; ><div class="doc" ><p >This module caused a duplicate instance in the documentation for the Foo - type. -</p + type.</p ></div ></div ><div id="synopsis" @@ -83,8 +82,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug7.html");}; > </p ><div class="doc" ><p - >The Foo datatype -</p + >The Foo datatype</p ></div ><div class="subs constructors" ><p class="caption" @@ -116,8 +114,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug7.html");}; ></td ><td class="doc" ><p - >Just one instance -</p + >Just one instance</p ></td ></tr ></table @@ -133,8 +130,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug7.html");}; > x y </p ><div class="doc" ><p - >The Bar class -</p + >The Bar class</p ></div ><div class="subs instances" ><p id="control.i:Bar" class="caption collapser" onclick="toggleSection('i:Bar')" @@ -152,8 +148,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug7.html");}; ></td ><td class="doc" ><p - >Just one instance -</p + >Just one instance</p ></td ></tr ></table diff --git a/html-test/ref/BugDeprecated.html b/html-test/ref/BugDeprecated.html index b3f63665..c65b4cf4 100644 --- a/html-test/ref/BugDeprecated.html +++ b/html-test/ref/BugDeprecated.html @@ -141,8 +141,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} >Deprecated: for one</p ></div ><p - >some documentation for one, two and three -</p + >some documentation for one, two and three</p ></div ></div ><div class="top" @@ -158,8 +157,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} >Deprecated: for three</p ></div ><p - >some documentation for one, two and three -</p + >some documentation for one, two and three</p ></div ></div ><div class="top" @@ -175,8 +173,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} >Deprecated: for two</p ></div ><p - >some documentation for one, two and three -</p + >some documentation for one, two and three</p ></div ></div ></div diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html index 99eea1bd..ee6f2679 100644 --- a/html-test/ref/DeprecatedClass.html +++ b/html-test/ref/DeprecatedClass.html @@ -93,8 +93,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") >Deprecated: SomeClass</p ></div ><p - >some class -</p + >some class</p ></div ><div class="subs methods" ><p class="caption" @@ -109,8 +108,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") >Deprecated: foo</p ></div ><p - >documentation for foo -</p + >documentation for foo</p ></div ></div ></div diff --git a/html-test/ref/DeprecatedData.html b/html-test/ref/DeprecatedData.html index 254ae11e..a0d659a9 100644 --- a/html-test/ref/DeprecatedData.html +++ b/html-test/ref/DeprecatedData.html @@ -95,8 +95,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); >Deprecated: Foo</p ></div ><p - >type Foo -</p + >type Foo</p ></div ><div class="subs constructors" ><p class="caption" @@ -113,8 +112,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); >Deprecated: Foo</p ></div ><p - >constructor Foo -</p + >constructor Foo</p ></td ></tr ><tr @@ -128,8 +126,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); >Deprecated: Bar</p ></div ><p - >constructor Bar -</p + >constructor Bar</p ></td ></tr ></table diff --git a/html-test/ref/DeprecatedFunction.html b/html-test/ref/DeprecatedFunction.html index 2ee6d01e..abd6e976 100644 --- a/html-test/ref/DeprecatedFunction.html +++ b/html-test/ref/DeprecatedFunction.html @@ -79,8 +79,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm > instead</p ></div ><p - >some documentation for foo -</p + >some documentation for foo</p ></div ></div ><div class="top" @@ -92,8 +91,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm ></p ><div class="doc" ><p - >some documentation for bar -</p + >some documentation for bar</p ></div ></div ></div diff --git a/html-test/ref/DeprecatedModule.html b/html-test/ref/DeprecatedModule.html index 1ff1e61f..79e61a51 100644 --- a/html-test/ref/DeprecatedModule.html +++ b/html-test/ref/DeprecatedModule.html @@ -54,8 +54,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedModule.html" ><p >Documentation for <a href="" >DeprecatedModule</a - >. -</p + >.</p ></div ></div ><div id="interface" diff --git a/html-test/ref/DeprecatedNewtype.html b/html-test/ref/DeprecatedNewtype.html index b3675ccf..4a8024b4 100644 --- a/html-test/ref/DeprecatedNewtype.html +++ b/html-test/ref/DeprecatedNewtype.html @@ -83,8 +83,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html >Deprecated: SomeNewType</p ></div ><p - >some documentation -</p + >some documentation</p ></div ><div class="subs constructors" ><p class="caption" @@ -103,8 +102,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html >Deprecated: SomeNewTypeConst</p ></div ><p - >constructor docu -</p + >constructor docu </p ></td ></tr ></table diff --git a/html-test/ref/DeprecatedReExport.html b/html-test/ref/DeprecatedReExport.html index 159c1086..99b797d0 100644 --- a/html-test/ref/DeprecatedReExport.html +++ b/html-test/ref/DeprecatedReExport.html @@ -60,11 +60,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedReExport.htm >Description</p ><div class="doc" ><p - >What is tested here: -</p + >What is tested here:</p ><ul ><li - > Deprecation messages are shown for re-exported items. + >Deprecation messages are shown for re-exported items. </li ></ul ></div @@ -101,8 +100,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedReExport.htm > instead</p ></div ><p - >some documentation for foo -</p + >some documentation for foo</p ></div ></div ><h1 id="g:2" @@ -112,8 +110,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedReExport.htm >Not yet working, see <a href="" >http://trac.haskell.org/haddock/ticket/223</a > - , isEmptyChan -</p + , isEmptyChan</p ></div ></div ></div diff --git a/html-test/ref/DeprecatedRecord.html b/html-test/ref/DeprecatedRecord.html index 5f84dfa8..d9a4abd4 100644 --- a/html-test/ref/DeprecatedRecord.html +++ b/html-test/ref/DeprecatedRecord.html @@ -81,8 +81,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedRecord.html" > </p ><div class="doc" ><p - >type Foo -</p + >type Foo</p ></div ><div class="subs constructors" ><p class="caption" @@ -110,8 +109,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedRecord.html" ></dt ><dd class="doc" ><p - >some name -</p + >some name</p ></dd ><dt class="src" ><a name="v:fooValue" class="def" @@ -125,8 +123,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedRecord.html" >Deprecated: do not use this</p ></div ><p - >some value -</p + >some value</p ></dd ></dl ><div class="clear" diff --git a/html-test/ref/DeprecatedTypeFamily.html b/html-test/ref/DeprecatedTypeFamily.html index b9f49036..4ed4d827 100644 --- a/html-test/ref/DeprecatedTypeFamily.html +++ b/html-test/ref/DeprecatedTypeFamily.html @@ -75,8 +75,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeFamily.h >Deprecated: SomeTypeFamily</p ></div ><p - >some documentation -</p + >some documentation</p ></div ></div ><div class="top" diff --git a/html-test/ref/DeprecatedTypeSynonym.html b/html-test/ref/DeprecatedTypeSynonym.html index fe305da7..d7f5785e 100644 --- a/html-test/ref/DeprecatedTypeSynonym.html +++ b/html-test/ref/DeprecatedTypeSynonym.html @@ -81,8 +81,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeSynonym. >Deprecated: TypeSyn</p ></div ><p - >some documentation -</p + >some documentation</p ></div ></div ><div class="top" diff --git a/html-test/ref/Examples.html b/html-test/ref/Examples.html index f14e226b..3270b856 100644 --- a/html-test/ref/Examples.html +++ b/html-test/ref/Examples.html @@ -73,11 +73,9 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");}; ><a href="" >Integer</a ></code - >. -</p + >.</p ><p - >Examples: -</p + >Examples:</p ><pre class="screen" ><code class="prompt" >>>> </code @@ -107,8 +105,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");}; >55 </pre ><p - >One more Example: -</p + >One more Example:</p ><pre class="screen" ><code class="prompt" >>>> </code @@ -120,8 +117,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");}; >5 </pre ><p - >One more Example: -</p + >One more Example:</p ><pre class="screen" ><code class="prompt" >>>> </code @@ -133,8 +129,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Examples.html");}; >5 </pre ><p - >Example with an import: -</p + >Example with an import:</p ><pre class="screen" ><code class="prompt" >>>> </code diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index c8c6a25d..48e6dc80 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -70,8 +70,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; ></td ><td class="doc" ><p - >First argument -</p + >First argument</p ></td ></tr ><tr @@ -79,8 +78,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> a</td ><td class="doc" ><p - >Second argument -</p + >Second argument</p ></td ></tr ><tr @@ -90,8 +88,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; ></td ><td class="doc" ><p - >Third argument -</p + >Third argument</p ></td ></tr ><tr @@ -99,8 +96,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> (a -> a)</td ><td class="doc" ><p - >Fourth argument -</p + >Fourth argument</p ></td ></tr ><tr @@ -108,8 +104,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> ()</td ><td class="doc" ><p - >Result -</p + >Result</p ></td ></tr ></table @@ -129,8 +124,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >:: a</td ><td class="doc" ><p - >First argument -</p + >First argument</p ></td ></tr ><tr @@ -138,8 +132,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> b</td ><td class="doc" ><p - >Second argument -</p + >Second argument</p ></td ></tr ><tr @@ -147,8 +140,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> c</td ><td class="doc" ><p - >Third argument -</p + >Third argument</p ></td ></tr ><tr @@ -156,8 +148,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");}; >-> d</td ><td class="doc" ><p - >Result -</p + >Result</p ></td ></tr ></table diff --git a/html-test/ref/GADTRecords.html b/html-test/ref/GADTRecords.html index a461e075..63297c37 100644 --- a/html-test/ref/GADTRecords.html +++ b/html-test/ref/GADTRecords.html @@ -117,8 +117,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_GADTRecords.html");}; ></p ><div class="doc" ><p - >h1 -</p + >h1</p ></div ><div class="subs constructors" ><p class="caption" @@ -176,8 +175,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_GADTRecords.html");}; ></dt ><dd class="doc" ><p - >hello docs -</p + >hello docs</p ></dd ></dl ><div class="clear" @@ -209,8 +207,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_GADTRecords.html");}; > :: a</dt ><dd class="doc" ><p - >hello2 docs -</p + >hello2 docs</p ></dd ></dl ><div class="clear" diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html index 06a7a19d..c459b524 100644 --- a/html-test/ref/Hash.html +++ b/html-test/ref/Hash.html @@ -73,8 +73,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; ><div class="doc" ><p >Implementation of fixed-size hash tables, with a type - class for constructing hash values for structured types. -</p + class for constructing hash values for structured types.</p ></div ></div ><div id="synopsis" @@ -164,8 +163,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; ><a href="" >Eq</a ></code - >. -</p + >.</p ></div ></div ><h2 id="g:2" @@ -189,8 +187,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; > key val)</p ><div class="doc" ><p - >Builds a new hash table with a given size -</p + >Builds a new hash table with a given size</p ></div ></div ><div class="top" @@ -206,8 +203,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; > ()</p ><div class="doc" ><p - >Inserts a new element into the hash table -</p + >Inserts a new element into the hash table</p ></div ></div ><div class="top" @@ -234,8 +230,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; ><a href="" >Nothing</a ></code - > otherwise. -</p + > otherwise.</p ></div ></div ><h1 id="g:3" @@ -253,8 +248,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; ></p ><div class="doc" ><p - >A class of types which can be hashed. -</p + >A class of types which can be hashed.</p ></div ><div class="subs methods" ><p class="caption" @@ -273,8 +267,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");}; ><a href="" >Int</a ></code - > -</p + ></p ></div ></div ><div class="subs instances" diff --git a/html-test/ref/HiddenInstances.html b/html-test/ref/HiddenInstances.html index 3ca45640..963ed6a6 100644 --- a/html-test/ref/HiddenInstances.html +++ b/html-test/ref/HiddenInstances.html @@ -71,8 +71,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") > a </p ><div class="doc" ><p - >Should be visible -</p + >Should be visible</p ></div ><div class="subs instances" ><p id="control.i:VisibleClass" class="caption collapser" onclick="toggleSection('i:VisibleClass')" @@ -88,8 +87,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ><tr @@ -101,8 +99,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ></table @@ -118,8 +115,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") > </p ><div class="doc" ><p - >Should be visible -</p + >Should be visible</p ></div ><div class="subs instances" ><p id="control.i:VisibleData" class="caption collapser" onclick="toggleSection('i:VisibleData')" @@ -135,8 +131,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ><tr @@ -148,8 +143,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstances.html") ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ></table diff --git a/html-test/ref/HiddenInstancesB.html b/html-test/ref/HiddenInstancesB.html index 248b7839..eabd7e12 100644 --- a/html-test/ref/HiddenInstancesB.html +++ b/html-test/ref/HiddenInstancesB.html @@ -71,8 +71,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstancesB.html" > a </p ><div class="doc" ><p - >Should be visible -</p + >Should be visible</p ></div ><div class="subs instances" ><p id="control.i:Foo" class="caption collapser" onclick="toggleSection('i:Foo')" @@ -88,8 +87,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstancesB.html" ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ></table @@ -105,8 +103,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstancesB.html" > </p ><div class="doc" ><p - >Should be visible -</p + >Should be visible</p ></div ><div class="subs instances" ><p id="control.i:Bar" class="caption collapser" onclick="toggleSection('i:Bar')" @@ -122,8 +119,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_HiddenInstancesB.html" ></td ><td class="doc" ><p - >Should be visible -</p + >Should be visible</p ></td ></tr ></table diff --git a/html-test/ref/Hyperlinks.html b/html-test/ref/Hyperlinks.html index 91237eb2..254b6b72 100644 --- a/html-test/ref/Hyperlinks.html +++ b/html-test/ref/Hyperlinks.html @@ -67,13 +67,11 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hyperlinks.html");}; ><p >A plain URL: <a href="" >http://example.com/</a - > -</p + ></p ><p >A URL with a label: <a href="" >some link</a - > -</p + ></p ></div ></div ></div diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/IgnoreExports.html index 8181829b..fc91be84 100644 --- a/html-test/ref/IgnoreExports.html +++ b/html-test/ref/IgnoreExports.html @@ -71,8 +71,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_IgnoreExports.html");} ></p ><div class="doc" ><p - >documentation for foo -</p + >documentation for foo</p ></div ></div ><div class="top" @@ -84,8 +83,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_IgnoreExports.html");} ></p ><div class="doc" ><p - >documentation for bar -</p + >documentation for bar</p ></div ></div ></div diff --git a/html-test/ref/ModuleWithWarning.html b/html-test/ref/ModuleWithWarning.html index 5d8b3832..b3ab62aa 100644 --- a/html-test/ref/ModuleWithWarning.html +++ b/html-test/ref/ModuleWithWarning.html @@ -54,8 +54,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_ModuleWithWarning.html ><p >Documentation for <a href="" >ModuleWithWarning</a - >. -</p + >.</p ></div ></div ><div id="interface" diff --git a/html-test/ref/NamedDoc.html b/html-test/ref/NamedDoc.html index 9c929548..94d4bad0 100644 --- a/html-test/ref/NamedDoc.html +++ b/html-test/ref/NamedDoc.html @@ -52,8 +52,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_NamedDoc.html");}; >Documentation</h1 ><div class="doc" ><p - >bar -</p + >bar</p ></div ></div ></div diff --git a/html-test/ref/NoLayout.html b/html-test/ref/NoLayout.html index 13c90f3e..4a9f14d2 100644 --- a/html-test/ref/NoLayout.html +++ b/html-test/ref/NoLayout.html @@ -69,8 +69,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_NoLayout.html");}; ><a href="" >g</a ></code - > -</p + ></p ></div ></div ></div diff --git a/html-test/ref/NonGreedy.html b/html-test/ref/NonGreedy.html index 8d8f26a5..2f9bd44c 100644 --- a/html-test/ref/NonGreedy.html +++ b/html-test/ref/NonGreedy.html @@ -65,8 +65,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_NonGreedy.html");}; >url1</a > <a href="" >url2</a - > -</p + ></p ></div ></div ></div diff --git a/html-test/ref/Properties.html b/html-test/ref/Properties.html index 3e590b45..7b2a2799 100644 --- a/html-test/ref/Properties.html +++ b/html-test/ref/Properties.html @@ -73,8 +73,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Properties.html");}; ><a href="" >Integer</a ></code - >. -</p + >.</p ><pre >fib n <= fib (n + 1)</pre ></div diff --git a/html-test/ref/PruneWithWarning.html b/html-test/ref/PruneWithWarning.html index 220576fa..837c28b4 100644 --- a/html-test/ref/PruneWithWarning.html +++ b/html-test/ref/PruneWithWarning.html @@ -46,11 +46,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_PruneWithWarning.html" >Description</p ><div class="doc" ><p - >What is tested here: -</p + >What is tested here:</p ><ul ><li - > If a binding has a deprecation message but no documentation, it is pruned + >If a binding has a deprecation message but no documentation, it is pruned when <code >OPTIONS_HADDOCK prune</code > is used. diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 9b9d8087..566eafd6 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -46,32 +46,25 @@ window.onload = function () {pageLoad();setSynopsis("mini_SpuriousSuperclassCons >Description</p ><div class="doc" ><p - >What is tested here: -</p + >What is tested here:</p ><p >Due to a change in GHC 7.6.1 we had a bug that superclass contraints were - included in the instances list. Edward K. repported it here: -</p + included in the instances list. Edward K. repported it here:</p ><p ><a href="" >http://www.haskell.org/pipermail/haskell-cafe/2012-September/103600.html</a - > -</p + ></p ><p - >And here is the corresponding theard on glasgow-haskell-users: -</p + >And here is the corresponding theard on glasgow-haskell-users:</p ><p ><a href="" >http://www.haskell.org/pipermail/glasgow-haskell-users/2012-September/022914.html</a - > -</p + ></p ><p - >It has been fixed in: -</p + >It has been fixed in:</p ><pre > 6ccf78e15a525282fef61bc4f58a279aa9c21771 - Fix spurious superclass constraints bug. -</pre + 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 9a25f960..2a3ae350 100644 --- a/html-test/ref/Test.html +++ b/html-test/ref/Test.html @@ -151,8 +151,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >visible</a ></code - >. -</p + >.</p ></div ></div ><div id="synopsis" @@ -678,8 +677,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; >This comment applies to the <em >following</em > declaration - and it continues until the next non-comment line -</p + and it continues until the next non-comment line</p ></div ><div class="subs constructors" ><p class="caption" @@ -702,8 +700,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >A</a ></code - > constructor -</p + > constructor</p ></td ></tr ><tr @@ -725,8 +722,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >B</a ></code - > constructor -</p + > constructor</p ></td ></tr ></table @@ -741,8 +737,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a b </p ><div class="doc" ><p - >An abstract data declaration -</p + >An abstract data declaration</p ></div ></div ><div class="top" @@ -754,8 +749,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a b </p ><div class="doc" ><p - >A data declaration with no documentation annotations on the constructors -</p + >A data declaration with no documentation annotations on the constructors</p ></div ><div class="subs constructors" ><p class="caption" @@ -832,8 +826,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >A3</a ></code - > -</p + ></p ></td ></tr ><tr @@ -847,8 +840,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >B3</a ></code - > -</p + ></p ></td ></tr ></table @@ -863,8 +855,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > </p ><div class="doc" ><p - >Testing alternative comment styles -</p + >Testing alternative comment styles</p ></div ><div class="subs constructors" ><p class="caption" @@ -881,8 +872,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >A4</a ></code - > -</p + ></p ></td ></tr ><tr @@ -896,8 +886,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >B4</a ></code - > -</p + ></p ></td ></tr ><tr @@ -911,8 +900,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >C4</a ></code - > -</p + ></p ></td ></tr ></table @@ -927,8 +915,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a </p ><div class="doc" ><p - >A newtype -</p + >A newtype</p ></div ><div class="subs constructors" ><p class="caption" @@ -954,8 +941,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a b </p ><div class="doc" ><p - >A newtype with a fieldname -</p + >A newtype with a fieldname</p ></div ><div class="subs constructors" ><p class="caption" @@ -999,8 +985,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a b </p ><div class="doc" ><p - >A newtype with a fieldname, documentation on the field -</p + >A newtype with a fieldname, documentation on the field</p ></div ><div class="subs constructors" ><p class="caption" @@ -1030,8 +1015,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >n3</a ></code - > field -</p + > field</p ></dd ></dl ><div class="clear" @@ -1052,8 +1036,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><div class="doc" ><p >An abstract newtype - we show this one as data rather than newtype because - the difference isn't visible to the programmer for an abstract type. -</p + the difference isn't visible to the programmer for an abstract type.</p ></div ></div ><div class="top" @@ -1087,8 +1070,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > :: a b</dt ><dd class="doc" ><p - >no docs on the datatype or the constructor -</p + >no docs on the datatype or the constructor</p ></dd ></dl ><div class="clear" @@ -1117,8 +1099,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ></td ><td class="doc" ><p - >docs on the constructor only -</p + >docs on the constructor only</p ></td ></tr ><tr @@ -1151,8 +1132,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a b </p ><div class="doc" ><p - >docs on the newtype and the constructor -</p + >docs on the newtype and the constructor</p ></div ><div class="subs constructors" ><p class="caption" @@ -1169,8 +1149,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >N7</a ></code - > constructor -</p + > constructor</p ></td ></tr ><tr @@ -1226,8 +1205,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s</a ></code - >. -</p + >.</p ></div ><div class="subs constructors" ><p class="caption" @@ -1244,8 +1222,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >C1</a ></code - > record constructor, with the following fields: -</p + > record constructor, with the following fields:</p ></td ></tr ><tr @@ -1266,8 +1243,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >p</a ></code - > field -</p + > field</p ></dd ><dt class="src" ><a name="v:q" class="def" @@ -1281,8 +1257,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >q</a ></code - > field -</p + > field</p ></dd ><dt class="src" ><a name="v:r" class="def" @@ -1300,8 +1275,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s</a ></code - > -</p + ></p ></dd ><dt class="src" ><a name="v:s" class="def" @@ -1319,8 +1293,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s</a ></code - > -</p + ></p ></dd ></dl ><div class="clear" @@ -1339,8 +1312,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >C2</a ></code - > record constructor, also with some fields: -</p + > record constructor, also with some fields:</p ></td ></tr ><tr @@ -1409,8 +1381,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > </p ><div class="doc" ><p - >Testing different record commenting styles -</p + >Testing different record commenting styles</p ></div ><div class="subs constructors" ><p class="caption" @@ -1427,8 +1398,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >C3</a ></code - > record constructor -</p + > record constructor</p ></td ></tr ><tr @@ -1449,8 +1419,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s1</a ></code - > record selector -</p + > record selector</p ></dd ><dt class="src" ><a name="v:s2" class="def" @@ -1464,8 +1433,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s2</a ></code - > record selector -</p + > record selector</p ></dd ><dt class="src" ><a name="v:s3" class="def" @@ -1479,8 +1447,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >s3</a ></code - > record selector -</p + > record selector</p ></dd ></dl ><div class="clear" @@ -1493,8 +1460,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ></div ><div class="doc" ><p - >test that we can export record selectors on their own: -</p + >test that we can export record selectors on their own:</p ></div ><h1 id="g:4" >Class declarations</h1 @@ -1517,8 +1483,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >C</a ></code - > class) -</p + > class)</p ></div ><div class="subs methods" ><p class="caption" @@ -1535,8 +1500,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >a</a ></code - > method -</p + > method</p ></div ><p class="src" ><a name="v:b" class="def" @@ -1548,8 +1512,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ><a href="" >b</a ></code - > method -</p + > method</p ></div ></div ></div @@ -1564,8 +1527,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ></p ><div class="doc" ><p - >This is a class declaration with no separate docs for the methods -</p + >This is a class declaration with no separate docs for the methods</p ></div ><div class="subs methods" ><p class="caption" @@ -1619,8 +1581,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; > a </p ><div class="doc" ><p - >This is a class declaration with no methods (or no methods exported) -</p + >This is a class declaration with no methods (or no methods exported)</p ></div ></div ><div class="top" @@ -1643,8 +1604,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");}; ></div ><div class="doc" ><p - >Test that we can export a class method on its own: -</p + >Test that we can export a class method on its own:</p ></div ><h1 id="g:5" >Function types</h1 @@ -1669,39 +1629,37 @@ using double quotes: <a href="" >Foo</a >. We can add emphasis <em >like this</em - >. -</p + >.</p ><ul ><li - > This is a bulleted list + >This is a bulleted list </li ><li - > This is the next item (different kind of bullet) + >This is the next item (different kind of bullet) </li ></ul ><ol ><li - > This is an ordered list + >This is an ordered list </li ><li - > This is the next item (different kind of bullet) + >This is the next item (different kind of bullet) </li ></ol ><dl ><dt >cat</dt ><dd - > a small, furry, domesticated mammal + >a small, furry, domesticated mammal </dd ><dt >pineapple</dt ><dd - > a fruit grown in the tropics + >a fruit grown in the tropics </dd ></dl ><pre - > - This is a block of code, which can include other markup: <code + > This is a block of code, which can include other markup: <code ><a href="" >R</a ></code @@ -1711,13 +1669,11 @@ 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 - >. -</p + >.</p ></div ></div ><div class="top" @@ -1731,8 +1687,7 @@ using double quotes: <a href="" > CInt</p ><div class="doc" ><p - >we can export foreign declarations too -</p + >we can export foreign declarations too</p ></div ></div ><h1 id="g:6" @@ -1741,15 +1696,13 @@ using double quotes: <a href="" ><p >This is some documentation that is attached to a name ($aux1) rather than a source declaration. The documentation may be - referred to in the export list using its name. -</p + referred to in the export list using its name.</p ><pre > code block in named doc</pre ></div ><div class="doc" ><p - >This is some documentation that is attached to a name ($aux2) -</p + >This is some documentation that is attached to a name ($aux2)</p ></div ><div class="doc" ><pre @@ -1761,19 +1714,16 @@ using double quotes: <a href="" ></div ><div class="doc" ><p - >a nested, named doc comment -</p + >a nested, named doc comment</p ><p - >with a paragraph, -</p + >with a paragraph,</p ><pre > and a code block</pre ></div ><div class="doc" ><pre >test -test1 -</pre +test1</pre ><pre > test2 test3 @@ -1781,70 +1731,57 @@ test1 ></div ><div class="doc" ><pre - > -test1 + >test1 test2 </pre ></div ><div class="doc" ><pre >test3 -test4 -</pre +test4</pre ></div ><div class="doc" ><pre - > -test1 + >test1 test2 </pre ><pre >test3 -test4 -</pre +test4</pre ></div ><div class="doc" ><pre >test3 -test4 -</pre +test4</pre ><pre - > -test1 + >test1 test2 </pre ></div ><div class="doc" ><p - >aux11: -</p + >aux11:</p ><pre >test3 -test4 -</pre +test4</pre ><pre - > -test1 + >test1 test2 </pre ></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 + >This is some inline documentation in the export list</p ><pre > a code block using bird-tracks each line must begin with > (which isn't significant unless it - is at the beginning of the line). -</pre + is at the beginning of the line).</pre ></div ><h1 id="g:7" >A hidden module</h1 @@ -1868,8 +1805,7 @@ test2 ></div ><div class="doc" ><p - >nested-style doc comments -</p + >nested-style doc comments </p ></div ><h1 id="g:9" >Existential / Universal types</h1 @@ -1882,8 +1818,7 @@ test2 > a </p ><div class="doc" ><p - >A data-type using existential/universal types -</p + >A data-type using existential/universal types</p ></div ><div class="subs constructors" ><p class="caption" @@ -1958,8 +1893,7 @@ test2 ><a href="" >T</a ></code - > -</p + ></p ></td ></tr ><tr @@ -1973,8 +1907,7 @@ test2 ></td ><td class="doc" ><p - >This argument has type 'T2 Int Int' -</p + >This argument has type 'T2 Int Int'</p ></td ></tr ><tr @@ -1996,8 +1929,7 @@ test2 ><p >This argument has type <code >T3 Bool Bool -> T4 Float Float</code - > -</p + ></p ></td ></tr ><tr @@ -2009,8 +1941,7 @@ test2 ><p >This argument has a very long description that should hopefully cause some wrapping to happen when it is finally - rendered by Haddock in the generated HTML page. -</p + rendered by Haddock in the generated HTML page.</p ></td ></tr ><tr @@ -2020,16 +1951,14 @@ test2 > ()</td ><td class="doc" ><p - >This is the result type -</p + >This is the result type</p ></td ></tr ></table ></div ><div class="doc" ><p - >This is a function with documentation for each argument -</p + >This is a function with documentation for each argument</p ></div ></div ><div class="top" @@ -2052,8 +1981,7 @@ test2 >)</td ><td class="doc" ><p - >takes a triple -</p + >takes a triple</p ></td ></tr ><tr @@ -2067,8 +1995,7 @@ test2 ><a href="" >Int</a ></code - > -</p + ></p ></td ></tr ></table @@ -2098,8 +2025,7 @@ test2 > ()</td ><td class="doc" ><p - >one of the arguments -</p + >one of the arguments</p ></td ></tr ><tr @@ -2111,16 +2037,14 @@ test2 ></td ><td class="doc" ><p - >and the return value -</p + >and the return value</p ></td ></tr ></table ></div ><div class="doc" ><p - >This function has some arg docs -</p + >This function has some arg docs</p ></div ></div ><div class="top" @@ -2139,8 +2063,7 @@ test2 ></td ><td class="doc" ><p - >The input float -</p + >The input float</p ></td ></tr ><tr @@ -2152,16 +2075,14 @@ test2 ></td ><td class="doc" ><p - >The output float -</p + >The output float</p ></td ></tr ></table ></div ><div class="doc" ><p - >A foreign import with argument docs -</p + >A foreign import with argument docs</p ></div ></div ><h1 id="g:11" @@ -2170,13 +2091,11 @@ test2 >A subsection</h2 ><div class="doc" ><pre - > a literal line -</pre + > a literal line</pre ><p >$ a non <em >literal</em - > line $ -</p + > line $</p ></div ><div class="top" ><p class="src" @@ -2192,8 +2111,7 @@ test2 >f'</a ></code > - but f' doesn't get link'd 'f\'' -</p + but f' doesn't get link'd 'f\''</p ></div ></div ><div class="top" @@ -2205,8 +2123,7 @@ test2 ></p ><div class="doc" ><p - >Comment on a definition with type signature -</p + >Comment on a definition with type signature</p ></div ></div ><div class="top" @@ -2216,8 +2133,7 @@ test2 > :: t</p ><div class="doc" ><p - >Comment on a definition without type signature -</p + >Comment on a definition without type signature</p ></div ></div ></div diff --git a/html-test/ref/Ticket112.html b/html-test/ref/Ticket112.html index b80c18c4..a190c72b 100644 --- a/html-test/ref/Ticket112.html +++ b/html-test/ref/Ticket112.html @@ -65,8 +65,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket112.html");}; ><a href="" >Addr#</a ></code - > to the string, and the length of the string. -</p + > to the string, and the length of the string.</p ></div ></div ></div diff --git a/html-test/ref/Ticket253_1.html b/html-test/ref/Ticket253_1.html index 2bcc2e21..cd4d19a7 100644 --- a/html-test/ref/Ticket253_1.html +++ b/html-test/ref/Ticket253_1.html @@ -69,15 +69,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket253_1.html");}; ><a href="" >bar</a ></code - >. -</p + >.</p ><p >Also see <code ><a href="" >Baz</a ></code - > -</p + ></p ></div ></div ></div diff --git a/html-test/ref/Ticket253_2.html b/html-test/ref/Ticket253_2.html index aabe3486..fc3c2e51 100644 --- a/html-test/ref/Ticket253_2.html +++ b/html-test/ref/Ticket253_2.html @@ -73,8 +73,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket253_2.html");}; ></p ><div class="doc" ><p - >Comment -</p + >Comment</p ></div ></div ><div class="top" diff --git a/html-test/ref/Ticket61.html b/html-test/ref/Ticket61.html index e0858dc0..4ff68c29 100644 --- a/html-test/ref/Ticket61.html +++ b/html-test/ref/Ticket61.html @@ -62,8 +62,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket61.html");}; > :: a</p ><div class="doc" ><p - >A comment about f -</p + >A comment about f</p ></div ></div ></div diff --git a/html-test/ref/Ticket75.html b/html-test/ref/Ticket75.html index 4caa1196..c6746f39 100644 --- a/html-test/ref/Ticket75.html +++ b/html-test/ref/Ticket75.html @@ -99,8 +99,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket75.html");}; ><a href="" >:-</a ></code - > -</p + ></p ></div ></div ></div diff --git a/html-test/ref/TitledPicture.html b/html-test/ref/TitledPicture.html index c3f2bbbc..7ed7ce85 100644 --- a/html-test/ref/TitledPicture.html +++ b/html-test/ref/TitledPicture.html @@ -76,8 +76,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TitledPicture.html");} >foo</a ></code > without a title <img src="bar" - /> -</p + /></p ></div ></div ><div class="top" @@ -94,8 +93,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TitledPicture.html");} >bar</a ></code > with title <img src="un∣∁∘" title="δ∈" - /> -</p + /></p ></div ></div ></div diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index e7c4de6e..f3982eb6 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -105,8 +105,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; > a :: *</p ><div class="doc" ><p - >Type family G -</p + >Type family G</p ></div ></div ><div class="top" @@ -120,8 +119,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; ></p ><div class="doc" ><p - >A class with an associated type -</p + >A class with an associated type</p ></div ><div class="subs associated-types" ><p class="caption" @@ -134,8 +132,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; > a :: * -> *</p ><div class="doc" ><p - >An associated type -</p + >An associated type</p ></div ></div ><div class="subs methods" @@ -151,8 +148,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; ></p ><div class="doc" ><p - >A method -</p + >A method</p ></div ></div ><div class="subs instances" @@ -183,8 +179,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");}; > a </p ><div class="doc" ><p - >Doc for family -</p + >Doc for family</p ></div ></div ><div class="top" diff --git a/html-test/ref/Unicode.html b/html-test/ref/Unicode.html index 747cedb5..699ea209 100644 --- a/html-test/ref/Unicode.html +++ b/html-test/ref/Unicode.html @@ -65,8 +65,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_Unicode.html");}; ></p ><div class="doc" ><p - >γλώσσα -</p + >γλώσσα</p ></div ></div ></div diff --git a/html-test/ref/mini_Test.html b/html-test/ref/mini_Test.html index 8cd3321a..3a01ff1c 100644 --- a/html-test/ref/mini_Test.html +++ b/html-test/ref/mini_Test.html @@ -232,7 +232,7 @@ window.onload = function () {pageLoad();}; ><h1 >A section</h1 ><h2 - >A subsection </h2 + >A subsection</h2 ><div class="top" ><p class="src" ><a href="" target="main" diff --git a/src/Haddock.hs b/src/Haddock.hs index b741f5f1..cc7e7842 100644 --- a/src/Haddock.hs +++ b/src/Haddock.hs @@ -446,7 +446,7 @@ getPrologue dflags flags = [] -> return Nothing [filename] -> do str <- readFile filename - case parseParas dflags str of + case parseParasMaybe dflags str of Nothing -> throwE $ "failed to parse haddock prologue from file: " ++ filename Just doc -> return (Just doc) _otherwise -> throwE "multiple -p/--prologue options" diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs index 4d68c554..69b2dd6f 100644 --- a/src/Haddock/Doc.hs +++ b/src/Haddock/Doc.hs @@ -1,16 +1,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Haddock.Doc ( - docAppend, - docParagraph, - combineStringNodes, - combineDocumentation - ) where + docAppend +, docParagraph +, combineDocumentation +) where import Data.Maybe import Data.Monoid import Haddock.Types import Data.Char (isSpace) -import Control.Arrow ((***)) -- We put it here so that we can avoid a circular import -- anything relevant imports this module anyway @@ -22,25 +20,15 @@ combineDocumentation :: Documentation name -> Maybe (Doc name) combineDocumentation (Documentation Nothing Nothing) = Nothing combineDocumentation (Documentation mDoc mWarning) = Just (fromMaybe mempty mWarning `mappend` fromMaybe mempty mDoc) --- used to make parsing easier; we group the list items later docAppend :: Doc id -> Doc id -> Doc id -docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) - = DocUnorderedList (ds1++ds2) -docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) - = DocAppend (DocUnorderedList (ds1++ds2)) d -docAppend (DocOrderedList ds1) (DocOrderedList ds2) - = DocOrderedList (ds1++ds2) -docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) - = DocAppend (DocOrderedList (ds1++ds2)) d -docAppend (DocDefList ds1) (DocDefList ds2) - = DocDefList (ds1++ds2) -docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) - = DocAppend (DocDefList (ds1++ds2)) d +docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2) +docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d docAppend DocEmpty d = d docAppend d DocEmpty = d -docAppend d1 d2 - = DocAppend d1 d2 - +docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2) +docAppend (DocAppend d (DocString s1)) (DocString s2) = DocAppend d (DocString (s1 ++ s2)) +docAppend (DocString s1) (DocAppend (DocString s2) d) = DocAppend (DocString (s1 ++ s2)) d +docAppend d1 d2 = DocAppend d1 d2 -- again to make parsing easier - we spot a paragraph whose only item -- is a DocMonospaced and make it into a DocCodeBlock @@ -77,28 +65,3 @@ docCodeBlock (DocString s) docCodeBlock (DocAppend l r) = DocAppend l (docCodeBlock r) docCodeBlock d = d - --- | This is a hack that joins neighbouring 'DocString's into a single one. --- This is done to ease up the testing and doesn't change the final result --- as this would be done later anyway. -combineStringNodes :: Doc id -> Doc id -combineStringNodes (DocAppend (DocString x) (DocString y)) = DocString (x ++ y) -combineStringNodes (DocAppend (DocString x) (DocAppend (DocString y) z)) = - tryjoin (DocAppend (DocString (x ++ y)) (combineStringNodes z)) -combineStringNodes (DocAppend x y) = tryjoin (DocAppend (combineStringNodes x) (combineStringNodes y)) -combineStringNodes (DocParagraph x) = DocParagraph (combineStringNodes x) -combineStringNodes (DocWarning x) = DocWarning (combineStringNodes x) -combineStringNodes (DocEmphasis x) = DocEmphasis (combineStringNodes x) -combineStringNodes (DocMonospaced x) = DocMonospaced (combineStringNodes x) -combineStringNodes (DocUnorderedList xs) = DocUnorderedList (map combineStringNodes xs) -combineStringNodes (DocOrderedList x) = DocOrderedList (map combineStringNodes x) -combineStringNodes (DocDefList xs) = DocDefList (map (combineStringNodes *** combineStringNodes) xs) -combineStringNodes (DocCodeBlock x) = DocCodeBlock (combineStringNodes x) -combineStringNodes x = x - -tryjoin :: Doc id -> Doc id -tryjoin (DocAppend (DocString x) (DocString y)) = DocString (x ++ y) -tryjoin (DocAppend (DocString x) (DocAppend (DocString y) z)) = DocAppend (DocString (x ++ y)) z -tryjoin (DocAppend (DocAppend x (DocString y)) (DocString z)) - = tryjoin (DocAppend (combineStringNodes x) (DocString $ y ++ z)) -tryjoin x = x diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index 13563532..8c33ade6 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -43,11 +43,11 @@ processDocStrings dflags gre strs = do processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (Doc Name)) -processDocStringParas = process parseParas +processDocStringParas = process parseParasMaybe processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (Doc Name)) -processDocString = process parseString +processDocString = process parseStringMaybe process :: (DynFlags -> String -> Maybe (Doc RdrName)) -> DynFlags diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs index 2e4fe73b..ade28728 100644 --- a/src/Haddock/Interface/ParseModuleHeader.hs +++ b/src/Haddock/Interface/ParseModuleHeader.hs @@ -46,13 +46,13 @@ parseModuleHeader dflags str0 = description1 :: Either String (Maybe (Doc RdrName)) description1 = case descriptionOpt of Nothing -> Right Nothing - Just description -> case parseString dflags description of + Just description -> case parseStringMaybe dflags description of Nothing -> Left ("Cannot parse Description: " ++ description) Just doc -> Right (Just doc) in case description1 of Left mess -> Left mess - Right docOpt -> case parseParas dflags str8 of + Right docOpt -> case parseParasMaybe dflags str8 of Nothing -> Left "Cannot parse header documentation paragraphs" Just doc -> Right (HaddockModInfo { hmi_description = docOpt, diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index 43a2b169..fe8904d4 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -9,15 +9,15 @@ -- Stability : experimental -- Portability : portable -module Haddock.Parser (parseString, parseParas) where +module Haddock.Parser (parseString, parseParas, parseStringMaybe, parseParasMaybe) where +import Prelude hiding (takeWhile) +import Control.Monad (void, mfilter) import Control.Applicative -import Data.Attoparsec.ByteString hiding (parse, takeWhile1, take, inClass) -import qualified Data.Attoparsec.ByteString.Char8 as A8 -import Data.Attoparsec.ByteString.Char8 hiding (parse, take, string) -import qualified Data.ByteString as BS -import Data.Char (chr) -import Data.List (stripPrefix) +import Data.Attoparsec.ByteString.Char8 hiding (parse, take, string, endOfLine) +import qualified Data.ByteString.Char8 as BS +import Data.Char (chr, isAsciiUpper) +import Data.List (stripPrefix, intercalate) import Data.Maybe (fromMaybe) import Data.Monoid import DynFlags @@ -31,157 +31,117 @@ import SrcLoc (mkRealSrcLoc, unLoc) import StringBuffer (stringToStringBuffer) import Haddock.Utf8 -parse :: Parser a -> String -> Maybe a -parse p = either (const Nothing) Just . parseOnly (p <* endOfInput) . encodeUtf8 +{-# DEPRECATED parseParasMaybe "use `parseParas` instead" #-} +parseParasMaybe :: DynFlags -> String -> Maybe (Doc RdrName) +parseParasMaybe d = Just . parseParas d + +{-# DEPRECATED parseStringMaybe "use `parseString` instead" #-} +parseStringMaybe :: DynFlags -> String -> Maybe (Doc RdrName) +parseStringMaybe d = Just . parseString d + +parse :: Parser a -> BS.ByteString -> a +parse p = either err id . parseOnly (p <* endOfInput) + where + err = error . ("Haddock.Parser.parse: " ++) -- | Main entry point to the parser. Appends the newline character -- to the input string. parseParas :: DynFlags -> String -- ^ String to parse - -> Maybe (Doc RdrName) -parseParas d = fmap combineStringNodes . parse (p <* skipSpace) . (++ "\n") + -> Doc RdrName +parseParas d = parse (p <* skipSpace) . encodeUtf8 . (++ "\n") where p :: Parser (Doc RdrName) - -- make sure that we don't swallow up whitespace belonging to next paragraph - p = mconcat <$> paragraph d `sepBy` some (optWs *> "\n") - --- | A parser that parsers separate lines of the comments. Eventually --- called by 'parseParas'. Appends a newline character to the input string. --- Drops any whitespace in front of the input string. It's dropped for the sake of --- section headings. -parseString :: DynFlags -> String -> Maybe (Doc RdrName) -parseString d = parseString' d . dropWhile isSpace - --- | A parser that parsers separate lines of the comments. Eventually --- called by 'parseParas'. Appends a newline character to the input string. --- Unlike 'parseString', doesn't drop the preceding whitespace. Internal use. -parseString'' :: DynFlags -> String -> Maybe (Doc RdrName) -parseString'' d = parseString' d . (++ "\n") - --- | An internal use function. Split from the 'parseString' is useful --- as we can specify separately when we want the newline to be appended. -parseString' :: DynFlags -> String -> Maybe (Doc RdrName) -parseString' d = fmap combineStringNodes . parse p + p = mconcat <$> paragraph d `sepBy` many (skipHorizontalSpace *> "\n") + +-- | Parse a text paragraph. +parseString :: DynFlags -> String -> Doc RdrName +parseString d = parseStringBS d . encodeUtf8 . dropWhile isSpace + +parseStringBS :: DynFlags -> BS.ByteString -> Doc RdrName +parseStringBS d = parse p where p :: Parser (Doc RdrName) - p = mconcat <$> some (charEscape <|> monospace d <|> anchor <|> identifier d - <|> moduleName <|> picture <|> url - <|> emphasis d <|> encodedChar <|> string' <|> skipChar) + p = mconcat <$> many (monospace d <|> anchor <|> identifier d + <|> moduleName <|> picture <|> hyperlink <|> autoUrl + <|> emphasis d <|> encodedChar <|> string' <|> skipSpecialChar) -- | Parses and processes -- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references> -- -- >>> parseOnly encodedChar "ABC" -- Right (DocString "ABC") -encodedChar :: Parser (Doc RdrName) +encodedChar :: Parser (Doc a) encodedChar = "&#" *> c <* ";" where c = DocString . return . chr <$> num num = hex <|> decimal hex = ("x" <|> "X") *> hexadecimal +specialChar :: [Char] +specialChar = "/<@\"&'`" + -- | Plain, regular parser for text. Called as one of the last parsers -- to ensure that we have already given a chance to more meaningful parsers -- before capturing their characers. -string' :: Parser (Doc RdrName) -string' = DocString . decodeUtf8 <$> takeWhile1 (`notElem` "/<@\" &'`\\") +string' :: Parser (Doc a) +string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar) + where + unescape "" = "" + unescape ('\\':x:xs) = x : unescape xs + unescape (x:xs) = x : unescape xs + +-- | Skips a single special character and treats it as a plain string. +-- This is done to skip over any special characters belonging to other +-- elements but which were not deemed meaningful at their positions. +skipSpecialChar :: Parser (Doc a) +skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar) -- | Emphasis parser. -- -- >>> parseOnly emphasis "/Hello world/" -- Right (DocEmphasis (DocString "Hello world")) emphasis :: DynFlags -> Parser (Doc RdrName) -emphasis d = DocEmphasis <$> stringBlock d "/" "/" "\n" +emphasis d = DocEmphasis . parseStringBS d <$> + mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/") --- | Skips a single character and treats it as a plain string. --- This is done to skip over any special characters belonging to other --- elements but which were not deemed meaningful at their positions. --- Note that this can only be used in places where we're absolutely certain --- no unicode is present, such as to skip a 100% certain ASCII delimeter. -skipChar :: Parser (Doc RdrName) -skipChar = DocString . return <$> anyChar +-- | Like `takeWhile`, but unconditionally take escaped characters. +takeWhile_ :: (Char -> Bool) -> Parser BS.ByteString +takeWhile_ p = scan False p_ + where + p_ escaped c + | escaped = Just False + | not $ p c = Nothing + | otherwise = Just (c == '\\') --- | Treats the next character as a regular string, even if it's normally --- used for markup. -charEscape :: Parser (Doc RdrName) -charEscape = "\\" *> (DocString . return <$> A8.satisfy (/= '\n')) +-- | Like `takeWhile1`, but unconditionally take escaped characters. +takeWhile1_ :: (Char -> Bool) -> Parser BS.ByteString +takeWhile1_ = mfilter (not . BS.null) . takeWhile_ -- | Text anchors to allow for jumping around the generated documentation. -- -- >>> parseOnly anchor "#Hello world#" -- Right (DocAName "Hello world") -anchor :: Parser (Doc RdrName) +anchor :: Parser (Doc a) anchor = DocAName . decodeUtf8 <$> ("#" *> takeWhile1 (`notElem` "#\n") <* "#") --- | Helper for markup structures surrounded with delimiters. -stringBlock - :: DynFlags - -> String -- ^ Opening delimiter - -> String -- ^ Closing delimiter - -> String -- ^ Additional characters to terminate parsing on - -> Parser (Doc RdrName) -stringBlock d op ed n = do - inner <- block op ed n - case parseString' d inner of - Just r -> return r - _ -> fail $ "inner parse fail with op: ‘" ++ op ++ "’, ed: ‘" ++ ed ++ "’" - --- | Returns sections of text delimited by specified text. -block :: String -> String -> String -> Parser String -block op ed n = reverse . drop (length ed) . reverse <$> block' op ed - where - block' op' ed' = string (encodeUtf8 op') *> mid - where - mid :: Parser String - mid = decodeUtf8 <$> string (encodeUtf8 ed') - <|> do - inner <- takeWithSkip (head ed') n - more <- decodeUtf8 <$> string (encodeUtf8 $ tail ed') - <|> block' "" ed' -- not full ending, take more - return $ inner ++ more - - --- | Takes all characters until the specified one. Unconditionally --- takes a character if it's escaped. Fails if it doesn't find the character or --- when the input string is empty. -takeWithSkip :: Char -> String -> Parser String -takeWithSkip s n = do - content <- decodeUtf8 <$> A8.scan (False, False) p >>= gotSome - if or (map (`elem` content) n) || last content /= s - then fail "failed in takeWithSkip" - else return content - where - gotSome [] = fail "EOF in takeWithSkip" - gotSome xs = return xs - -- Apparently ‘scan’ is so magical that it doesn't mangle unicode. - p (escaped, terminate) c - | terminate = Nothing -- swallows up that extra character - | escaped = Just (False, False) - | c == s = Just (False, True) - | otherwise = Just (c == '\\', False) - -- | Monospaced strings. -- -- >>> parseOnly (monospace dynflags) "@cruel@" -- Right (DocMonospaced (DocString "cruel")) monospace :: DynFlags -> Parser (Doc RdrName) -monospace d = DocMonospaced <$> stringBlock d "@" "@" "" - --- | Module name parser, surrounded by double quotes. This does a very primitive and --- purely syntactic checking so that obviously invalid names are not treated as valid --- and blindly hyperlinked (not starting with a capital letter or including spaces). -moduleName :: Parser (Doc RdrName) -moduleName = DocModule <$> ("\"" *> legalModule <* "\"") - where legalModule = do - n <- (:) <$> A8.satisfy (`elem` ['A' .. 'Z']) - <*> (decodeUtf8 <$> A8.takeWhile (`notElem` "\"\n")) - - if any (`elem` n) " &[{}(=*)+]!#|@/;,^?" - then fail "invalid characters in module name" - else case n of - [] -> return [] - _ -> if last n == '.' then fail "trailing dot in module name" else return n +monospace d = DocMonospaced . parseStringBS d <$> ("@" *> takeWhile1_ (/= '@') <* "@") +moduleName :: Parser (Doc a) +moduleName = DocModule <$> (char '"' *> modid <* char '"') + where + modid = intercalate "." <$> conid `sepBy1` "." + conid = (:) + <$> satisfy isAsciiUpper + -- NOTE: According to Haskell 2010 we shouldd actually only + -- accept {small | large | digit | ' } here. But as we can't + -- match on unicode characters, this is currently not possible. + <*> (decodeUtf8 <$> takeWhile (`notElem` " .&[{}(=*)+]!#|@/;,^?\"\n")) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. @@ -190,181 +150,166 @@ moduleName = DocModule <$> ("\"" *> legalModule <* "\"") -- Right (DocPic (Picture "hello.png" Nothing)) -- >>> parseOnly picture "<<hello.png world>>" -- Right (DocPic (Picture "hello.png" (Just "world"))) -picture :: Parser (Doc RdrName) -picture = DocPic . makePicture . decodeUtf8 <$> ("<<" *> takeWhile1 (`notElem` ">\n") <* ">>") +picture :: Parser (Doc a) +picture = DocPic . makeLabeled Picture . decodeUtf8 + <$> ("<<" *> takeWhile1 (`notElem` ">\n") <* ">>") -- | Paragraph parser, called by 'parseParas'. paragraph :: DynFlags -> Parser (Doc RdrName) paragraph d = examples <|> skipSpace *> (list d <|> birdtracks <|> codeblock d <|> property <|> textParagraph d) +textParagraph :: DynFlags -> Parser (Doc RdrName) +textParagraph d = docParagraph . parseString d . intercalate "\n" <$> many1 nonEmptyLine + -- | List parser, called by 'paragraph'. list :: DynFlags -> Parser (Doc RdrName) list d = DocUnorderedList <$> unorderedList d <|> DocOrderedList <$> orderedList d <|> DocDefList <$> definitionList d --- | Parse given text with a provided parser, casting --- Nothing to a failure -parseLine :: (String -> Maybe (Doc RdrName)) -- ^ Parser to use - -> (Doc RdrName -> a) -- ^ Doc function to wrap around the result - -> BS.ByteString -- ^ Text to parse - -> Parser a -parseLine f doc str = maybe (fail "invalid string") (return . doc) (f $ decodeUtf8 str) - -- | Parses unordered (bullet) lists. unorderedList :: DynFlags -> Parser [Doc RdrName] -unorderedList d = ("*" <|> "-") *> innerList unorderedList d +unorderedList d = ("*" <|> "-") *> innerList (unorderedList d) d -- | Parses ordered lists (numbered or dashed). orderedList :: DynFlags -> Parser [Doc RdrName] -orderedList d = skipSpace *> (paren <|> dot) *> innerList orderedList d +orderedList d = (paren <|> dot) *> innerList (orderedList d) d where - dot = decimal <* "." - paren = "(" *> (decimal :: Parser Int) <* ")" + dot = (decimal :: Parser Int) <* "." + paren = "(" *> decimal <* ")" -- | Generic function collecting any further lines belonging to the -- list entry and recursively collecting any further lists in the -- same paragraph. Usually used as -- -- > someListFunction dynflags = listBeginning *> innerList someListFunction dynflags -innerList :: (DynFlags -> Parser [Doc RdrName]) -- ^ parser calling this function - -> DynFlags - -> Parser [Doc RdrName] -innerList p d = do - cl <- do - content <- A8.takeWhile (/= '\n') <* "\n" -- allow empty - parseLine (parseString'' d) id content - ulcs <- many ulc - let contents = docParagraph $ mconcat $ cl : [x | Right x <- ulcs] - unLists = mconcat [x | Left x <- ulcs] - return $ contents : unLists +innerList :: Parser [Doc RdrName] -> DynFlags -> Parser [Doc RdrName] +innerList item d = do + c <- takeLine + (cs, items) <- more + let contents = (docParagraph . parseString d . unlines) (c : cs) + return (contents : items) where - ulc :: Parser (Either [Doc RdrName] (Doc RdrName)) - ulc = Left <$> (optWs *> p d) - <|> Right <$> nonEmptyLine d - --- | Takes the remained of the line until the newline character --- and calls 'parseLine' using 'parseString'. Fails if it's made --- up strictly of whitespace. -nonEmptyLine :: DynFlags -> Parser (Doc RdrName) -nonEmptyLine d = do - s <- (takeWhile1 (/= '\n') >>= nonSpace) <* "\n" - parseLine (parseString'' d) id s - where - nonSpace xs - | not (any (not . isSpace) (decodeUtf8 xs)) = fail "empty line" - | otherwise = return xs + more :: Parser ([String], [Doc RdrName]) + more = moreListItems <|> moreContent <|> pure ([], []) + + moreListItems :: Parser ([String], [Doc RdrName]) + moreListItems = (,) [] <$> (skipSpace *> item) + + moreContent :: Parser ([String], [Doc RdrName]) + moreContent = mapFst . (:) <$> nonEmptyLine <*> more -- | Parses definition lists. definitionList :: DynFlags -> Parser [(Doc RdrName, Doc RdrName)] definitionList d = do - _ <- "[" - inner <- parseLine (parseString' d) id =<< takeWhile1 (`notElem` "]\n") - _ <- "]" - outer <- parseLine (parseString'' d) id =<< (A8.takeWhile (/= '\n') <* "\n") - ulcs <- many ulc - let contents = mconcat $ outer : [x | Right x <- ulcs] - unLists = map mconcat [x | Left x <- ulcs] - return $ (inner, contents) : unLists + label <- parseStringBS d <$> ("[" *> takeWhile1 (`notElem` "]\n") <* "]") + c <- takeLine + (cs, items) <- more + let contents = (parseString d . unlines) (c : cs) + return ((label, contents) : items) where - ulc :: Parser (Either [(Doc RdrName, Doc RdrName)] (Doc RdrName)) - ulc = Left <$> (optWs *> definitionList d) - <|> Right <$> nonEmptyLine d - --- | Parses birdtracks. No further markup is parsed after the birdtrack. --- Consecutive birdtracks are allowed. -birdtracks :: Parser (Doc RdrName) -birdtracks = DocCodeBlock . mconcat . map (DocString . (++ "\n") . decodeUtf8) <$> line `sepBy1` "\n" + more :: Parser ([String], [(Doc RdrName, Doc RdrName)]) + more = moreListItems <|> moreContent <|> pure ([], []) + + moreListItems :: Parser ([String], [(Doc RdrName, Doc RdrName)]) + moreListItems = (,) [] <$> (skipSpace *> definitionList d) + + moreContent :: Parser ([String], [(Doc RdrName, Doc RdrName)]) + moreContent = mapFst . (:) <$> nonEmptyLine <*> more + +birdtracks :: Parser (Doc a) +birdtracks = DocCodeBlock . DocString . intercalate "\n" <$> many1 line where - line = optWs *> ">" *> A8.takeWhile (/= '\n') + line = skipHorizontalSpace *> ">" *> takeLine -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. -examples :: Parser (Doc RdrName) -examples = DocExamples <$> example - --- | Collects consecutive examples and their results. -example :: Parser [Example] -example = do - ws <- optWs - prompt <- decodeUtf8 <$> string ">>>" - expr <- (++ "\n") . decodeUtf8 <$> (A8.takeWhile (/= '\n') <* "\n") - results <- many result - let exs = concat [ e | Left e <- results ] - res = filter (not . null) [ r | Right r <- results ] - return $ makeExample (decodeUtf8 ws ++ prompt) expr res : exs +examples :: Parser (Doc a) +examples = DocExamples <$> (many (skipHorizontalSpace *> "\n") *> go) where - result = Left <$> example - <|> Right . decodeUtf8 <$> takeWhile1 (/= '\n') <* "\n" + go :: Parser [Example] + go = do + prefix <- decodeUtf8 <$> takeHorizontalSpace <* ">>>" + expr <- takeLine + (rs, es) <- resultAndMoreExamples + return (makeExample prefix expr rs : es) + where + resultAndMoreExamples :: Parser ([String], [Example]) + resultAndMoreExamples = moreExamples <|> result <|> pure ([], []) + where + moreExamples :: Parser ([String], [Example]) + moreExamples = (,) [] <$> go + + result :: Parser ([String], [Example]) + result = mapFst . (:) <$> nonEmptyLine <*> resultAndMoreExamples + + makeExample :: String -> String -> [String] -> Example + makeExample prefix expression res = + Example (strip expression) result + where + result = map (substituteBlankLine . tryStripPrefix) res + + tryStripPrefix xs = fromMaybe xs (stripPrefix prefix xs) + + substituteBlankLine "<BLANKLINE>" = "" + substituteBlankLine xs = xs + +nonEmptyLine :: Parser String +nonEmptyLine = mfilter (any (not . isSpace)) takeLine --- | Propery parser. +takeLine :: Parser String +takeLine = decodeUtf8 <$> takeWhile (/= '\n') <* endOfLine + +endOfLine :: Parser () +endOfLine = void "\n" <|> endOfInput + +mapFst :: (a -> b) -> (a, c) -> (b, c) +mapFst f (a, b) = (f a, b) + +-- | Property parser. -- -- >>> parseOnly property "prop> hello world" -- Right (DocProperty "hello world") -property :: Parser (Doc RdrName) -property = do - _ <- skipSpace - s <- decodeUtf8 <$> (string "prop>" *> takeWhile1 (/= '\n')) - return $ makeProperty ("prop>" ++ s) - --- | Paragraph level codeblock. Anything between the two delimiting @ --- is parsed for markup. +property :: Parser (Doc a) +property = DocProperty . strip . decodeUtf8 <$> ("prop>" *> takeWhile1 (/= '\n')) + +-- | +-- Paragraph level codeblock. Anything between the two delimiting @ is parsed +-- for markup. codeblock :: DynFlags -> Parser (Doc RdrName) -codeblock d = do - -- Note that we don't need to use optWs here because in cases where - -- we don't see a \n immediatelly after the opening @, this parser - -- fails but we still have a chance to get a codeblock by getting - -- a monospaced doc on its own in the paragraph. With that, the cases - -- are covered. This should be updated if the implementation ever changes. - s <- parseString' d . ('\n':) . decodeUtf8 <$> ("@\n" *> block' <* "@") - maybe (fail "codeblock") (return . DocCodeBlock) s +codeblock d = + DocCodeBlock . parseStringBS d <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where - block' = A8.scan False p + block' = scan False p where p isNewline c | isNewline && c == '@' = Nothing | otherwise = Just $ c == '\n' --- | Calls 'parseString'' on each line of a paragraph -textParagraph :: DynFlags -> Parser (Doc RdrName) -textParagraph d = do - s <- parseString' d . concatMap ((++ "\n") . decodeUtf8) <$> line `sepBy1` "\n" - maybe (fail "textParagraph") (return . docParagraph) s - where - line = takeWhile1 (/= '\n') - --- | See 'picture' for adding a page title. -url :: Parser (Doc RdrName) -url = DocHyperlink . makeHyperlink . decodeUtf8 <$> ("<" *> takeWhile1 (`notElem` ">\n") <* ">") - <|> autoUrl - --- | Naive implementation of auto-linking. Will link everything after --- @http://@, @https://@, @ftp://@, @ssh://@, @gopher://@ until a space. --- Single trailing punctuation character (.!?,) is split off. -autoUrl :: Parser (Doc RdrName) -autoUrl = do - link <- decodeUtf8 <$> urlLone - return $ formatLink link +hyperlink :: Parser (Doc a) +hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8 <$> ("<" *> takeWhile1 (`notElem` ">\n") <* ">") + +autoUrl :: Parser (Doc a) +autoUrl = mkLink <$> url where - urlLone = mappend <$> choice prefixes <*> takeWhile1 (not . isSpace) - prefixes = [ "http://", "https://", "ftp://" - , "ssh://", "gopher://" ] - formatLink :: String -> Doc RdrName - formatLink s = if last s `elem` ".!?," - then docAppend (DocHyperlink $ Hyperlink (init s) Nothing) (DocString [last s]) - else DocHyperlink $ Hyperlink s Nothing + url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace) + mkLink :: BS.ByteString -> Doc a + mkLink s = case BS.unsnoc s of + Just (xs, x) | x `elem` ",.!?" -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) <> DocString [x] + _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it -- deems to be valid in an identifier. Note that it simply blindly consumes -- characters and does no actual validation itself. parseValid :: Parser String parseValid = do - vs <- many' (A8.satisfy (`elem` "_.!#$%&*+/<=>?@\\?|-~:") <|> digit <|> letter_ascii) + vs <- many' $ satisfy (`elem` "_.!#$%&*+/<=>?@\\|-~:") <|> digit <|> letter_ascii c <- peekChar case c of Just '`' -> return vs - Just '\'' -> (do {c'' <- char '\''; y'' <- parseValid; return $ vs ++ [c''] ++ y''}) <|> return vs + Just '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> parseValid) + <|> return vs _ -> fail "outofvalid" -- | Parses identifiers with help of 'parseValid'. Asks GHC for 'RdrName' from the @@ -374,56 +319,33 @@ identifier dflags = do o <- idDelim vid <- parseValid e <- idDelim - return $ validIdentifier $ o : (vid ++ [e]) - where idDelim = char '\'' <|> char '`' - validIdentifier str = case parseIdent (tail $ init str) of - Just identName -> DocIdentifier identName - Nothing -> DocString str - parseIdent :: String -> Maybe RdrName - parseIdent str0 = - let buffer = stringToStringBuffer str0 - realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0 - pstate = mkPState dflags buffer realSrcLc - in case unP parseIdentifier pstate of - POk _ name -> Just (unLoc name) - _ -> Nothing + return $ validIdentifier o vid e + where + idDelim = char '\'' <|> char '`' + validIdentifier o ident e = case parseIdent ident of + Just identName -> DocIdentifier identName + Nothing -> DocString $ o : ident ++ [e] + + parseIdent :: String -> Maybe RdrName + parseIdent str0 = + let buffer = stringToStringBuffer str0 + realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0 + pstate = mkPState dflags buffer realSrcLc + in case unP parseIdentifier pstate of + POk _ name -> Just (unLoc name) + _ -> Nothing -- | Remove all leading and trailing whitespace strip :: String -> String strip = (\f -> f . f) $ dropWhile isSpace . reverse --- | Consumes whitespace, excluding a newline. -optWs :: Parser BS.ByteString -optWs = A8.takeWhile (`elem` " \t\f\v\r") - --- | Create an 'Example', stripping superfluous characters as appropriate. --- Remembers the amount of indentation used for the prompt. -makeExample :: String -> String -> [String] -> Example -makeExample prompt expression res = - Example (strip expression) result' -- drop whitespace in expressions - where (prefix, _) = span isSpace prompt - result' = map substituteBlankLine $ filter (not . null) $ map (tryStripPrefix prefix) res - where tryStripPrefix xs ys = fromMaybe ys $ stripPrefix xs ys - substituteBlankLine "<BLANKLINE>" = "" - substituteBlankLine line = line - --- | Creates a 'Picture' with an optional title. Called by 'picture'. -makePicture :: String -> Picture -makePicture input = case break isSpace $ strip input of - (uri, "") -> Picture uri Nothing - (uri, label) -> Picture uri (Just $ dropWhile isSpace label) - --- | Creates a 'Hyperlink' with an optional title. Called by 'example'. -makeHyperlink :: String -> Hyperlink -makeHyperlink input = case break isSpace $ strip input of - (u, "") -> Hyperlink u Nothing - (u, label) -> Hyperlink u (Just $ dropWhile isSpace label) - --- | Makes a property that can be used by other programs for assertions. --- Drops whitespace around the property. Called by 'property' -makeProperty :: String -> Doc RdrName -makeProperty s = case strip s of - 'p':'r':'o':'p':'>':xs -> - DocProperty (dropWhile isSpace xs) - xs -> - error $ "makeProperty: invalid input " ++ show xs +skipHorizontalSpace :: Parser () +skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r") + +takeHorizontalSpace :: Parser BS.ByteString +takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r") + +makeLabeled :: (String -> Maybe String -> a) -> String -> a +makeLabeled f input = case break isSpace $ strip input of + (uri, "") -> f uri Nothing + (uri, label) -> f uri (Just $ dropWhile isSpace label) diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs index b0a6e41b..42f19c96 100644 --- a/test/Haddock/ParserSpec.hs +++ b/test/Haddock/ParserSpec.hs @@ -5,16 +5,16 @@ module Haddock.ParserSpec (main, spec) where -import Control.Applicative import Data.Monoid import Data.String -import Haddock.Doc (combineStringNodes) import qualified Haddock.Parser as Parse import Haddock.Types import Outputable (Outputable, showSDoc, ppr) -import RdrName (RdrName) +import RdrName (RdrName, mkVarUnqual) +import FastString (fsLit) +import StaticFlags (initStaticOpts) import Test.Hspec -import Test.QuickCheck (property) +import Test.QuickCheck import Helper @@ -24,6 +24,8 @@ instance Outputable a => Show a where deriving instance Show a => Show (Doc a) deriving instance Eq a => Eq (Doc a) +instance IsString RdrName where + fromString = mkVarUnqual . fsLit instance IsString (Doc RdrName) where fromString = DocString @@ -31,70 +33,78 @@ instance IsString (Doc RdrName) where instance IsString a => IsString (Maybe a) where fromString = Just . fromString -parseParas :: String -> Maybe (Doc RdrName) +parseParas :: String -> Doc RdrName parseParas = Parse.parseParas dynFlags -parseString :: String -> Maybe (Doc RdrName) +parseString :: String -> Doc RdrName parseString = Parse.parseString dynFlags main :: IO () main = hspec spec spec :: Spec -spec = do - let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) - +spec = before initStaticOpts $ do describe "parseString" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc RdrName -> Expectation - shouldParseTo input ast = parseString input `shouldBe` Just ast + shouldParseTo input ast = parseString input `shouldBe` ast it "is total" $ do property $ \xs -> (length . show . parseString) xs `shouldSatisfy` (> 0) + context "when parsing text" $ do + it "can handle unicode" $ do + "灼眼のシャナ" `shouldParseTo` "灼眼のシャナ" + + it "accepts numeric character references" $ do + "foo bar baz λ" `shouldParseTo` "foo bar baz λ" + + it "accepts hexadecimal character references" $ do + "e" `shouldParseTo` "e" + + it "allows to backslash-escape characters" $ do + property $ \x -> ['\\', x] `shouldParseTo` DocString [x] + + context "when parsing identifiers" $ do + it "parses identifiers enclosed within single ticks" $ do + "'foo'" `shouldParseTo` DocIdentifier "foo" + + it "parses identifiers enclosed within backticks" $ do + "`foo`" `shouldParseTo` DocIdentifier "foo" + + it "parses a word with one of the delimiters in it as ordinary string" $ do + "don't use apostrophe's in the wrong place's" `shouldParseTo` "don't use apostrophe's in the wrong place's" + context "when parsing URLs" $ do + let hyperlink :: String -> Maybe String -> Doc RdrName + hyperlink url = DocHyperlink . Hyperlink url + it "parses a URL" $ do - "<http://example.com/>" `shouldParseTo` - hyperlink "http://example.com/" Nothing + "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing it "accepts an optional label" $ do - "<http://example.com/ some link>" `shouldParseTo` - hyperlink "http://example.com/" "some link" - - it "finishes URL parsing as soon as it sees >, even if it's escaped" $ do - "<http://examp\\>le.com" `shouldParseTo` - hyperlink "http://examp\\" Nothing <> "le.com" + "<http://example.com/ some link>" `shouldParseTo` hyperlink "http://example.com/" "some link" - "<http://exa\\>mp\\>le.com>" `shouldParseTo` - hyperlink "http://exa\\" Nothing <> "mp>le.com>" + it "does not accept newlines in label" $ do + "<foo bar\nbaz>" `shouldParseTo` "<foo bar\nbaz>" - -- Likewise in label - "<http://example.com f\\>oo>" `shouldParseTo` - hyperlink "http://example.com" "f\\" <> "oo>" + it "does not allow to escap >" $ do + "<http://examp\\>le.com" `shouldParseTo` hyperlink "http://examp\\" Nothing <> "le.com" it "parses inline URLs" $ do - "Not yet working, see <http://trac.haskell.org/haddock/ticket/223>\n , isEmptyChan" `shouldParseTo` - "Not yet working, see " - <> hyperlink "http://trac.haskell.org/haddock/ticket/223" Nothing - <> "\n , isEmptyChan" + "foo <http://example.com/> bar" `shouldParseTo` + "foo " <> hyperlink "http://example.com/" Nothing <> " bar" context "when autolinking URLs" $ do it "autolinks HTTP URLs" $ do - "http://example.com/" `shouldParseTo` - hyperlink "http://example.com/" Nothing + "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing it "autolinks HTTPS URLs" $ do - "https://www.example.com/" `shouldParseTo` - hyperlink "https://www.example.com/" Nothing + "https://www.example.com/" `shouldParseTo` hyperlink "https://www.example.com/" Nothing it "autolinks FTP URLs" $ do - "ftp://example.com/" `shouldParseTo` - hyperlink "ftp://example.com/" Nothing - - it "does not include a trailing exclamation mark" $ do - "http://example.com/! Some other sentence." `shouldParseTo` - hyperlink "http://example.com/" Nothing <> "! Some other sentence." + "ftp://example.com/" `shouldParseTo` hyperlink "ftp://example.com/" Nothing it "does not include a trailing comma" $ do "http://example.com/, Some other sentence." `shouldParseTo` @@ -104,10 +114,46 @@ spec = do "http://example.com/. Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> ". Some other sentence." + it "does not include a trailing exclamation mark" $ do + "http://example.com/! Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "! Some other sentence." + it "does not include a trailing question mark" $ do "http://example.com/? Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> "? Some other sentence." + context "when parsing pictures" $ do + let picture :: String -> Maybe String -> Doc RdrName + picture uri = DocPic . Picture uri + + it "parses a simple picture" $ do + "<<foo>>" `shouldParseTo` picture "foo" Nothing + + it "accepts an optional title" $ do + "<<foo bar baz>>" `shouldParseTo` picture "foo" (Just "bar baz") + + it "does not accept newlines in title" $ do + "<<foo bar\nbaz>>" `shouldParseTo` "<<foo bar\nbaz>>" + + it "parses a picture with unicode" $ do + "<<灼眼 のシャナ>>" `shouldParseTo` picture "灼眼" (Just "のシャナ") + + it "doesn't allow for escaping of the closing tags" $ do -- bug? + "<<ba\\>>z>>" `shouldParseTo` picture "ba\\" Nothing <> "z>>" + + context "when parsing anchors" $ do + it "parses a single word anchor" $ do + "#foo#" `shouldParseTo` DocAName "foo" + + it "parses a multi word anchor" $ do + "#foo bar#" `shouldParseTo` DocAName "foo bar" + + it "parses a unicode anchor" $ do + "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ" + + it "does not accept newlines in anchors" $ do + "#foo\nbar#" `shouldParseTo` "#foo\nbar#" + context "when parsing emphasised text" $ do it "emphasises a word on its own" $ do "/foo/" `shouldParseTo` DocEmphasis "foo" @@ -130,363 +176,231 @@ spec = do it "recognizes other markup constructs within emphasised text" $ do "/foo @bar@ baz/" `shouldParseTo` DocEmphasis ("foo " <> DocMonospaced "bar" <> " baz") - describe "parseParas" $ do - let infix 1 `shouldParseTo` - shouldParseTo :: String -> Doc RdrName -> Expectation - shouldParseTo input ast = (combineStringNodes <$> parseParas input) - `shouldBe` Just ast + context "when parsing monospaced text" $ do + it "parses simple monospaced text" $ do + "@foo@" `shouldParseTo` DocMonospaced "foo" - it "is total" $ do - property $ \xs -> - (length . show . parseParas) xs `shouldSatisfy` (> 0) + it "parses inline monospaced text" $ do + "foo @bar@ baz" `shouldParseTo` "foo " <> DocMonospaced "bar" <> " baz" - it "parses a paragraph" $ do - "foobar" `shouldParseTo` DocParagraph "foobar\n" + it "allows to escape @" $ do + "@foo \\@ bar@" `shouldParseTo` DocMonospaced "foo @ bar" - it "empty input produces DocEmpty" $ do - "" `shouldParseTo` DocEmpty - - it "should preserve all regular characters" $ do - property $ \xs -> - let input = filterSpecial xs - in case input of - [] -> input `shouldParseTo` DocEmpty - _ -> input `shouldParseTo` DocParagraph (DocString $ input ++ "\n") + it "accepts unicode" $ do + "@foo 灼眼のシャナ bar@" `shouldParseTo` DocMonospaced "foo 灼眼のシャナ bar" - context "when parsing a simple string" $ do - it "] should be made into a DocString" $ do - "hell]o" `shouldParseTo` DocParagraph "hell]o\n" + it "accepts other markup in monospaced text" $ do + "@/foo/@" `shouldParseTo` DocMonospaced (DocEmphasis "foo") - it "can handle unicode" $ do - "灼眼のシャナ" `shouldParseTo` DocParagraph "灼眼のシャナ\n" + it "requires the closing @" $ do + "@foo /bar/ baz" `shouldParseTo` "@foo " <> DocEmphasis "bar" <> " baz" - context "when parsing module strings" $ do - it "should parse a module on its own" $ do - "\"Module\"" `shouldParseTo` - (DocParagraph $ DocModule "Module" <> "\n") + context "when parsing module names" $ do + it "accepts a simple module name" $ do + "\"Foo\"" `shouldParseTo` DocModule "Foo" - it "should parse a module inline" $ do - "This is a \"Module\"." `shouldParseTo` - DocParagraph ("This is a " <> (DocModule "Module" <> ".\n")) + it "accepts a module name with dots" $ do + "\"Foo.Bar.Baz\"" `shouldParseTo` DocModule "Foo.Bar.Baz" - context "when parsing codeblocks" $ do - it "codeblock a word on its own" $ do - "@quux@" `shouldParseTo` DocCodeBlock "quux" + it "accepts a module name with unicode" $ do + "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ" - it "codeblocks unicode" $ do - "@灼眼のシャナ@" `shouldParseTo` DocCodeBlock "灼眼のシャナ" + it "parses a module inline" $ do + "This is a \"Module\"." `shouldParseTo` ("This is a " <> (DocModule "Module" <> ".")) + it "rejects empty module name" $ do + "\"\"" `shouldParseTo` "\"\"" - it "does @multi-line\\n codeblocks@" $ do - "@multi-line\n codeblocks@" `shouldParseTo` - DocCodeBlock "multi-line\n codeblocks" + it "rejects a module name with a trailing dot" $ do + "\"Foo.\"" `shouldParseTo` "\"Foo.\"" - it "accepts other elements in a codeblock" $ do - "@/emphasis/ \"Module\" <<picture>>@" `shouldParseTo` - (DocCodeBlock $ DocEmphasis "emphasis" <> " " - <> DocModule "Module" <> " " <> pic "picture" Nothing) + it "rejects a module name with a space" $ do + "\"Foo Bar\"" `shouldParseTo` "\"Foo Bar\"" - context "when parsing monospaced strings" $ do - it "monospaces inline strings" $ do - "This comment applies to the @following@ declaration" `shouldParseTo` - (DocParagraph $ "This comment applies to the " - <> DocMonospaced "following" <> " declaration\n") + it "rejects a module name with invalid characters" $ do + "\"Foo&[{}(=*)+]!\"" `shouldParseTo` "\"Foo&[{}(=*)+]!\"" - it "should allow us to escape the @" $ do - "foo @hey \\@ world@ bar" `shouldParseTo` - DocParagraph ("foo " <> DocMonospaced "hey @ world" <> " bar\n") + describe "parseParas" $ do + let infix 1 `shouldParseTo` + shouldParseTo :: String -> Doc RdrName -> Expectation + shouldParseTo input ast = parseParas input `shouldBe` ast - it "monospaces inline unicode" $ do - "hello @灼眼のシャナ@ unicode" `shouldParseTo` - (DocParagraph $ "hello " - <> DocMonospaced "灼眼のシャナ" <> " unicode\n") + it "is total" $ do + property $ \xs -> + (length . show . parseParas) xs `shouldSatisfy` (> 0) - it "accepts other elements in a monospaced section" $ do - "hey @/emphasis/ \"Module\" <<picture>>@ world" `shouldParseTo` - (DocParagraph $ - "hey " - <> DocMonospaced (DocEmphasis "emphasis" <> " " - <> DocModule "Module" <> " " <> pic "picture" Nothing) - <> " world\n") + context "when parsing text paragraphs" $ do + let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) + it "parses an empty paragraph" $ do + "" `shouldParseTo` DocEmpty - context "when parsing unordered lists" $ do - it "parses a simple unordered list" $ do - "* point one\n\n* point two" `shouldParseTo` - DocUnorderedList [ DocParagraph " point one\n" - , DocParagraph " point two\n"] - - "* 1.parameter re : the derived regular expression" - ++ "\n\n- returns : empty String" `shouldParseTo` - (DocUnorderedList - [DocParagraph " 1.parameter re : the derived regular expression\n", - DocParagraph " returns : empty String\n"]) - - it "doesn't accept a list where unexpected" $ do - " expression?\n -> matches\n\n * 1.parameter \n\n" - `shouldParseTo` - DocParagraph "expression?\n -> matches\n" <> DocUnorderedList [DocParagraph " 1.parameter \n"] - - - it "parses a simple unordered list without the empty line separator" $ do - "* point one\n* point two" `shouldParseTo` - DocUnorderedList [ DocParagraph " point one\n" - , DocParagraph " point two\n"] - - "* point one\nmore one\n* point two\nmore two" `shouldParseTo` - DocUnorderedList [ DocParagraph " point one\nmore one\n" - , DocParagraph " point two\nmore two\n"] - - " * point one\nmore one\n * point two\nmore two" `shouldParseTo` - DocUnorderedList [ DocParagraph " point one\nmore one\n" - , DocParagraph " point two\nmore two\n" - ] - - it "parses an empty unordered list" $ do - "*" `shouldParseTo` DocUnorderedList [DocParagraph "\n"] - - it "accepts unicode in an unordered list" $ do - "* 灼眼のシャナ" `shouldParseTo` - DocUnorderedList [DocParagraph " 灼眼のシャナ\n"] - - it "preserves whitespace on the front of additional lines" $ do - "* foo\n bar" `shouldParseTo` DocUnorderedList [DocParagraph " foo\n bar\n"] - - it "accepts other elements in an unordered list" $ do - ("* \"Module\"\n\n* /emphasis/" - ++ "\n\n* @code@\n\n* a@mono@b \n\n*") `shouldParseTo` - DocUnorderedList [ - DocParagraph (" " <> DocModule "Module" <> "\n") - , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") - , DocCodeBlock "code" - , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") - , DocParagraph "\n" - ] + it "parses a simple text paragraph" $ do + "foo bar baz" `shouldParseTo` DocParagraph "foo bar baz" - ("* \"Module\"\n* /emphasis/" - ++ "\n* @code@\n* a@mono@b \n*") `shouldParseTo` - DocUnorderedList [ - DocParagraph (" " <> DocModule "Module" <> "\n") - , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") - , DocCodeBlock "code" - , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") - , DocParagraph "\n" - ] + it "accepts markup in text paragraphs" $ do + "foo /bar/ baz" `shouldParseTo` DocParagraph ("foo " <> DocEmphasis "bar" <> " baz") - context "when parsing ordered lists" $ do - it "parses a simple ordered list" $ do - "1. point one\n\n2. point two" `shouldParseTo` - DocOrderedList [ DocParagraph " point one\n" - , DocParagraph " point two\n" - ] - - it "parses a simple ordered list without the newline separator" $ do - "1. point one\n2. point two" `shouldParseTo` - DocOrderedList [ DocParagraph " point one\n" - , DocParagraph " point two\n" - ] - - "1. point one\nmore\n2. point two\nmore" `shouldParseTo` - DocOrderedList [ DocParagraph " point one\nmore\n" - , DocParagraph " point two\nmore\n" - ] - - -- space before list - " 1. point one\nmore\n 2. point two\nmore" `shouldParseTo` - DocOrderedList [ DocParagraph " point one\nmore\n" - , DocParagraph " point two\nmore\n" - ] - - it "parses an empty list" $ do - "1." `shouldParseTo` DocOrderedList [DocParagraph "\n"] - - "(1)" `shouldParseTo` DocOrderedList [DocParagraph "\n"] + it "preserve all regular characters" $ do + property $ \xs -> let input = filterSpecial xs in (not . null) input ==> + input `shouldParseTo` DocParagraph (DocString input) - it "accepts unicode" $ do - "1. 灼眼のシャナ" `shouldParseTo` - DocOrderedList [DocParagraph " 灼眼のシャナ\n"] - - "(1) 灼眼のシャナ" `shouldParseTo` - DocOrderedList [DocParagraph " 灼眼のシャナ\n"] - - it "preserves whitespace on the front of additional lines" $ do - "1. foo\n bar" `shouldParseTo` DocOrderedList [DocParagraph " foo\n bar\n"] - - it "accepts other elements" $ do - ("1. \"Module\"\n\n2. /emphasis/" - ++ "\n\n3. @code@\n\n4. a@mono@b \n\n5.") `shouldParseTo` - DocOrderedList [ - DocParagraph (" " <> DocModule "Module" <> "\n") - , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") - , DocCodeBlock "code" - , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") - , DocParagraph "\n" - ] + it "separates paragraphs by empty lines" $ do + unlines [ + "foo" + , " \t " + , "bar" + ] `shouldParseTo` DocParagraph "foo" <> DocParagraph "bar" - context "when parsing definition lists" $ do - it "parses a simple list" $ do - "[foo] bar\n\n[baz] quux" `shouldParseTo` - DocDefList [("foo", " bar\n"), ("baz", " quux\n")] + context "when a pragraph only contains monospaced text" $ do + it "turns it into a code block" $ do + "@foo@" `shouldParseTo` DocCodeBlock "foo" - it "parses a simple list without the newline separator" $ do - "[foo] bar\n[baz] quux" `shouldParseTo` - DocDefList [("foo", " bar\n"), ("baz", " quux\n")] + context "when parsing birdtracks" $ do + it "parses them as a code block" $ do + unlines [ + ">foo" + , ">bar" + , ">baz" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" - "[foo] bar\nmore\n[baz] quux\nmore" `shouldParseTo` - DocDefList [("foo", " bar\nmore\n"), ("baz", " quux\nmore\n")] + it "ignores leading whitespace" $ do + unlines [ + " >foo" + , " \t >bar" + , " >baz" + ] + `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" - " [foo] bar\nmore\n [baz] quux\nmore" `shouldParseTo` - DocDefList [("foo", " bar\nmore\n"), ("baz", " quux\nmore\n")] + it "ignores nested markup" $ do + unlines [ + ">/foo/" + ] `shouldParseTo` DocCodeBlock "/foo/" - it "parses a list with unicode in it" $ do - "[灼眼] シャナ" `shouldParseTo` - DocDefList [("灼眼", " シャナ\n")] + it "treats them as regular text inside text paragraphs" $ do + unlines [ + "foo" + , ">bar" + ] `shouldParseTo` DocParagraph "foo\n>bar" - it "parse other markup inside of it as usual" $ do - "[/foo/] bar" `shouldParseTo` - DocDefList [(DocEmphasis "foo", " bar\n")] + context "when parsing code blocks" $ do + it "accepts a simple code block" $ do + unlines [ + "@" + , "foo" + , "bar" + , "baz" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz\n" + + it "ignores trailing whitespace after the opening @" $ do + unlines [ + "@ " + , "foo" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\n" - it "doesn't need a string to follow it" $ do - "[hello /world/]" `shouldParseTo` - DocDefList [("hello " <> DocEmphasis "world", "\n")] + it "rejects code blocks that are not closed" $ do + unlines [ + "@" + , "foo" + ] `shouldParseTo` DocParagraph "@\nfoo" - it "takes input until the very last delimiter on the line" $ do - "[[world]] bar" `shouldParseTo` - DocDefList [("[world", "] bar\n")] + it "accepts nested markup" $ do + unlines [ + "@" + , "/foo/" + , "@" + ] `shouldParseTo` DocCodeBlock (DocEmphasis "foo" <> "\n") - it "treats broken up definition list as regular string" $ do - "[qu\nx] hey" `shouldParseTo` DocParagraph "[qu\nx] hey\n" + it "allows to escape the @" $ do + unlines [ + "@" + , "foo" + , "\\@" + , "bar" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\n@\nbar\n" + + context "when parsing examples" $ do + it "parses a simple example" $ do + ">>> foo" `shouldParseTo` DocExamples [Example "foo" []] + + it "parses an example with result" $ do + unlines [ + ">>> foo" + , "bar" + , "baz" + ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] - it "preserves whitespace on the front of additional lines" $ do - "[foo] bar\n baz" `shouldParseTo` DocDefList [("foo", " bar\n baz\n")] + it "parses consecutive examples" $ do + unlines [ + ">>> fib 5" + , "5" + , ">>> fib 10" + , "55" + ] `shouldParseTo` DocExamples [ + Example "fib 5" ["5"] + , Example "fib 10" ["55"] + ] + + it "requires an example to be separated from a previous paragraph by an empty line" $ do + unlines [ + "foobar" + , "" + , ">>> fib 10" + , "55" + ] `shouldParseTo` DocParagraph "foobar" + <> DocExamples [Example "fib 10" ["55"]] - context "when parsing consecutive paragraphs" $ do - it "will not capture irrelevant consecutive lists" $ do - " * bullet\n\n - different bullet\n\n (1) ordered\n \n " - ++ "2. different bullet\n \n [cat] kitten\n \n [pineapple] fruit" - `shouldParseTo` - DocUnorderedList [ DocParagraph " bullet\n" - , DocParagraph " different bullet\n"] - <> DocOrderedList [ DocParagraph " ordered\n" - , DocParagraph " different bullet\n" - ] - <> DocDefList [ ("cat", " kitten\n") - , ("pineapple", " fruit\n") - ] - - context "when parsing an example" $ do - it ("requires an example to be separated" - ++ " from a previous paragraph by an empty line") $ do - "foobar\n\n>>> fib 10\n55" `shouldParseTo` - DocParagraph "foobar\n" - <> DocExamples [Example "fib 10" ["55"]] - - -- parse error it "parses bird-tracks inside of paragraphs as plain strings" $ do - "foobar\n>>> fib 10\n55" `shouldParseTo` DocParagraph "foobar\n>>> fib 10\n55\n" - - it "parses a prompt with no example results" $ do - " >>> import Data.Char\n " `shouldParseTo` - DocExamples [ Example { exampleExpression = "import Data.Char" - , exampleResult = [] - } - ] - - it "is able to parse example sections with unicode" $ do - " >>> 灼眼\n の\n >>> シャナ\n 封絶" `shouldParseTo` - DocExamples [ Example { exampleExpression = "灼眼" - , exampleResult = ["の"] - } - , Example { exampleExpression = "シャナ" - , exampleResult = ["封絶"] - } - ] - it "preserves whitespace before the prompt with consecutive paragraphs" $ do - " Examples:\n\n >>> fib 5\n 5\n >>> fib 10\n 55\n\n >>> fib 10\n 55" - `shouldParseTo` - DocParagraph "Examples:\n" - <> DocExamples [ Example { exampleExpression = "fib 5" - , exampleResult = ["5"]} - , Example {exampleExpression = "fib 10" - , exampleResult = ["55"]}] - <> DocExamples [ Example { exampleExpression = "fib 10" - , exampleResult = ["55"]}] - - it "can parse consecutive prompts with results" $ do - " >>> fib 5\n 5\n >>> fib 10\n 55" `shouldParseTo` - DocExamples [ Example { exampleExpression = "fib 5" - , exampleResult = ["5"] } - , Example { exampleExpression = "fib 10" - , exampleResult = ["55"] }] - - it "can parse results if they don't have the same whitespace prefix" $ do - " >>> hey\n5\n 5\n 5" `shouldParseTo` - DocExamples [ Example { exampleExpression = "hey" - , exampleResult = ["5", "5", " 5"] }] + let xs = "foo\n>>> bar" + xs `shouldParseTo` DocParagraph (DocString xs) + it "skips empty lines in front of an example" $ do + "\n \n\n>>> foo" `shouldParseTo` DocExamples [Example "foo" []] + + it "terminates example on empty line" $ do + unlines [ + ">>> foo" + , "bar" + , " " + , "baz" + ] + `shouldParseTo` + DocExamples [Example "foo" ["bar"]] <> DocParagraph "baz" it "parses a <BLANKLINE> result as an empty result" $ do - ">>> putFooBar\nfoo\n<BLANKLINE>\nbar" `shouldParseTo` - DocExamples [Example "putFooBar" ["foo","","bar"]] - - context "when parsing a code block" $ do - it ("requires a code blocks to be " - ++ "separated from a previous paragraph by an empty line") $ do - "foobar\n\n> some code" `shouldParseTo` - DocParagraph "foobar\n" <> DocCodeBlock " some code\n" - - it "parses birdtracks inside of paragraphs as plain strings" $ do - "foobar\n> some code" `shouldParseTo` DocParagraph "foobar\n> some code\n" - - it "long birdtrack block without spaces in front" $ do - "beginning\n\n> foo\n> bar\n> baz" `shouldParseTo` - DocParagraph "beginning\n" - <> DocCodeBlock " foo\n bar\n baz\n" - - it "single DocCodeBlock even if there's space before birdtracks" $ do - "beginning\n\n > foo\n > bar\n > baz" `shouldParseTo` - DocParagraph "beginning\n" - <> DocCodeBlock " foo\n bar\n baz\n" - - it "consecutive birdtracks with spaces " $ do - " > foo\n \n > bar\n \n" `shouldParseTo` - DocCodeBlock " foo\n" <> DocCodeBlock " bar\n" - - it "code block + birdtracks" $ do - "@\ntest1\ntest2\n@\n\n>test3\n>test4\n\n" `shouldParseTo` - DocCodeBlock "\ntest1\ntest2\n" - <> DocCodeBlock "test3\ntest4\n" - - it "requires the code block to be closed" $ do - "@hello" `shouldParseTo` DocParagraph "@hello\n" - - it "preserves the first trailing whitespace after the opening @ in a code block" $ do - "@\ntest1\ntest2\n@" `shouldParseTo` DocCodeBlock "\ntest1\ntest2\n" - - "@ \ntest1\ntest2\n@" `shouldParseTo` DocCodeBlock " \ntest1\ntest2\n" - - it "markup in a @ code block" $ do - "@hello <world> \"Foo.Bar\" <<how is>> it /going/?@" `shouldParseTo` - DocCodeBlock - ("hello " <> - (DocHyperlink (Hyperlink {hyperlinkUrl = "world", hyperlinkLabel = Nothing})) - <> " " - <> DocModule "Foo.Bar" - <> " " - <> (DocPic (Picture {pictureUri = "how", pictureTitle = Just "is"})) - <> " it " <> (DocEmphasis "going") - <> "?") - - it "should allow us to escape the @ in a paragraph level @ code block" $ do - "@hello \\@ world@" `shouldParseTo` DocCodeBlock "hello @ world" - - it "should swallow up trailing spaces in code blocks" $ do - "@ foo @" `shouldParseTo` DocCodeBlock " foo" - - it "birdtracks + code block" $ do - ">test3\n>test4\n\n@\ntest1\ntest2\n@\n\n" `shouldParseTo` - DocCodeBlock "test3\ntest4\n" - <> DocCodeBlock "\ntest1\ntest2\n" + unlines [ + ">>> foo" + , "bar" + , "<BLANKLINE>" + , "baz" + ] + `shouldParseTo` DocExamples [Example "foo" ["bar", "", "baz"]] + + it "accepts unicode in examples" $ do + ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]] + + context "when prompt is prefixed by whitespace" $ do + it "strips the exact same amount of whitespace from result lines" $ do + unlines [ + " >>> foo" + , " bar" + , " baz" + ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] + + it "preserves additional whitespace" $ do + unlines [ + " >>> foo" + , " bar" + ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] + + it "keeps original if stripping is not possible" $ do + unlines [ + " >>> foo" + , " bar" + ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] context "when parsing properties" $ do it "can parse a single property" $ do @@ -505,115 +419,189 @@ spec = do DocProperty "灼眼のシャナ ≡ 愛" it "can deal with whitespace before and after the prop> prompt" $ do - " prop> xs == (reverse $ reverse xs)" `shouldParseTo` + " prop> xs == (reverse $ reverse xs) " `shouldParseTo` DocProperty "xs == (reverse $ reverse xs)" - context "when escaping elements" $ do - - it "escapes \\#\\#\\#" $ do - " We should be able to escape this: \\#\\#\\#" `shouldParseTo` - DocParagraph "We should be able to escape this: ###\n" - - it "escapes forward slashes" $ do - " Existential \\/ Universal types" `shouldParseTo` - DocParagraph "Existential / Universal types\n" - - context "when parsing pictures" $ do - it "parses a simple picture" $ do - "<<baz>>" `shouldParseTo` - DocParagraph (pic "baz" Nothing <> "\n") - - it "parses a picture with a title" $ do - "<<b a z>>" `shouldParseTo` - DocParagraph (pic "b" (Just "a z") <> "\n") - - it "parses a picture with unicode" $ do - "<<灼眼のシャナ>>" `shouldParseTo` - DocParagraph ((pic "灼眼のシャナ" Nothing) <> "\n") - - it "doesn't allow for escaping of the closing tags" $ do -- bug? - "<<ba\\>>z>>" `shouldParseTo` - (DocParagraph $ pic "ba\\" Nothing <> "z>>\n") - - context "when parsing anchors" $ do - it "should parse a single word anchor" $ do - "#foo#" `shouldParseTo` - DocParagraph (DocAName "foo" <> "\n") - - it "should parse a multi word anchor" $ do - "#foo bar#" `shouldParseTo` - DocParagraph (DocAName "foo bar" <> "\n") - - it "should parse a unicode anchor" $ do - "#灼眼のシャナ#" `shouldParseTo` - DocParagraph (DocAName "灼眼のシャナ" <> "\n") - - context "replicates parsing of weird strings" $ do - it "#f\\noo#" $ do - "#f\noo#" `shouldParseTo` DocParagraph "#f\noo#\n" - - it "<b\\nar>" $ do - "<b\nar>" `shouldParseTo` DocParagraph "<b\nar>\n" - - it "<<ba\\nz aar>>" $ do - "<<ba\nz aar>>" `shouldParseTo` DocParagraph "<<ba\nz aar>>\n" - - it "[@q/uu/x@] h\\ney" $ do - "[@q/uu/x@] h\ney" `shouldParseTo` - DocDefList - [(DocMonospaced ("q" <> DocEmphasis "uu" <> "x"), " h\ney\n")] - - -- regression test - it "requires markup to be fully closed, even if nested" $ do - "@hel/lo" `shouldParseTo` DocParagraph "@hel/lo\n" - - it "will be total even if only the first delimiter is present" $ do - "/" `shouldParseTo` DocParagraph "/\n" - - context "when parsing strings with apostrophes" $ do - it "parses a word with an one of the delimiters in it as DocString" $ do - "don't" `shouldParseTo` DocParagraph "don't\n" - - it "doesn't pass pairs of delimiters with spaces between them" $ do - "hel'lo w'orld" `shouldParseTo` DocParagraph "hel'lo w'orld\n" - - it "don't use apostrophe's in the wrong place's" $ do - " don't use apostrophe's in the wrong place's" `shouldParseTo` - DocParagraph "don't use apostrophe's in the wrong place's\n" - - context "when parsing strings contaning numeric character references" $ do - it "will implicitly convert digits to characters" $ do - "AAAA" `shouldParseTo` DocParagraph "AAAA\n" - - "灼眼のシャナ" `shouldParseTo` - DocParagraph "灼眼のシャナ\n" - - it "will implicitly convert hex encoded characters" $ do - "eeee" `shouldParseTo` DocParagraph "eeee\n" - - context "when parsing module names" $ do - it "can accept a simple module name" $ do - "\"Hello\"" `shouldParseTo` DocParagraph (DocModule "Hello" <> "\n") - - it "can accept a module name with dots" $ do - "\"Hello.World\"" `shouldParseTo` DocParagraph (DocModule "Hello.World" <> "\n") - - it "can accept a module name with unicode" $ do - "\"Hello.Worldλ\"" `shouldParseTo` DocParagraph ((DocModule "Hello.Worldλ") <> "\n") - - it "parses a module name with a trailing dot as regular quoted string" $ do - "\"Hello.\"" `shouldParseTo` DocParagraph "\"Hello.\"\n" - - it "parses a module name with a space as regular quoted string" $ do - "\"Hello World\"" `shouldParseTo` DocParagraph "\"Hello World\"\n" - - it "parses a module name with invalid characters as regular quoted string" $ do - "\"Hello&[{}(=*)+]!\"" `shouldParseTo` DocParagraph "\"Hello&[{}(=*)+]!\"\n" + context "when parsing unordered lists" $ do + it "parses a simple list" $ do + unlines [ + " * one" + , " * two" + , " * three" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "one\n" + , DocParagraph "two\n" + , DocParagraph "three\n" + ] + + it "ignores empty lines between list items" $ do + unlines [ + "* one" + , "" + , "* two" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "one\n" + , DocParagraph "two\n" + ] + + it "accepts an empty list item" $ do + "*" `shouldParseTo` DocUnorderedList [DocParagraph DocEmpty] + + it "accepts multi-line list items" $ do + unlines [ + "* point one" + , " more one" + , "* point two" + , "more two" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "point one\n more one\n" + , DocParagraph "point two\nmore two\n" + ] + + it "accepts markup in list items" $ do + "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo" <> "\n")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "* bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar\n"] <> DocParagraph "baz" + context "when parsing ordered lists" $ do + it "parses a simple list" $ do + unlines [ + " 1. one" + , " (1) two" + , " 3. three" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "one\n" + , DocParagraph "two\n" + , DocParagraph "three\n" + ] + + it "ignores empty lines between list items" $ do + unlines [ + "1. one" + , "" + , "2. two" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "one\n" + , DocParagraph "two\n" + ] + + it "accepts an empty list item" $ do + "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty] + + it "accepts multi-line list items" $ do + unlines [ + "1. point one" + , " more one" + , "1. point two" + , "more two" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "point one\n more one\n" + , DocParagraph "point two\nmore two\n" + ] + + it "accepts markup in list items" $ do + "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo" <> "\n")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "1. bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar\n"] <> DocParagraph "baz" - where - hyperlink :: String -> Maybe String -> Doc RdrName - hyperlink url = DocHyperlink . Hyperlink url + context "when parsing definition lists" $ do + it "parses a simple list" $ do + unlines [ + " [foo] one" + , " [bar] two" + , " [baz] three" + ] + `shouldParseTo` DocDefList [ + ("foo", "one\n") + , ("bar", "two\n") + , ("baz", "three\n") + ] + + it "ignores empty lines between list items" $ do + unlines [ + "[foo] one" + , "" + , "[bar] two" + ] + `shouldParseTo` DocDefList [ + ("foo", "one\n") + , ("bar", "two\n") + ] + + it "accepts an empty list item" $ do + "[foo]" `shouldParseTo` DocDefList [("foo", DocEmpty)] + + it "accepts multi-line list items" $ do + unlines [ + "[foo] point one" + , " more one" + , "[bar] point two" + , "more two" + ] + `shouldParseTo` DocDefList [ + ("foo", "point one\n more one\n") + , ("bar", "point two\nmore two\n") + ] + + it "accepts markup in list items" $ do + "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo" <> "\n")] + + it "accepts markup for the label" $ do + "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar\n")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "[foo] bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar\n")] <> DocParagraph "baz" - pic :: String -> Maybe String -> Doc RdrName - pic uri = DocPic . Picture uri + context "when parsing consecutive paragraphs" $ do + it "accepts consecutive lists" $ do + unlines [ + " * foo" + , "" + , " - bar" + , "" + , " (1) ordered foo" + , " " + , " 2. ordered bar" + , " " + , " [cat] kitten" + , " " + , " [pineapple] fruit" + ] `shouldParseTo` DocUnorderedList [ + DocParagraph "foo\n" + , DocParagraph "bar\n" + ] <> DocOrderedList [ + DocParagraph "ordered foo\n" + , DocParagraph "ordered bar\n" + ] <> DocDefList [ + ("cat", "kitten\n") + , ("pineapple", "fruit\n") + ] |