Blogdown 0.1.0 → 0.2.0
raw patch · 21 files changed
+451/−380 lines, 21 filesdep +criteriondep +network-uribuild-type:Customsetup-changed
Dependencies added: criterion, network-uri
Files
- Blogdown.cabal +26/−20
- ChangeLog.md +15/−0
- Readme.html +0/−189
- Readme.md +66/−18
- Setup.hs +23/−1
- assets/Footnotes.css +18/−0
- assets/Footnotes.js +41/−0
- assets/footnotes.css +0/−18
- assets/footnotes.js +0/−41
- src/AST.hs +10/−3
- src/Blogdown.hs +3/−3
- src/Parsing/Parse.hs +4/−3
- src/Parsing/ParseBlock.hs +24/−11
- src/Parsing/ParseHtml.hs +11/−1
- src/Parsing/ParseInline.hs +22/−8
- src/Parsing/State.hs +6/−2
- src/Parsing/Text.hs +8/−2
- src/Rendering/Render.hs +40/−33
- src/Rendering/RenderOptions.hs +25/−15
- test/Benchmark.hs +20/−0
- test/Test.hs +89/−12
Blogdown.cabal view
@@ -1,47 +1,53 @@ name: Blogdown-version: 0.1.0+version: 0.2.0 synopsis: A markdown-like markup language designed for blog posts description: A library and executable that implement a modified, extended version of Markdown designed for writing blog posts. license: AGPL-3 license-file: LICENSE author: Alex Becker maintainer: acbecker@uchicago.edu+homepage: https://blogdown.io copyright: (c) 2017 Alex Becker category: Web-build-type: Simple-extra-source-files:- Readme.html- ChangeLog.md- Readme.md-data-files: assets/footnotes.css, assets/footnotes.js+build-type: Custom+extra-source-files: ChangeLog.md, Readme.md+data-files: assets/Footnotes.css, assets/Footnotes.js cabal-version: >=1.10 library exposed-modules: Parsing.Parse, Rendering.Render, Rendering.RenderOptions- other-modules: AST, Parsing.ParseBlock, Parsing.ParseInline, Parsing.Text, Parsing.Utils, Parsing.ParseFootnotes, Parsing.ParseHtml, Parsing.State, Parsing.TextUtils, Paths_Blogdown- other-extensions: CPP, DeriveGeneric- build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5- hs-source-dirs: src+ other-modules: AST, Parsing.ParseBlock, Parsing.ParseInline, Parsing.Text, Parsing.Utils, Parsing.ParseFootnotes, Parsing.ParseHtml, Parsing.State, Parsing.TextUtils+ other-extensions: DeriveGeneric+ build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5, network-uri >=2.6 && <2.7+ hs-source-dirs: src, assets default-language: Haskell2010- cpp-options: -DCABAL executable Blogdown main-is: Blogdown.hs- other-extensions: CPP, DeriveGeneric- build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5- hs-source-dirs: src+ other-extensions: DeriveGeneric+ build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5, network-uri >=2.6 && <2.7+ hs-source-dirs: src, assets default-language: Haskell2010- cpp-options: -DCABAL test-suite Test type: exitcode-stdio-1.0 main-is: Test.hs- other-extensions: CPP, DeriveGeneric- build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5- hs-source-dirs: src, test+ other-extensions: DeriveGeneric+ build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5, network-uri >=2.6 && <2.7+ hs-source-dirs: src, assets, test default-language: Haskell2010- cpp-options: -DCABAL +benchmark Benchmark+ type: exitcode-stdio-1.0+ main-is: Benchmark.hs+ other-extensions: DeriveGeneric+ build-depends: base >=4.9 && <4.10, parsec >=3.1 && <3.2, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5, criterion >=1.1 && <1.2, network-uri >=2.6 && <2.7+ hs-source-dirs: src, assets, test+ default-language: Haskell2010+ source-repository Head type: git location: https://github.com/alexbecker/blogdown++custom-setup+ setup-depends: base >= 4.9 && <4.10, Cabal >=1.24 && <1.25, MissingH >=1.4 && <1.5
ChangeLog.md view
@@ -1,5 +1,20 @@ # Revision history for Blogdown +## 0.2.0 -- 2017-05-21++* Add image support.+* Add nested list support.+* Allow implicit link hrefs.+* Support HTML bleaching.+* Abort parsing script or style tags unless --allow-unsafe-tags is passed.+* Build assets at compile time instead of accessing them at run time.++### 0.1.1 -- 2017-04-10++* Allow overriding the directory for assets via environment variable.+* Bug fix in footnote parsing.+* Update Readme.md and make it display on Hackage correctly.+ ## 0.1.0 -- 2017-04-02 * Released as a Cabal package.
− Readme.html
@@ -1,189 +0,0 @@-<p><i>Note: If you are viewing this Readme on GitHub, its Blogdown-specific features will not render correctly.-The Blogdown-formatted output is in Readme.html.</i></p>-<h1>Blogdown</h1>-<p>Blogdown is a markup language based on Markdown, designed for writing blog posts.-Blogdown's goals are:</p>-<ul><li>Clean syntax for common blog post features absent from Markdown.</li>-<li>Ability to handle untrusted input.</li>-<li>Simple syntax, with no surprises.</li>-<li>Debuggability.</li>-<li>Near compatibility with common Markdown implementations.</li>-</ul>-<p>Because there is no Markdown standard and existing Markdown implementations-<a href="http://johnmacfarlane.net/babelmark2/?text=Hello+world%0A*+this+is+a+list%0A%3E+this+is+a+quote">disagree wildly even on simple cases</a>,-Blogdown cannot be 100% compatible with even a majority of Markdown implementations.-While there have been attemps to create a common Markdown standard—most notably <a href="http://commonmark.org/">CommonMark</a>—they-are necessarily quite complex. The primary cause of this complexity is that Markdown insists on rendering <i>something</i> for every input,-no matter how malformed. Blogdown is considerably simpler, and hopefully easier for authors to debug, because it fails on malformed inputs.-With full compatability out of the window, I have chosen to make some other small improvements on Markdown syntax.</p>-<h2>Installation</h2>-<h3>With Cabal or Stack</h3>-<p>The recommended way to install any Haskell project is using <a href="https://www.haskell.org/cabal/">Cabal</a> or <a href="https://docs.haskellstack.org/en/stable/README/">Stack</a>.-With these tools, you can simply run <code>cabal install</code> or <code>stack build</code> respectively.</p>-<h3>Without Haskell Tooling</h3>-<p>Because configuring Cabal and Stack can be tricky for Haskell beginners, Blogdown supports installation without any Haskell tooling.</p>-<p>First, install <a href="https://www.haskell.org/ghc/">GHC</a>, <a href="https://hackage.haskell.org/package/parsec">Parsec</a> and <a href="https://hackage.haskell.org/package/MissingH">MissingH</a>,-all of which are available through common Linux package managers.-Then run <code>ghc -isrc -o Blogdown src/Blogdown.hs</code> in the repository's base directory.</p>-<h2>Usage</h2>-<p>The <code>Blogdown</code> binary reads from <code>stdin</code> and writes to <code>stdout</code>. Typical usage looks like:</p>-<pre><code>cat blogpost.md | ./Blogdown > blogpost.html-</code></pre>-<h3>Optional Styling and Scripts</h3>-<p>It is recommended to include <code>footnotes.css</code> and <code>footnotes.js</code> on any pages which make use of Blogdown-generated footnotes,-which improve the appearance of footnotes and allow them to be shown inline.-These can be inlined using the <code>--inline-css</code> and <code>--inline-js</code> flags respectively<sup><a href="#-footnote-0" id="a--footnote-0">[0]</a></sup>.</p>-<h3>Optional Flags</h3>-<p><code>Blogdown</code> accepts the following long-style flags:</p>-<ul><li><code>--footnote-prefix</code>: Defines a prefix for the <code>id</code>s of footnotes. Recommended if multiple output files are included in a single HTML page, to avoid <code>id</code> collisions.</li>-<li><code>--footnote-index-from</code>: The index from which footnotes are numbered. Defaults to 0.</li>-<li><code>--footnote-backlinks</code>: If this flag is passed, footnotes will be preceded by a caret linking back to the point where the footnote is referenced.</li>-<li><code>--em-dashes</code>: If this flag is passed, <code>--</code> will be replaced with "—" in text.</li>-<li><code>--inline-css</code>: If this flag is passed, the recommended CSS will be inlined at the end of the output document.</li>-<li><code>--inline-js</code>: If this flag is passed, the recommended JS will be inlined at the end of the output document.</li>-</ul>-<h2>Syntax</h2>-<h3>Differences from Markdown</h3>-<p>Most of the syntax of Blogdown should be familiar to Markdown users, but some new syntax has been added, and some existing syntax has changed.</p>-<h4>New Features</h4>-<p>Blogdown adds footnote support to Markdown.-Footnotes can be referenced inline with ^[<i>footnote-name</i>], which will render as a superscript link to a <i>footnote-definition</i>-at the end of the document, which is defined by ~[<i>footnote-name</i>] followed by the footnote contents.</p>-<h4>Markdown Incompatibilities</h4>-<p>Blogdown does not support the Markdown syntax of underlining text with <code>=</code> or <code>-</code> characters to define a header,-as this comes at a large cost in the parser implementation<sup><a href="#-footnote-1" id="a--footnote-1">[1]</a></sup>.-The <code>#</code> syntax for headers is supported instead.</p>-<p>It also does not support using multiple trailing spaces to force a breakpoint at the end of a line.-The <code><br/></code> tag is supported instead.</p>-<p>The <code>~</code> and <code>^</code> characters are now special, and must be escaped to be used in text.-Additionally, while most Markdown implementations do not require escaping many special characters when their special meaning would-not be valid, Blogdown always requires they be escaped.</p>-<h3>Formal Description</h3>-<p>The body of a Blogdown document consists of a sequence of <i>block nodes</i>, which in turn consist of <i>inline nodes</i>.</p>-<h4>Block Nodes</h4>-<p>Block nodes can contain any sequence of inline nodes, with the exception of code and HTML blocks, whose contents are rendered verbatim.-Block nodes can span multiple lines and are terminated by a blank line, the beginning of another type of block, or the end of the document.</p>-<p>The following block node types are supported:</p>-<ul><li><b>Paragraph</b>: The default block type; any content not in another block is part of a paragraph.-Paragraphs must be separated by a blank line.-Can contain arbitrary inline nodes.</li>-<li><b>Header</b>: 1-6 <code>#</code> characters at the beginning of a line begins a header, with the number of <code>#</code> characters determining the header level.-Can contain arbitrary inline nodes.</li>-<li><b>Ordered Lists</b>: A <code> - </code> begins an ordered list item, which itself is a block.-Sequential ordered list items form an ordered list.-Can contain arbitrary inline nodes.</li>-<li><b>Unordered Lists</b>: A <code> * </code> begins an unordered list item, which itself is a block.-Sequential unordered list items form an unordered list.-Can contain arbitrary inline nodes.</li>-<li><b>Blockquote</b>: Lines beginning with <code>> </code> define a blockquote.-Can contain arbitrary inline nodes.-Note that the first line not beginning with <code>> </code> will start a new block.</li>-<li><b>Code Block</b>: Lines indented with 4+ spaces or a tab define a code block.-Code blocks are rendered verbatim, ignoring special characters.-Note that the first un-indented line will start a new block.</li>-<li><b>HTML Block</b>: An HTML tag at the beginning of a line starts an HTML block.-Its contents must be valid HTML, and it is ended by the corresponding closing tag.-HTML blocks are rendered verbatim, unless HTML bleaching is enabled.</li>-<li><b>Hard Rule</b>: A line consisting of 3+ <code>-</code> defines a hard rule.</li>-<li><b>Table</b>: A <code>|</code>character at the beginning of a line begins a table row, consisting of table cells separated by <code>|</code> characters.-The cells are themselves blocks, and as such can contain newlines. The rows are terminated by a <code>|</code> followed by a newline.-By default the table has only a body, but if rows are separated by an alternating string of <code>+</code> and multiple <code>-</code> characters,-e.g. <code>+---+---+</code>, then every row above the separator will be in the header and every row below will be in the body.-Optionally the table may start and end with such a separator as well.</li>-</ul>-<h4>Inline Nodes</h4>-<p>Inline nodes can generally contain a sequence of other inline nodes, but cannot contain nodes of the same type.-Despite the name, inline nodes can span multiple lines, e.g. to accomodate line length limits.</p>-<p>The following inline node types are supported:</p>-<ul><li><b>Plaintext</b>: The default inline type; any text not in another inline node is plaintext. Rendered verbatim.</li>-<li><b>Italic</b>: Surrounding text with <code>*</code> <i>italicizes</i> it. Italic nodes can contain any other type of inline node.</li>-<li><b>Bold</b>: Surrounding text with <code>**</code> <b>bolds</b> it. Bold nodes can contain any other type of inline node.</li>-<li><b>Code</b>: Surrounding text with <code>`</code> renders it as <code>code</code>. The content is rendered verbatim.</li>-<li><b>Link</b>: A <a href="#">link</a> is written as [<i>text</i>](<i>href</i>). The <i>text</i> portion can contain any other type of inline node.-The <i>href</i> portion is the link destination, and is parsed verbatim except that any literal <code>(</code> or <code>)</code> must be escaped.</li>-<li><b>Footnote Reference</b>: Writing ^[<i>footnote-name</i>] defines a footnote reference.-It is rendered as a superscript footnote number<sup><a href="#-footnote-2" id="a--footnote-2">[2]</a></sup>, and links to the footnote named <i>footnote-name</i>-if it is present in the footer.</li>-</ul>-<h4>Footer</h4>-<p>A Blogdown document may optionally include a footer after the body.-The footer consists of a sequence of <i>footnote definitions</i>, each of which begins on a new line with ~[<i>footnote-name</i>] and consists of an arbitrary sequence of blocks.-A footnote definition is only terminated by another footnote definition or the end of the document.</p>-<h3>Escaping</h3>-<p>Any character (special or not) can be escaped with <code>\</code>. For a literal backslash, use <code>\\</code>.-A backslash before a newline acts as a continuation character.</p>-<h2>Planned improvements</h2>-<ul><li>Nested lists</li>-<li>Better error messages on parse failures</li>-<li>Windows support</li>-<li>Better tests</li>-<li>Document building & running tests</li>-<li>Comments</li>-</ul>-<hr/>-<ol start="0" class="footnotes"><li id="-footnote-0"><p>Inlining CSS and JS is not recommended if you will be rendering multiple Blogdown documents on a single page, e.g. multiple blog posts on a blog.-Doing so will degrade network and browser performance slightly.</p></li>-<li id="-footnote-1"><p>Supporting underlines for headers requires the parser to look-ahead arbitrarily far, resulting in quadratic time complexity.</p></li>-<li id="-footnote-2"><p>Footnotes are auto-numbered in order of appearance, starting from 0 by default (this can be changed by passing the <code>--footnote-index-from</code> flag).</p></li>-</ol>-<style>.footnotes > li {- margin: 15px 0;-}--/* Keeps the back-link on the same line as the first block. */-.footnotes > li > *:nth-child(2) {- display: inline;-}--.inline-footnote {- margin: .5em;- padding: .5em;- border-left: 2px solid #555;-}--.inline-footnote > p {- margin: 0;-}-</style>-<script>function inlineFootnote(footnote) {- var ref = document.getElementById("a-" + footnote.id);- var inline = document.createElement("div");- for (var i=0; i<footnote.children.length;) {- var child = footnote.children[i];- if (child.tagName == "A" && child.getAttribute("href") == "#" + ref.id) {- i++;- continue;- }- inline.appendChild(child);- }- inline.className = "inline-footnote";- inline.style.display = "none";- ref.parentNode.parentNode.insertBefore(inline, ref.parentNode.nextSibling);- ref.origIndex = ref.textContent;- ref.expanded = false;- ref.addEventListener("click", function (e) {- e.preventDefault();- if (ref.expanded) {- inline.style.display = "none";- ref.textContent = ref.origIndex;- } else {- inline.style.display = "block";- ref.textContent = "X";- }- ref.expanded = !ref.expanded;- });-}--function inlineFootnotes() {- var footnoteLists = document.getElementsByClassName("footnotes");- while (footnoteLists.length > 0) {- var footnotes = footnoteLists[0].children;- for (var j=0; j<footnotes.length; j++) {- inlineFootnote(footnotes[j]);- }- footnoteLists[0].remove();- }-}--inlineFootnotes()-</script>
Readme.md view
@@ -1,7 +1,7 @@ *Note: If you are viewing this Readme on GitHub, its Blogdown-specific features will not render correctly.-The Blogdown-formatted output is in Readme.html.*+The Blogdown-formatted output is in `test/goldens/Readme.html`.* -# Blogdown+# [Blogdown](https://blogdown.io) Blogdown is a markup language based on Markdown, designed for writing blog posts. Blogdown's goals are:@@ -32,7 +32,8 @@ First, install [GHC](https://www.haskell.org/ghc/), [Parsec](https://hackage.haskell.org/package/parsec) and [MissingH](https://hackage.haskell.org/package/MissingH), all of which are available through common Linux package managers.-Then run `ghc -isrc -o Blogdown src/Blogdown.hs` in the repository's base directory.+To compile static assets into Haskell files, run `ghci Setup.hs` and manually invoke `compileStaticFiles`.+Then run `ghc -isrc -iassets -o Blogdown src/Blogdown.hs` in the repository's base directory. ## Usage @@ -49,10 +50,20 @@ ### Optional Flags `Blogdown` accepts the following long-style flags:- * `--footnote-prefix`: Defines a prefix for the `id`s of footnotes. Recommended if multiple output files are included in a single HTML page, to avoid `id` collisions.- * `--footnote-index-from`: The index from which footnotes are numbered. Defaults to 0.- * `--footnote-backlinks`: If this flag is passed, footnotes will be preceded by a caret linking back to the point where the footnote is referenced.+ * `--allowed-tags`: Specifies a comma-separated list of HTML tags which should be+rendered faithfully. All other tags are escaped, e.g. `<a>` becomes `&lt;a&gt;`.+If no list is supplied, all tags are escaped.+ * `--allowed-attributes`: Specifies a comma-separated list of HTML attributes which+should be rendered faithfully. Any other attributes will be stripped from tags when+they are rendered. If no list is supplied, all attributes are stripped.+ * `--allow-unsafe-tags`: By default, Blogdown will fail when it encounters a `<script>`+or a `<style>` tag, because there are certain corner cases it cannot parse correctly,+e.g. `<style>"</style>"evil()"<style>"</style>`. However, these are unlikely on+non-malicious input, so this flag can be passed to attempt parsing these tags. * `--em-dashes`: If this flag is passed, `--` will be replaced with "—" in text.+ * `--footnote-backlinks`: If this flag is passed, footnotes will be preceded by a caret linking back to the point where the footnote is referenced.+ * `--footnote-index-from`: The index from which footnotes are numbered. Defaults to 0.+ * `--footnote-prefix`: Defines a prefix for the `id`s of footnotes. Recommended if multiple output files are included in a single HTML page, to avoid `id` collisions. * `--inline-css`: If this flag is passed, the recommended CSS will be inlined at the end of the output document. * `--inline-js`: If this flag is passed, the recommended JS will be inlined at the end of the output document. @@ -77,10 +88,42 @@ It also does not support using multiple trailing spaces to force a breakpoint at the end of a line. The `<br/>` tag is supported instead. -The `\~` and `\^` characters are now special, and must be escaped to be used in text.+While tables are not a feature of base Markdown, some common Markdown implementations+such as [Github Flavored Markdown](https://guides.github.com/features/mastering-markdown/#GitHub-flavored-markdown)+support them. Blogdown also supports tables, but its implementation is slightly different+from Github's, requiring `|` characters at the start and end of a row and using `+`+instead of `|` in the separator between the (optional) table header and table body.++Since Blogdown introduces new syntax, some valid Markdown will require escaping to render as expected in Blogdown. Additionally, while most Markdown implementations do not require escaping many special characters when their special meaning would not be valid, Blogdown always requires they be escaped. +### HTML Embedding++Like most Markdown implementations, Blogdown documents can have HTML embedded inside them.+However, Blogdown allows only a limited subset of HTML, specifically+[XHTML](https://www.w3.org/TR/xhtml1),+with the exceptions that unknown tags are permitted, and that any tag+is allowed to be self-closing^[arbitrary-tags].+By default Blogdown will not allow `<script>` or `<style>` tags, since parsing+for these is very complex and not fully implemented. However, when parsing trusted+content it is generally safe to use `--allow-unsafe-tags` to attempt to allow+these anyway.++Note also that any content within an HTML node is rendered verbatim, so Blogdown features+cannot be used inside HTML nodes.++#### HTML Bleaching++If using Blogdown to parse *untrusted* content (such as comments on a blog),+the `--allowed-tags` and `--allowed-attributes` flags **must** be used to restrict what+HTML can be rendered in the output. Generally these flags should be used without+without arguments, bleaching all HTML. If you must allow some HTML, you should only+allow tags and attributes which are necessary for your use case and which you understand+the security implications of.++The `--allow-unsafe-tags` **must not** with untrusted content.+ ### Formal Description The body of a Blogdown document consists of a sequence of *block nodes*, which in turn consist of *inline nodes*.@@ -97,11 +140,15 @@ * **Header**: 1-6 `#` characters at the beginning of a line begins a header, with the number of `#` characters determining the header level. Can contain arbitrary inline nodes. * **Ordered Lists**: A ` - ` begins an ordered list item, which itself is a block.-Sequential ordered list items form an ordered list.-Can contain arbitrary inline nodes.+Sequential ordered list items or sublists form an ordered list.+List items can contain arbitrary inline nodes.+ * Sublists are created when list items begin with one more space than their parent list, and can be ordered or unordered.+For example, this sublist begins with ` * `. * **Unordered Lists**: A ` * ` begins an unordered list item, which itself is a block.-Sequential unordered list items form an unordered list.-Can contain arbitrary inline nodes.+Sequential unordered list items or sublists form an unordered list.+List items can contain arbitrary inline nodes.+ - Sublists are created when list items begin with one more space than their parent list, and can be ordered or unordered.+For example, this sublist begins with ` - `. * **Blockquote**: Lines beginning with `> ` define a blockquote. Can contain arbitrary inline nodes. Note that the first line not beginning with `> ` will start a new block.@@ -121,15 +168,18 @@ #### Inline Nodes Inline nodes can generally contain a sequence of other inline nodes, but cannot contain nodes of the same type.-Despite the name, inline nodes can span multiple lines, e.g. to accomodate line length limits.+Despite the name, inline nodes can span multiple lines, e.g. to accommodate line length limits. The following inline node types are supported: * **Plaintext**: The default inline type; any text not in another inline node is plaintext. Rendered verbatim. * **Italic**: Surrounding text with `*` *italicizes* it. Italic nodes can contain any other type of inline node. * **Bold**: Surrounding text with `**` **bolds** it. Bold nodes can contain any other type of inline node. * **Code**: Surrounding text with `\`` renders it as `code`. The content is rendered verbatim.- * **Link**: A [link](#) is written as \[*text*\]\(*href*\). The *text* portion can contain any other type of inline node.+ * **Link**: A [link](#) is written as \[*text*\](*href*). The *text* can contain any other type of inline node.+Note that the (*href*) portion can be omitted entirely if *text* is a valid absolute URI (including scheme). The *href* portion is the link destination, and is parsed verbatim except that any literal `(` or `)` must be escaped.+ * **Image**: A image is written as \!\[*alt*\](*src*). The *alt* and *src* values are parsed verbatim except that any literal+`[` or `]` in the *alt* value and `(` or `)` in the *src* value must be escaped. * **Footnote Reference**: Writing \^\[*footnote-name*\] defines a footnote reference. It is rendered as a superscript footnote number^[footnote-numbering], and links to the footnote named *footnote-name* if it is present in the footer.@@ -146,18 +196,16 @@ A backslash before a newline acts as a continuation character. ## Planned improvements- * Nested lists * Better error messages on parse failures * Windows support- * Better tests- * Document building & running tests * Comments ----- ~[inline] Inlining CSS and JS is not recommended if you will be rendering multiple Blogdown documents on a single page, e.g. multiple blog posts on a blog. Doing so will degrade network and browser performance slightly. ~[underline-parser-complexity] Supporting underlines for headers requires the parser to look-ahead arbitrarily far, resulting in quadratic time complexity.++~[arbitrary-tags] Arbitrary tags are allowed for ease of implementation,+although they are also potentially useful, e.g. for Angular support. ~[footnote-numbering] Footnotes are auto-numbered in order of appearance, starting from 0 by default (this can be changed by passing the `--footnote-index-from` flag).
Setup.hs view
@@ -1,2 +1,24 @@+import Data.List+import Data.List.Utils (replace)+import Data.Maybe (fromJust) import Distribution.Simple-main = defaultMain+import Distribution.Simple.Setup++main = defaultMainWithHooks simpleUserHooks { preBuild=preBuild' }++preBuild' a b = compileStaticFiles >> preBuild simpleUserHooks a b++compileStaticFiles :: IO ()+compileStaticFiles = mapM_ compileStaticFile [+ "assets/Footnotes.js",+ "assets/Footnotes.css"]++compileStaticFile :: FilePath -> IO ()+compileStaticFile filepath = do+ let out = replace "." "_" filepath ++ ".hs"+ let moduleName = takeWhile (/= '.') $ fromJust $ stripPrefix "assets/" out+ rawContent <- readFile filepath+ let escaped = (replace "\"" "\\\"" $ intercalate "\\n" $ lines rawContent) ++ "\\n"+ let variable = "content = \"" ++ escaped ++ "\""+ let hsContent = "module " ++ moduleName ++ " where\n" ++ variable+ writeFile out hsContent
+ assets/Footnotes.css view
@@ -0,0 +1,18 @@+.footnotes > li {+ margin: 15px 0;+}++/* Keeps the back-link on the same line as the first block. */+.footnotes > li > *:nth-child(2) {+ display: inline;+}++.inline-footnote {+ margin: .5em;+ padding: .5em;+ border-left: 2px solid #555;+}++.inline-footnote > p {+ margin: 0;+}
+ assets/Footnotes.js view
@@ -0,0 +1,41 @@+function inlineFootnote(footnote) {+ var ref = document.getElementById("a-" + footnote.id);+ var inline = document.createElement("div");+ for (var i=0; i<footnote.children.length;) {+ var child = footnote.children[i];+ if (child.tagName == "A" && child.getAttribute("href") == "#" + ref.id) {+ i++;+ continue;+ }+ inline.appendChild(child);+ }+ inline.className = "inline-footnote";+ inline.style.display = "none";+ ref.parentNode.parentNode.insertBefore(inline, ref.parentNode.nextSibling);+ ref.origIndex = ref.textContent;+ ref.expanded = false;+ ref.addEventListener("click", function (e) {+ e.preventDefault();+ if (ref.expanded) {+ inline.style.display = "none";+ ref.textContent = ref.origIndex;+ } else {+ inline.style.display = "block";+ ref.textContent = "X";+ }+ ref.expanded = !ref.expanded;+ });+}++function inlineFootnotes() {+ var footnoteLists = document.getElementsByClassName("footnotes");+ while (footnoteLists.length > 0) {+ var footnotes = footnoteLists[0].children;+ for (var j=0; j<footnotes.length; j++) {+ inlineFootnote(footnotes[j]);+ }+ footnoteLists[0].remove();+ }+}++inlineFootnotes()
− assets/footnotes.css
@@ -1,18 +0,0 @@-.footnotes > li {- margin: 15px 0;-}--/* Keeps the back-link on the same line as the first block. */-.footnotes > li > *:nth-child(2) {- display: inline;-}--.inline-footnote {- margin: .5em;- padding: .5em;- border-left: 2px solid #555;-}--.inline-footnote > p {- margin: 0;-}
− assets/footnotes.js
@@ -1,41 +0,0 @@-function inlineFootnote(footnote) {- var ref = document.getElementById("a-" + footnote.id);- var inline = document.createElement("div");- for (var i=0; i<footnote.children.length;) {- var child = footnote.children[i];- if (child.tagName == "A" && child.getAttribute("href") == "#" + ref.id) {- i++;- continue;- }- inline.appendChild(child);- }- inline.className = "inline-footnote";- inline.style.display = "none";- ref.parentNode.parentNode.insertBefore(inline, ref.parentNode.nextSibling);- ref.origIndex = ref.textContent;- ref.expanded = false;- ref.addEventListener("click", function (e) {- e.preventDefault();- if (ref.expanded) {- inline.style.display = "none";- ref.textContent = ref.origIndex;- } else {- inline.style.display = "block";- ref.textContent = "X";- }- ref.expanded = !ref.expanded;- });-}--function inlineFootnotes() {- var footnoteLists = document.getElementsByClassName("footnotes");- while (footnoteLists.length > 0) {- var footnotes = footnoteLists[0].children;- for (var j=0; j<footnotes.length; j++) {- inlineFootnote(footnotes[j]);- }- footnoteLists[0].remove();- }-}--inlineFootnotes()
src/AST.hs view
@@ -12,9 +12,13 @@ } deriving (Show) -data ListItem = ListItem Bool [Inline]+data ListItem = ListItem [Inline]+ | SubList List deriving (Show) +data List = List Bool [ListItem]+ deriving (Show)+ data TableCell = TableHeaderCell [Inline] | TableBodyCell [Inline] deriving (Show)@@ -25,8 +29,7 @@ data Block = HardRule | Paragraph [Inline] | Header Int [Inline]- | OrderedList [ListItem]- | UnorderedList [ListItem]+ | ListBlock List | BlockQuote [Inline] | BlockCode String | BlockHtml Html@@ -45,6 +48,10 @@ | Link { text :: [Inline], href :: String+}+ | Image {+ alt :: String,+ src :: String } deriving (Show)
src/Blogdown.hs view
@@ -1,11 +1,11 @@ module Main where +import Options import Parsing.Parse import Rendering.Render-import Rendering.RenderOptions main :: IO () main = do- renderOptions <- getRenderOptions+ (parseOptions, renderOptions) <- getOptions input <- getContents- either (putStrLn . show) (putStr . toHtml renderOptions) $ parse input+ either (putStrLn . show) (putStr . toHtml renderOptions) $ parse parseOptions input
src/Parsing/Parse.hs view
@@ -3,9 +3,10 @@ import Text.Parsec hiding (parse) import AST-import Parsing.State+import Parsing.ParseOptions (ParseOptions) import Parsing.ParseBlock import Parsing.ParseFootnotes+import Parsing.State ast :: Parser AST ast = do@@ -14,5 +15,5 @@ eof return $ AST blocks footnotes -parse :: String -> Either ParseError AST-parse = runParser ast initialState ""+parse :: ParseOptions -> String -> Either ParseError AST+parse parseOptions = runParser ast (initialState {options=parseOptions}) ""
src/Parsing/ParseBlock.hs view
@@ -26,17 +26,27 @@ text <- many1 inline return $ Header (length hashes) text -listItem :: Bool -> Parser ListItem-listItem ordered = fmap (ListItem ordered) $ do- let identifier = if ordered then " - " else " * "- (try $ string' identifier) <?> ("\"" ++ identifier ++ "\" (list item)")- many1 $ inline+listItem :: Bool -> Int -> Parser ListItem+listItem ordered depth = fmap ListItem $ do+ let identifier = replicate depth ' ' ++ if ordered+ then "- "+ else "* "+ let errMsg = "\"" ++ identifier ++ "\" " ++ if ordered+ then "(ordered list item)"+ else "(unordered list item)"+ try (string' identifier) <?> errMsg+ many1 inline -orderedList :: Parser Block-orderedList = fmap OrderedList $ many1 $ listItem True+list :: Bool -> Int -> Parser List+list ordered depth = do+ first <- listItem ordered depth+ remainder <- many (listItem ordered depth+ <|> fmap SubList (list True (depth + 1))+ <|> fmap SubList (list False (depth + 1)))+ return $ List ordered $ first : remainder -unorderedList :: Parser Block-unorderedList = fmap UnorderedList $ many1 $ listItem False+listBlock :: Parser Block+listBlock = fmap ListBlock (list True 1 <|> list False 1) blockQuoteLineStart :: Parser String blockQuoteLineStart = try (string "> ") <?> "\"> \" (blockquote)"@@ -61,7 +71,7 @@ tableSeparator :: Parser () tableSeparator = optional $ do- sepBy1 (char '+' <?> "\"+\" (table)") (optionMaybe (char ' ') >> many1 (char '-') >> optionMaybe (char ' '))+ sepBy1 (char '+' <?> "\"+\" (table)") $ many1 (char '-') char' '\n' table :: Parser Block@@ -80,4 +90,7 @@ return $ Table headerRows bodyRows block :: Parser Block-block = (many $ char '\n') >> choice [blockHtml, hardRule, header, orderedList, unorderedList, blockQuote, table, blockCode, paragraph]+block = between+ (many $ char '\n')+ (many $ char '\n')+ (choice [blockHtml, hardRule, header, listBlock, blockQuote, table, blockCode, paragraph])
src/Parsing/ParseHtml.hs view
@@ -1,11 +1,17 @@ module Parsing.ParseHtml (html) where +import Data.Char (toLower) import Text.Parsec import AST+import Parsing.ParseOptions (allowUnsafeTags) import Parsing.State import Parsing.Utils +unsafeTags = ["script", "style"]+unsafeTagErr = " tags cannot safely be parsed\n\+ \pass --allow-unsafe-tags to try anyway"+ htmlTag :: HtmlTagType -> Parser HtmlTag htmlTag tagType = do if tagType == Close@@ -13,11 +19,15 @@ else string "<" <?> "\"<\" (html tag)" spaces tagname <- many1 (letter <?> "rest of tag name") <?> "html tag name"+ let lowerTagname = map toLower tagname+ state <- getState+ let allowUnsafe = allowUnsafeTags $ options state+ failWithIf (lowerTagname ++ unsafeTagErr) (not allowUnsafe && elem lowerTagname unsafeTags) attrs <- many attr if tagType == SelfClosing then try (string "/>") <?> "closing \"/>\" (self-closing html tag)" else string ">" <?> "closing \">\" (html tag)"- return $ HtmlTag {tagname=tagname, attrs=attrs}+ return $ HtmlTag {tagname=lowerTagname, attrs=attrs} htmlContent :: Parser (Either String Html) htmlContent = fmap Left (many1 $ noneOf "<") <|> fmap Right html
src/Parsing/ParseInline.hs view
@@ -1,6 +1,7 @@ module Parsing.ParseInline (inline) where import Data.Maybe+import Network.URI (isURI) import Text.Parsec import qualified Data.Map.Strict as M @@ -46,26 +47,39 @@ identifier <- betweenWithErrors' "^[" "]" "footnote reference" $ many1 $ escapableNoneOf "[]" state <- getState let f = footnoteIndices state- let maybeIndex = M.lookup identifier f- if isJust maybeIndex- then fail $ "repeated footnote identifier: " ++ (show $ fromJust maybeIndex)+ if M.member identifier f+ then fail $ "repeated footnote identifier: " ++ identifier else return () let index = M.size f let f' = M.insert identifier index f putState $ state {footnoteIndices=f'} return $ FootnoteRef index +image :: Parser Inline+image = do+ alt <- betweenWithErrors' "![" "]" "image" $ many1 $ escapableNoneOf "[]"+ src <- betweenWithErrors' "(" ")" "image src" $ many $ escapableNoneOf "()"+ return $ Image {alt=alt, src=src}+ link :: Parser Inline link = do state <- getState let currentParserStack = inlineParserStack state- lookAhead (char '[' <?> "\"[\" (link text)")+ lookAhead (char '[' <?> "\"[\" (link)") if elem "link" currentParserStack then fail "links cannot be nested" else return ()- text <- betweenWithErrors' "[" "]" "link text" $ withModifiedState (many1 inline) $ \s -> s {inlineParserStack=("link" : currentParserStack)}- href <- betweenWithErrors' "(" ")" "link href" $ many $ escapableNoneOf "()"- return $ Link {text=text, href=href}+ text <- betweenWithErrors' "[" "]" "link" $ withModifiedState (many1 inline) $ \s -> s {inlineParserStack=("link" : currentParserStack)}+ href <- optionMaybe $ betweenWithErrors' "(" ")" "link href" $ many $ escapableNoneOf "()"+ if isJust href+ then return $ Link {text=text, href=fromJust href}+ else do+ let text' = unboxPlaintext text where+ unboxPlaintext [Plaintext p] = p+ unboxPlaintext _ = ""+ if isURI text'+ then return $ Link {text=text, href=text'}+ else fail "link href is required unless link text is a valid absolute URI" inline :: Parser Inline-inline = choice [nestedBold, bold, italics, code, footnoteRef, link, fmap InlineHtml html, fmap Plaintext plaintext]+inline = choice [nestedBold, bold, italics, code, footnoteRef, link, image, fmap InlineHtml html, fmap Plaintext plaintext]
src/Parsing/State.hs view
@@ -3,11 +3,14 @@ import Text.Parsec import qualified Data.Map.Strict as M +import Parsing.ParseOptions+ data ParserState = ParserState { prevCharIsNewline :: Bool, skipPrefix :: Parser String, inlineParserStack :: [String],- footnoteIndices :: M.Map String Int+ footnoteIndices :: M.Map String Int,+ options :: ParseOptions } type Parser = Parsec String ParserState @@ -15,5 +18,6 @@ prevCharIsNewline=False, skipPrefix=string "", inlineParserStack=[],- footnoteIndices=M.fromList []+ footnoteIndices=M.fromList [],+ options=defaultParseOptions }
src/Parsing/Text.hs view
@@ -6,7 +6,8 @@ import Parsing.State import Parsing.Utils -specials = "*`^<>[]|\\"+specials = "*`<>[]|\\"+specialStrings = ["^[", "!["] firstCharSpecials = " \t#~+\n" ++ specials -- Parse a single non-special character, allowing for escaping and continuation.@@ -17,7 +18,12 @@ then do optional $ char '\n' -- continuation anyChar- else noneOf blacklist+ else do+ maybeSpecialStrings <- mapM (\s -> suppressErr $ optionMaybe $ lookAhead $ try $ string s) specialStrings+ let specialStringsFound = catMaybes maybeSpecialStrings+ if length specialStringsFound > 0+ then fail $ "special string sequence \"" ++ head specialStringsFound ++ "\""+ else noneOf blacklist -- Parse one or more non-special characters, allowing for escaping and incorporating the -- rules for special characters at the start of a line. Note that this does not consume
src/Rendering/Render.hs view
@@ -1,37 +1,25 @@-{-# Language CPP #-}- module Rendering.Render (ToHtml, toHtml) where import Data.List import Data.List.Utils-import System.IO.Unsafe+import Data.Maybe (isJust, fromJust) import AST-#ifdef CABAL-import Paths_Blogdown-#endif+import qualified Footnotes_js as JS+import qualified Footnotes_css as CSS import Rendering.RenderOptions class ToHtml a where toHtml :: RenderOptions -> a -> String -dataFileContents :: FilePath -> String-dataFileContents relPath = unsafePerformIO $ do-#ifdef CABAL- newPath <- getDataFileName relPath- readFile newPath-#else- readFile relPath-#endif- optionalJS :: RenderOptions -> String optionalJS r = if (inlineJS r)- then "<script>" ++ dataFileContents "assets/footnotes.js" ++ "</script>\n"+ then "<script>" ++ JS.content ++ "</script>\n" else "" optionalCSS :: RenderOptions -> String optionalCSS r = if (inlineCSS r)- then "<style>" ++ dataFileContents "assets/footnotes.css" ++ "</style>\n"+ then "<style>" ++ CSS.content ++ "</style>\n" else "" instance ToHtml AST where@@ -79,8 +67,7 @@ toHtml _ HardRule = "<hr/>" toHtml r (Paragraph ls) = withTag "p" $ stripEndingNewline $ concatMap (toHtml r) ls toHtml r (Header level text) = withTag ("h" ++ show level) $ stripEndingNewline $ concatMap (toHtml r) text- toHtml r (OrderedList ls) = withTag "ol" $ unlines $ map (toHtml r) ls- toHtml r (UnorderedList ls) = withTag "ul" $ unlines $ map (toHtml r) ls+ toHtml r (ListBlock l) = toHtml r l toHtml r (BlockQuote ls) = withTag "blockquote" $ stripEndingNewline $ concatMap (toHtml r) ls toHtml _ (BlockCode s) = withTag "pre" $ withTag "code" $ escapeHtml s toHtml r (BlockHtml h) = toHtml r h@@ -90,8 +77,13 @@ header = unlines $ map (toHtml r) ths body = unlines $ map (toHtml r) trs +instance ToHtml List where+ toHtml r (List True ls) = withTag "ol" $ unlines $ map (toHtml r) ls+ toHtml r (List False ls) = withTag "ul" $ unlines $ map (toHtml r) ls+ instance ToHtml ListItem where- toHtml r (ListItem _ ls) = withTag "li" $ stripEndingNewline $ concatMap (toHtml r) ls+ toHtml r (ListItem ls) = withTag "li" $ stripEndingNewline $ concatMap (toHtml r) ls+ toHtml r (SubList l) = toHtml r l instance ToHtml TableCell where toHtml r (TableHeaderCell tds) = withTag "th" $ concatMap (toHtml r) tds@@ -113,20 +105,35 @@ else s toHtml r (InlineHtml h) = toHtml r h toHtml r (Link text href) = withTagAttrs "a" [("href", href)] $ concatMap (toHtml r) text--showAttr :: Attr -> String-showAttr (Attr s t) = s ++ "=\"" ++ t ++ "\""--showInnerTag :: HtmlTag -> String-showInnerTag t = unwords (tagname t : (map showAttr $ attrs t))+ toHtml _ (Image alt src) = "<img alt=\"" ++ alt ++ "\" src=\"" ++ src ++ "\"/>" -showHtmlContent :: Either String Html -> String-showHtmlContent (Left s) = s-showHtmlContent (Right h) = showHtml h+instance ToHtml HtmlTag where+ toHtml r (HtmlTag name attrs) = unwords (name : (map showAttr filteredAttrs)) where+ showAttr (Attr s t) = s ++ "=\"" ++ t ++ "\""+ filteredAttrs = maybe attrs (\allowed -> filter (\(Attr name val) -> elem name allowed) attrs) $ allowedAttributes r -showHtml :: Html -> String-showHtml (PairTag open content) = "<" ++ showInnerTag open ++ ">" ++ concatMap showHtmlContent content ++ "</" ++ tagname open ++ ">"-showHtml (SingleTag tag) = "<" ++ showInnerTag tag ++ "/>"+showHtmlContent :: RenderOptions -> Either String Html -> String+showHtmlContent _ (Left s) = s+showHtmlContent r (Right h) = toHtml r h instance ToHtml Html where- toHtml _ = showHtml+ toHtml r (PairTag open content) = concat [+ leftBracket,+ toHtml r open,+ rightBracket,+ concatMap (showHtmlContent r) content,+ leftBracket ++ "/",+ tagname open,+ rightBracket]+ where+ allowTag = maybe True (\attrs -> elem (tagname open) attrs) $ allowedTags r+ leftBracket = if allowTag then "<" else "<"+ rightBracket = if allowTag then ">" else ">"+ toHtml r (SingleTag tag) = concat [+ leftBracket,+ toHtml r tag,+ "/" ++ rightBracket]+ where+ allowTag = maybe True (\attrs -> elem (tagname tag) attrs) $ allowedTags r+ leftBracket = if allowTag then "<" else "<"+ rightBracket = if allowTag then ">" else ">"
src/Rendering/RenderOptions.hs view
@@ -2,8 +2,8 @@ module Rendering.RenderOptions where +import qualified Data.Map.Strict as M import GHC.Generics (Generic)-import System.Environment data RenderOptions = RenderOptions { footnotePrefix :: String,@@ -11,8 +11,10 @@ footnoteBacklinks :: Bool, emDashes :: Bool, inlineCSS :: Bool,- inlineJS :: Bool-} deriving (Generic)+ inlineJS :: Bool,+ allowedTags :: Maybe [String],+ allowedAttributes :: Maybe [String]+} deriving (Show, Generic) defaultRenderOptions = RenderOptions { footnotePrefix = "",@@ -20,18 +22,26 @@ footnoteBacklinks = False, emDashes = False, inlineCSS = False,- inlineJS = False+ inlineJS = False,+ allowedTags = Nothing,+ allowedAttributes = Nothing } -renderOptions :: [String] -> RenderOptions-renderOptions [] = defaultRenderOptions-renderOptions (key : ls) = case key of- "--footnote-prefix" -> (renderOptions $ tail ls) {footnotePrefix=head ls}- "--footnote-index-from" -> (renderOptions $ tail ls) {footnoteIndexFrom=read $ head ls}- "--footnote-backlinks" -> (renderOptions ls) {footnoteBacklinks=True}- "--em-dashes" -> (renderOptions ls) {emDashes=True}- "--inline-css" -> (renderOptions ls) {inlineCSS=True}- "--inline-js" -> (renderOptions ls) {inlineJS=True}+splitCommas :: String -> [String]+splitCommas "" = []+splitCommas s = takeWhile (/= ',') s : splitCommas (dropWhile (/= ',') s) -getRenderOptions :: IO RenderOptions-getRenderOptions = fmap renderOptions getArgs+getSingleArg :: [String] -> String+getSingleArg [] = ""+getSingleArg (x : xs) = x++renderOptions :: M.Map String ([String] -> RenderOptions -> RenderOptions)+renderOptions = M.fromList([+ ("--footnote-prefix", \xs -> \r -> r {footnotePrefix=getSingleArg xs}),+ ("--footnote-index-from", \xs -> \r -> r {footnoteIndexFrom=read $ getSingleArg xs}),+ ("--footnote-backlinks", \_ -> \r -> r {footnoteBacklinks=True}),+ ("--em-dashes", \_ -> \r -> r {emDashes=True}),+ ("--inline-css", \_ -> \r -> r {inlineCSS=True}),+ ("--inline-js", \_ -> \r -> r {inlineJS=True}),+ ("--allowed-tags", \xs -> \r -> r {allowedTags=Just $ splitCommas $ getSingleArg xs}),+ ("--allowed-attributes", \xs -> \r -> r {allowedAttributes=Just $ splitCommas $ getSingleArg xs})])
+ test/Benchmark.hs view
@@ -0,0 +1,20 @@+module Main where++import Criterion.Main+import Data.Either+import Data.String.Utils (replace)++import Parsing.Parse+import Rendering.Render+import Rendering.RenderOptions++parseAndRender :: RenderOptions -> String -> String+parseAndRender options = either show (toHtml options) . parse++main :: IO ()+main = do+ readme <- readFile "Readme.md"+ let readmeWithErrors = replace "](" "]" readme+ defaultMain [bench "Readme.md" $ nf (parseAndRender defaultRenderOptions) readme,+ bench "Readme.md with inlining" $ nf (parseAndRender defaultRenderOptions {inlineJS=True, inlineCSS=True}) readme,+ bench "Readme.md with errors" $ nf (parseAndRender defaultRenderOptions) readmeWithErrors]
test/Test.hs view
@@ -4,6 +4,7 @@ import Text.Parsec import System.Exit +import qualified Options import Parsing.Parse import Parsing.ParseBlock import Parsing.ParseHtml@@ -51,12 +52,20 @@ testFootnoteRef = expectSuccess "footnote reference" inline "^[x]" "<sup><a href=\"#-footnote-0\" id=\"a--footnote-0\">[0]</a></sup>"+testCaret = expectSuccess "literal '^' does not need escaping" inline "^" "^"+testImage = expectSuccess "inline image" inline+ ""+ "<img alt=\"an image\" src=\"/img/0\"/>"+testExclamationMark = expectSuccess "literal '!' does not need escaping" inline "!" "!" testLink = expectSuccess "link" inline "[Google](https://google.com)" "<a href=\"https://google.com\">Google</a>" testLinkWithContents = expectSuccess "link with styling inside" inline "[*Whence* `he` **came**](https://google.com)" "<a href=\"https://google.com\"><i>Whence</i> <code>he</code> <b>came</b></a>"+testLinkImplicit = expectSuccess "link with implicit href" inline+ "[https://google.com]"+ "<a href=\"https://google.com\">https://google.com</a>" testH1 = expectSuccess "h1" header "# hello" "<h1>hello</h1>" testH6 = expectSuccess "h6" header "###### hello" "<h6>hello</h6>" testHardRule = expectSuccess "hard rule" hardRule "---\n" "<hr/>"@@ -74,16 +83,36 @@ \containing '#'\n" "<p>This is a paragraph\n\ \containing '#'</p>"-testOrderedList = expectSuccess "ol" orderedList+testOrderedList = expectSuccess "ol" listBlock " - point 1\n\ \ - point 2\n" "<ol><li>point 1</li>\n\- \<li>point 2</li>\n</ol>"-testUnorderedList = expectSuccess "ul" unorderedList+ \<li>point 2</li>\n\+ \</ol>"+testUnorderedList = expectSuccess "ul" listBlock " * point 1\n\ \ * point 2\n" "<ul><li>point 1</li>\n\- \<li>point 2</li>\n</ul>"+ \<li>point 2</li>\n\+ \</ul>"+testNestedList = expectSuccess "nested list" listBlock+ " - point 1\n\+ \ - point 2\n\+ \ * point 3\n\+ \ * point 4\n\+ \ - point 5\n\+ \ * point 6\n\+ \ - point 7\n"+ "<ol><li>point 1</li>\n\+ \<li>point 2</li>\n\+ \<ul><li>point 3</li>\n\+ \<li>point 4</li>\n\+ \<ol><li>point 5</li>\n\+ \</ol>\n\+ \<li>point 6</li>\n\+ \</ul>\n\+ \<li>point 7</li>\n\+ \</ol>" testBlockQuote = expectSuccess "blockquote" blockQuote "> The politician said that\n\ \> he would fix the economy.\n"@@ -183,6 +212,15 @@ \<ol start=\"0\" class=\"footnotes\"><li id=\"-footnote-0\"><p>This is a single list item\n\ \of footnote.</p></li>\n\ \</ol>\n"+testFootnoteDefTwoLines = expectSuccess "footnote definition, separated by 2 lines" ast+ "^[x]\n\+ \\n\+ \~[x] This is a single list item\n\+ \of footnote.\n"+ "<p><sup><a href=\"#-footnote-0\" id=\"a--footnote-0\">[0]</a></sup></p>\n\+ \<ol start=\"0\" class=\"footnotes\"><li id=\"-footnote-0\"><p>This is a single list item\n\+ \of footnote.</p></li>\n\+ \</ol>\n" testFootnoteDefs = expectSuccess "multiple footnote definitions" ast "^[0]^[1]^[2]\n\ \~[0] a\n\@@ -206,7 +244,7 @@ "a\\\nb" "<p>ab</p>" -expectFailure :: String -> (Parser a) -> String -> String -> IO Bool+expectFailure :: (ToHtml a) => String -> (Parser a) -> String -> String -> IO Bool expectFailure name p input expectedErr = either (\err -> if endswith expectedErr $ show err then do@@ -221,8 +259,10 @@ putStrLn "expect:" putStrLn expectedErr return False)- (\_ -> do+ (\parsed -> do putStrLn $ "FAIL: " ++ name+ putStrLn $ "unexpected success:"+ putStrLn $ toHtml defaultRenderOptions parsed return False) $ runParser p initialState name input @@ -239,8 +279,13 @@ testNestedLink = expectFailure "links cannot be nested" inline "[[a](https://a.com)](https://b.com)" "unexpected \"[\"\n\- \expecting \"**\" (bold), \"*\" (italics), \"`\" (code), \"^[\" (footnote reference) or \"<\" (html tag)\n\+ \expecting \"**\" (bold), \"*\" (italics), \"`\" (code), \"^[\" (footnote reference), \"![\" (image) or \"<\" (html tag)\n\ \links cannot be nested"+testBadImplicitLink = expectFailure "link href required unless text is valid URI" inline+ "[notauri]"+ "unexpected end of input\n\+ \expecting \"(\" (link href)\n\+ \link href is required unless link text is a valid absolute URI" testUnclosedOpeningTag = expectFailure "unclosed opening tag should fail to parse" html "<div" "unexpected end of input\n\@@ -252,15 +297,34 @@ testMismatchedTags = expectFailure "mismatched tags should fail to parse" html "<a>hello</b>" "mismatched tags: 'a' and 'b'"+testScriptTag = expectFailure "script tags unsafe" html+ "<script></script>"+ "script tags cannot safely be parsed\n\+ \pass --allow-unsafe-tags to try anyway"+testStyleTag = expectFailure "style tags unsafe" html+ "<style></style>"+ "style tags cannot safely be parsed\n\+ \pass --allow-unsafe-tags to try anyway"+testBadTableSeparator = expectFailure "incomplete table separator" block+ "+---+---\n\+ \| a | b |"+ "unexpected \"\\n\"\n\+ \expecting \"-\" or \"+\" (table)"+testBadListNesting = expectFailure "incorrectly nested lists" ast+ " * a\n\+ \ * b\n"+ "unexpected \" \"\n\+ \expecting \" - \" (ordered list item) or \" * \" (unordered list item)" goldenTest :: FilePath -> FilePath -> String -> IO Bool goldenTest inFilePath goldenFilePath renderArgs = do- let r = renderOptions $ words renderArgs+ let (p, r) = Options.options $ words renderArgs input <- readFile inFilePath golden <- readFile goldenFilePath either- (\_ -> do+ (\err -> do putStrLn $ "FAIL: " ++ goldenFilePath+ putStrLn $ show err return False) (\parsed -> do let rendered = toHtml r parsed@@ -273,7 +337,7 @@ writeFile failPath rendered putStrLn $ "FAIL: " ++ goldenFilePath return False)- $ runParser ast initialState inFilePath input+ $ runParser ast (initialState {options=p}) inFilePath input main :: IO () main = do@@ -287,6 +351,10 @@ testFootnoteRef, testLink, testLinkWithContents,+ testLinkImplicit,+ testCaret,+ testImage,+ testExclamationMark, testH1, testH6, testHardRule,@@ -296,6 +364,7 @@ testHashInParagraph, testOrderedList, testUnorderedList,+ testNestedList, testBlockQuote, testBlockQuotePreFormatted, testBlockCode,@@ -307,6 +376,7 @@ testTableMinimal, testTableHeaderMinimal, testFootnoteDef,+ testFootnoteDefTwoLines, testFootnoteDefs, testFootnoteOrdering, testContinuation,@@ -314,14 +384,21 @@ testMismatchedBoldItalics, testSwappedItalicsBold, testNestedLink,+ testBadImplicitLink, testUnclosedOpeningTag, testUnclosedTag, testMismatchedTags,- goldenTest "Readme.md" "Readme.html" "--em-dashes --inline-css --inline-js",+ testScriptTag,+ testStyleTag,+ testBadTableSeparator,+ testBadListNesting,+ goldenTest "Readme.md" "test/goldens/Readme.html" "--em-dashes --inline-css --inline-js", goldenTest "test/goldens/golden1.md" "test/goldens/golden1.html" "--em-dashes", goldenTest "test/goldens/golden1.md" "test/goldens/golden1-backlinks.html" "--em-dashes --footnote-backlinks", goldenTest "test/goldens/golden2.md" "test/goldens/golden2.html" "--em-dashes",- goldenTest "test/goldens/golden2.md" "test/goldens/golden2-backlinks.html" "--em-dashes --footnote-backlinks"]+ goldenTest "test/goldens/golden2.md" "test/goldens/golden2-backlinks.html" "--em-dashes --footnote-backlinks",+ goldenTest "test/goldens/bleach.md" "test/goldens/bleach.html" "--allowed-tags span --allowed-attributes class",+ goldenTest "test/goldens/bleach.md" "test/goldens/bleach-all.html" "--allowed-tags --allowed-attributes"] if and results then exitSuccess else exitFailure