+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU AGPL, see
+.
diff --git a/Readme.html b/Readme.html
new file mode 100644
--- /dev/null
+++ b/Readme.html
@@ -0,0 +1,189 @@
+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.
+Blogdown
+Blogdown is a markup language based on Markdown, designed for writing blog posts.
+Blogdown's goals are:
+- Clean syntax for common blog post features absent from Markdown.
+- Ability to handle untrusted input.
+- Simple syntax, with no surprises.
+- Debuggability.
+- Near compatibility with common Markdown implementations.
+
+Because there is no Markdown standard and existing Markdown implementations
+disagree wildly even on simple cases,
+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 CommonMark—they
+are necessarily quite complex. The primary cause of this complexity is that Markdown insists on rendering something 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.
+Installation
+With Cabal or Stack
+The recommended way to install any Haskell project is using Cabal or Stack.
+With these tools, you can simply run cabal install or stack build respectively.
+Without Haskell Tooling
+Because configuring Cabal and Stack can be tricky for Haskell beginners, Blogdown supports installation without any Haskell tooling.
+First, install GHC, Parsec and 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.
+Usage
+The Blogdown binary reads from stdin and writes to stdout. Typical usage looks like:
+cat blogpost.md | ./Blogdown > blogpost.html
+
+Optional Styling and Scripts
+It is recommended to include footnotes.css and footnotes.js 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 --inline-css and --inline-js flags respectively.
+Optional Flags
+Blogdown accepts the following long-style flags:
+--footnote-prefix: Defines a prefix for the ids 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.--em-dashes: If this flag is passed, -- will be replaced with "—" in text.--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.
+Syntax
+Differences from Markdown
+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.
+New Features
+Blogdown adds footnote support to Markdown.
+Footnotes can be referenced inline with ^[footnote-name], which will render as a superscript link to a footnote-definition
+at the end of the document, which is defined by ~[footnote-name] followed by the footnote contents.
+Markdown Incompatibilities
+Blogdown does not support the Markdown syntax of underlining text with = or - characters to define a header,
+as this comes at a large cost in the parser implementation.
+The # syntax for headers is supported instead.
+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.
+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.
+Formal Description
+The body of a Blogdown document consists of a sequence of block nodes, which in turn consist of inline nodes.
+Block Nodes
+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.
+The following block node types are supported:
+- Paragraph: 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.
+- 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.
+- 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.
+- 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.
+- Code Block: 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.
+- HTML Block: 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.
+- Hard Rule: A line consisting of 3+
- defines a hard rule.
+- Table: A
|character at the beginning of a line begins a table row, consisting of table cells separated by | characters.
+The cells are themselves blocks, and as such can contain newlines. The rows are terminated by a | followed by a newline.
+By default the table has only a body, but if rows are separated by an alternating string of + and multiple - characters,
+e.g. +---+---+, 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.
+
+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.
+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.
+The href portion is the link destination, and is parsed verbatim except that any literal
( or ) must be escaped.
+- Footnote Reference: Writing ^[footnote-name] defines a footnote reference.
+It is rendered as a superscript footnote number, and links to the footnote named footnote-name
+if it is present in the footer.
+
+Footer
+A Blogdown document may optionally include a footer after the body.
+The footer consists of a sequence of footnote definitions, each of which begins on a new line with ~[footnote-name] and consists of an arbitrary sequence of blocks.
+A footnote definition is only terminated by another footnote definition or the end of the document.
+Escaping
+Any character (special or not) can be escaped with \. For a literal backslash, use \\.
+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
+
+
+
+
+
diff --git a/Readme.md b/Readme.md
new file mode 100644
--- /dev/null
+++ b/Readme.md
@@ -0,0 +1,163 @@
+*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.*
+
+# Blogdown
+
+Blogdown is a markup language based on Markdown, designed for writing blog posts.
+Blogdown's goals are:
+ * Clean syntax for common blog post features absent from Markdown.
+ * Ability to handle untrusted input.
+ * Simple syntax, with no surprises.
+ * Debuggability.
+ * Near compatibility with common Markdown implementations.
+
+Because there is no Markdown standard and existing Markdown implementations
+[disagree wildly even on simple cases](http://johnmacfarlane.net/babelmark2/?text=Hello+world%0A*+this+is+a+list%0A%3E+this+is+a+quote),
+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 [CommonMark](http://commonmark.org/)--they
+are necessarily quite complex. The primary cause of this complexity is that Markdown insists on rendering *something* 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.
+
+## Installation
+
+### With Cabal or Stack
+
+The recommended way to install any Haskell project is using [Cabal](https://www.haskell.org/cabal/) or [Stack](https://docs.haskellstack.org/en/stable/README/).
+With these tools, you can simply run `cabal install` or `stack build` respectively.
+
+### Without Haskell Tooling
+
+Because configuring Cabal and Stack can be tricky for Haskell beginners, Blogdown supports installation without any Haskell tooling.
+
+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.
+
+## Usage
+
+The `Blogdown` binary reads from `stdin` and writes to `stdout`. Typical usage looks like:
+
+ cat blogpost.md | ./Blogdown > blogpost.html
+
+### Optional Styling and Scripts
+
+It is recommended to include `footnotes.css` and `footnotes.js` 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 `--inline-css` and `--inline-js` flags respectively^[inline].
+
+### 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.
+ * `--em-dashes`: If this flag is passed, `--` will be replaced with "—" in text.
+ * `--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.
+
+## Syntax
+
+### Differences from Markdown
+
+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.
+
+#### New Features
+
+Blogdown adds footnote support to Markdown.
+Footnotes can be referenced inline with \^\[*footnote-name*\], which will render as a superscript link to a *footnote-definition*
+at the end of the document, which is defined by \~\[*footnote-name*\] followed by the footnote contents.
+
+#### Markdown Incompatibilities
+
+Blogdown does not support the Markdown syntax of underlining text with `=` or `-` characters to define a header,
+as this comes at a large cost in the parser implementation^[underline-parser-complexity].
+The `#` syntax for headers is supported instead.
+
+It also does not support using multiple trailing spaces to force a breakpoint at the end of a line.
+The `
` tag is supported instead.
+
+The `\~` and `\^` 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.
+
+### Formal Description
+
+The body of a Blogdown document consists of a sequence of *block nodes*, which in turn consist of *inline nodes*.
+
+#### Block Nodes
+
+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.
+
+The following block node types are supported:
+ * **Paragraph**: 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.
+ * **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.
+ * **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.
+ * **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.
+ * **Code Block**: 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.
+ * **HTML Block**: 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.
+ * **Hard Rule**: A line consisting of 3+ `-` defines a hard rule.
+ * **Table**: A `|`character at the beginning of a line begins a table row, consisting of table cells separated by `|` characters.
+The cells are themselves blocks, and as such can contain newlines. The rows are terminated by a `|` followed by a newline.
+By default the table has only a body, but if rows are separated by an alternating string of `+` and multiple `-` characters,
+e.g. `+---+---+`, 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.
+
+#### 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.
+
+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.
+The *href* portion is the link destination, and is parsed verbatim except that any literal `(` or `)` 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.
+
+#### Footer
+
+A Blogdown document may optionally include a footer after the body.
+The footer consists of a sequence of *footnote definitions*, each of which begins on a new line with \~\[*footnote-name*\] and consists of an arbitrary sequence of blocks.
+A footnote definition is only terminated by another footnote definition or the end of the document.
+
+### Escaping
+
+Any character (special or not) can be escaped with `\\`. For a literal backslash, use `\\\\`.
+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.
+
+~[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).
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/assets/footnotes.css b/assets/footnotes.css
new file mode 100644
--- /dev/null
+++ b/assets/footnotes.css
@@ -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;
+}
diff --git a/assets/footnotes.js b/assets/footnotes.js
new file mode 100644
--- /dev/null
+++ b/assets/footnotes.js
@@ -0,0 +1,41 @@
+function inlineFootnote(footnote) {
+ var ref = document.getElementById("a-" + footnote.id);
+ var inline = document.createElement("div");
+ for (var i=0; i 0) {
+ var footnotes = footnoteLists[0].children;
+ for (var j=0; j Either ParseError AST
+parse = runParser ast initialState ""
diff --git a/src/Parsing/ParseBlock.hs b/src/Parsing/ParseBlock.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/ParseBlock.hs
@@ -0,0 +1,83 @@
+module Parsing.ParseBlock where
+
+import Text.Parsec
+
+import AST
+import Parsing.State
+import Parsing.TextUtils
+import Parsing.Utils
+import Parsing.ParseHtml
+import Parsing.ParseInline
+
+hardRule :: Parser Block
+hardRule = do
+ try (string "---") "\"---\" (hard rule)"
+ many (char '-')
+ many1 (char '\n')
+ return HardRule
+
+paragraph :: Parser Block
+paragraph = fmap Paragraph $ many1 inline
+
+header :: Parser Block
+header = do
+ hashes <- (many1 $ char' '#') "\"#\" (header)"
+ many1 $ oneOf " \t"
+ 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
+
+orderedList :: Parser Block
+orderedList = fmap OrderedList $ many1 $ listItem True
+
+unorderedList :: Parser Block
+unorderedList = fmap UnorderedList $ many1 $ listItem False
+
+blockQuoteLineStart :: Parser String
+blockQuoteLineStart = try (string "> ") "\"> \" (blockquote)"
+
+blockQuote :: Parser Block
+blockQuote = fmap BlockQuote $ do
+ blockQuoteLineStart
+ withModifiedState (many1 inline) $ \s -> s {prevCharIsNewline=False, skipPrefix=(blockQuoteLineStart >> many (char ' '))}
+
+blockCodeLineStart :: Parser String
+blockCodeLineStart = try (string "\t" <|> string " ") "\" \" or tab (code block)"
+
+blockCode :: Parser Block
+blockCode = fmap (BlockCode . unlines) $ many1 $ blockCodeLineStart >> manyTill (noneOf "\n") (char' '\n')
+
+blockHtml :: Parser Block
+blockHtml = fmap BlockHtml html
+
+-- Does not return TableRow because we don't know what type the cells are until the whole table is parsed.
+tableRow :: Parser [[Inline]]
+tableRow = manyTill ((char' '|' "\"|\" (table cell)") >> many1 inline) (try $ string' "|\n")
+
+tableSeparator :: Parser ()
+tableSeparator = optional $ do
+ sepBy1 (char '+' "\"+\" (table)") (optionMaybe (char ' ') >> many1 (char '-') >> optionMaybe (char ' '))
+ char' '\n'
+
+table :: Parser Block
+table = do
+ tableSeparator
+ rows <- many1 $ tableRow
+ tableSeparator
+ rows2 <- many $ tableRow
+ let headerRows = if null rows2
+ then Nothing
+ else Just $ map (TableRow . map TableHeaderCell) rows
+ let bodyRows = map (TableRow . map TableBodyCell) $ if null rows2 then rows else rows2
+ if null rows2
+ then return ()
+ else tableSeparator
+ return $ Table headerRows bodyRows
+
+block :: Parser Block
+block = (many $ char '\n') >> choice [blockHtml, hardRule, header, orderedList, unorderedList, blockQuote, table, blockCode, paragraph]
diff --git a/src/Parsing/ParseFootnotes.hs b/src/Parsing/ParseFootnotes.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/ParseFootnotes.hs
@@ -0,0 +1,27 @@
+module Parsing.ParseFootnotes where
+
+import Data.Maybe
+import Text.Parsec
+import qualified Data.Map.Strict as M
+
+import AST
+import Parsing.State
+import Parsing.TextUtils
+import Parsing.ParseBlock
+
+footnoteDef :: Parser FootnoteDef
+footnoteDef = do
+ many $ char '\n'
+ identifier <- betweenWithErrors' "~[" "]" "footnote definition" $ many1 $ escapableNoneOf "[]"
+ state <- getState
+ let maybeIndex = M.lookup identifier $ footnoteIndices state
+ index <- if isNothing maybeIndex
+ then fail $ "unreferenced footnote identifier: " ++ identifier
+ else return $ fromJust maybeIndex
+ many1 $ oneOf " \t"
+ modifyState (\s -> s {prevCharIsNewline=False})
+ content <- many1 $ try block
+ return $ FootnoteDef index content
+
+footnoteDefs :: Parser FootnoteDefs
+footnoteDefs = fmap FootnoteDefs $ many1 footnoteDef
diff --git a/src/Parsing/ParseHtml.hs b/src/Parsing/ParseHtml.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/ParseHtml.hs
@@ -0,0 +1,51 @@
+module Parsing.ParseHtml (html) where
+
+import Text.Parsec
+
+import AST
+import Parsing.State
+import Parsing.Utils
+
+htmlTag :: HtmlTagType -> Parser HtmlTag
+htmlTag tagType = do
+ if tagType == Close
+ then try (string " "\" "\"<\" (html tag)"
+ spaces
+ tagname <- many1 (letter "rest of tag name") "html tag name"
+ 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}
+
+htmlContent :: Parser (Either String Html)
+htmlContent = fmap Left (many1 $ noneOf "<") <|> fmap Right html
+
+pairTag :: Parser Html
+pairTag = do
+ open <- htmlTag Open
+ content <- option [] $ many $ try htmlContent
+ close <- htmlTag Close
+ if tagname open /= tagname close
+ then fail $ "mismatched tags: '" ++ tagname open ++ "' and '" ++ tagname close ++ "'"
+ else return $ PairTag open content
+
+singleTag :: Parser Html
+singleTag = fmap SingleTag $ htmlTag SelfClosing
+
+-- TODO: consider eliminating arbitrary-length backtracking on [singleTag]
+-- by limiting tag name length and checking against self-closing tag names.
+html :: Parser Html
+html = try singleTag <|> pairTag
+
+attr :: Parser Attr
+attr = do
+ space >> spaces
+ name <- many1 letter "html attribute name"
+ char '='
+ val <- attrVal
+ return $ Attr name val
+
+attrVal :: Parser String
+attrVal = betweenWithErrors "\"" "\"" "html attribute value" (many $ noneOf "\"")
diff --git a/src/Parsing/ParseInline.hs b/src/Parsing/ParseInline.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/ParseInline.hs
@@ -0,0 +1,71 @@
+module Parsing.ParseInline (inline) where
+
+import Data.Maybe
+import Text.Parsec
+import qualified Data.Map.Strict as M
+
+import AST
+import Parsing.State
+import Parsing.Text
+import Parsing.TextUtils
+import Parsing.Utils
+import Parsing.ParseHtml
+
+nestedBold :: Parser Inline
+nestedBold = suppressErr (try (string "****")) >> fail "cannot have empty or nested bold nodes"
+
+bold :: Parser Inline
+bold = do
+ state <- getState
+ let currentParserStack = inlineParserStack state
+ failIf $ elem "bold" currentParserStack
+ s <- betweenWithErrors' "**" "**" "bold"
+ $ withModifiedState (many1 inline) $ \s -> s {inlineParserStack=("bold" : currentParserStack)}
+ return $ Bold s
+
+-- The bold and italics parsers are tricky because they both use the same special character.
+italics :: Parser Inline
+italics = do
+ state <- getState
+ let currentParserStack = inlineParserStack state
+ failIf $ elem "italics" currentParserStack
+ s <- between
+ (try ((char' '*' "\"*\" (italics)") >> suppressErr (notFollowedBy (char '*'))))
+ (char' '*' "closing \"*\" (italics)")
+ ((withModifiedState (many1 inline) $ \s -> s {inlineParserStack=("italics" : currentParserStack)})
+ if elem "bold" currentParserStack
+ then "content in italics node or extra \"*\" to close bold node"
+ else "content in italics node")
+ return $ Italics s
+
+code :: Parser Inline
+code = fmap Code $ betweenWithErrors' "`" "`" "code" $ many1 $ escapableNoneOf "`"
+
+footnoteRef :: Parser Inline
+footnoteRef = do
+ 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)
+ else return ()
+ let index = M.size f
+ let f' = M.insert identifier index f
+ putState $ state {footnoteIndices=f'}
+ return $ FootnoteRef index
+
+link :: Parser Inline
+link = do
+ state <- getState
+ let currentParserStack = inlineParserStack state
+ lookAhead (char '[' "\"[\" (link text)")
+ 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}
+
+inline :: Parser Inline
+inline = choice [nestedBold, bold, italics, code, footnoteRef, link, fmap InlineHtml html, fmap Plaintext plaintext]
diff --git a/src/Parsing/State.hs b/src/Parsing/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/State.hs
@@ -0,0 +1,19 @@
+module Parsing.State where
+
+import Text.Parsec
+import qualified Data.Map.Strict as M
+
+data ParserState = ParserState {
+ prevCharIsNewline :: Bool,
+ skipPrefix :: Parser String,
+ inlineParserStack :: [String],
+ footnoteIndices :: M.Map String Int
+}
+type Parser = Parsec String ParserState
+
+initialState = ParserState{
+ prevCharIsNewline=False,
+ skipPrefix=string "",
+ inlineParserStack=[],
+ footnoteIndices=M.fromList []
+}
diff --git a/src/Parsing/Text.hs b/src/Parsing/Text.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/Text.hs
@@ -0,0 +1,49 @@
+module Parsing.Text (plaintext) where
+
+import Data.Maybe
+import Text.Parsec
+
+import Parsing.State
+import Parsing.Utils
+
+specials = "*`^<>[]|\\"
+firstCharSpecials = " \t#~+\n" ++ specials
+
+-- Parse a single non-special character, allowing for escaping and continuation.
+nonSpecial :: String -> Parser Char
+nonSpecial blacklist = do
+ escape <- suppressErr (optionMaybe $ char '\\')
+ if isJust escape
+ then do
+ optional $ char '\n' -- continuation
+ anyChar
+ 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
+-- as many non-special characters as possible, for ease of implementation.
+nonSpecials :: Parser String
+nonSpecials = do
+ state <- getState
+ str <- if prevCharIsNewline state
+ then do
+ s <- skipPrefix state
+ if null s
+ then do
+ c <- nonSpecial firstCharSpecials
+ return [c]
+ else return s
+ else do
+ s <- many $ nonSpecial ('\n' : specials)
+ c <- suppressErr (optionMaybe $ char '\n')
+ if isJust c
+ then return (s ++ "\n")
+ else if null s
+ then fail "" -- Don't succeed without consuming any input.
+ else return s
+ putState $ state {prevCharIsNewline=(last str == '\n')}
+ return str
+
+-- Parse as many non-special characters as possible.
+plaintext :: Parser String
+plaintext = fmap concat $ many1 nonSpecials
diff --git a/src/Parsing/TextUtils.hs b/src/Parsing/TextUtils.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/TextUtils.hs
@@ -0,0 +1,40 @@
+module Parsing.TextUtils where
+
+import Data.Maybe
+import Text.Parsec
+
+import Parsing.State
+import Parsing.Utils
+
+-- Parse a single character and update parsing state accordingly.
+char' :: Char -> Parser Char
+char' c = if c == '\n'
+ then do
+ newline <|> (eof >> return '\n')
+ modifyState $ \s -> s {prevCharIsNewline=True}
+ return '\n'
+ else do
+ char c
+ modifyState $ \s -> s {prevCharIsNewline=False}
+ return c
+
+-- Parse a string of characters and update parsing state accordingly.
+string' :: String -> Parser String
+string' = mapM char'
+
+-- Parse a string of characters not in [blacklist], unless they are escaped,
+-- and update state like [string'].
+escapableNoneOf :: String -> Parser Char
+escapableNoneOf blacklist = do
+ escape <- suppressErr (optionMaybe $ char '\\')
+ c <- if isJust escape
+ then anyChar
+ else noneOf blacklist
+ modifyState $ \s -> s {prevCharIsNewline=(c == '\n')}
+ return c
+
+-- Like [betweenWithErrors], but updates state when parsing the start and end strings.
+betweenWithErrors' :: String -> String -> String -> Parser a -> Parser a
+betweenWithErrors' open close name = between
+ (try (string' open) "\"" ++ open ++ "\" (" ++ name ++ ")")
+ (try (string' close) "closing \"" ++ close ++ "\" (" ++ name ++ ")")
diff --git a/src/Parsing/Utils.hs b/src/Parsing/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Parsing/Utils.hs
@@ -0,0 +1,26 @@
+module Parsing.Utils where
+
+import Text.Parsec
+
+suppressErr :: Parsec s u a -> Parsec s u a
+suppressErr p = p ""
+
+failWithIf :: String -> Bool -> Parsec s u ()
+failWithIf msg cond = if cond then fail msg else return ()
+
+failIf :: Bool -> Parsec s u ()
+failIf = failWithIf ""
+
+withModifiedState :: Parsec s u a -> (u -> u) -> Parsec s u a
+withModifiedState p modifier = do
+ state <- getState
+ putState $ modifier state
+ result <- p
+ putState state
+ return result
+
+-- Like [between], but with more helpful error messages on failure.
+betweenWithErrors :: String -> String -> String -> Parsec String u a -> Parsec String u a
+betweenWithErrors open close name = between
+ (try (string open) "\"" ++ open ++ "\" (" ++ name ++ ")")
+ (try (string close) "closing \"" ++ close ++ "\" (" ++ name ++ ")")
diff --git a/src/Rendering/Render.hs b/src/Rendering/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Rendering/Render.hs
@@ -0,0 +1,132 @@
+{-# Language CPP #-}
+
+module Rendering.Render (ToHtml, toHtml) where
+
+import Data.List
+import Data.List.Utils
+import System.IO.Unsafe
+
+import AST
+#ifdef CABAL
+import Paths_Blogdown
+#endif
+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 "\n"
+ else ""
+
+optionalCSS :: RenderOptions -> String
+optionalCSS r = if (inlineCSS r)
+ then "\n"
+ else ""
+
+instance ToHtml AST where
+ toHtml r (AST bs Nothing) = (unlines $ map (toHtml r) bs) ++ optionalCSS r ++ optionalJS r
+ toHtml r (AST bs (Just f)) = body ++ footnotes ++ "\n" ++ optionalCSS r ++ optionalJS r where
+ body = unlines $ map (toHtml r) bs
+ footnotes = toHtml r f
+
+withTag :: String -> String -> String
+withTag tag content = "<" ++ tag ++ ">" ++ content ++ ""
+
+showAttrs :: [(String, String)] -> String
+showAttrs attrs = unwords $ map (\(name, val) -> name ++ "=\"" ++ val ++ "\"") attrs
+
+withTagAttrs :: String -> [(String, String)] -> String -> String
+withTagAttrs tag attrs content = "<" ++ tag ++ " " ++ showAttrs attrs ++ ">" ++ content ++ ""
+
+fancyUnlines :: [String] -> String
+fancyUnlines = concat . intersperse "\n"
+
+escapeHtml :: String -> String
+escapeHtml = concatMap escapeChar where
+ escapeChar '<' = "<"
+ escapeChar '>' = ">"
+ escapeChar c = [c]
+
+instance ToHtml FootnoteDefs where
+ toHtml r (FootnoteDefs fs) = withTagAttrs "ol"
+ [("start", show $ footnoteIndexFrom r), ("class", "footnotes")]
+ $ unlines $ map (toHtml r) $ sortOn index fs
+
+instance ToHtml FootnoteDef where
+ toHtml r (FootnoteDef index ls) = withTagAttrs "li" [("id", (footnotePrefix r) ++ "-footnote-" ++ show index)] content' where
+ content = fancyUnlines $ map (toHtml r) ls
+ content' = if footnoteBacklinks r
+ then withTagAttrs "a" [("href", "#a-" ++ (footnotePrefix r) ++ "-footnote-" ++ show index)] "^" ++ "\n" ++ content
+ else content
+
+stripEndingNewline :: String -> String
+stripEndingNewline s = if last s == '\n'
+ then init s
+ else s
+
+instance ToHtml Block where
+ toHtml _ HardRule = "
"
+ 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 (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
+ toHtml r (Table Nothing trs) = withTag "table" $ withTag "tbody" body where
+ body = unlines $ map (toHtml r) trs
+ toHtml r (Table (Just ths) trs) = withTag "table" $ (withTag "thead" header) ++ (withTag "tbody" body) where
+ header = unlines $ map (toHtml r) ths
+ body = unlines $ map (toHtml r) trs
+
+instance ToHtml ListItem where
+ toHtml r (ListItem _ ls) = withTag "li" $ stripEndingNewline $ concatMap (toHtml r) ls
+
+instance ToHtml TableCell where
+ toHtml r (TableHeaderCell tds) = withTag "th" $ concatMap (toHtml r) tds
+ toHtml r (TableBodyCell tds) = withTag "td" $ concatMap (toHtml r) tds
+
+instance ToHtml TableRow where
+ toHtml r (TableRow tcs) = withTag "tr" $ unlines $ map (toHtml r) tcs
+
+instance ToHtml Inline where
+ toHtml r (Italics ls) = withTag "i" $ concatMap (toHtml r) ls
+ toHtml r (Bold ls) = withTag "b" $ concatMap (toHtml r) ls
+ toHtml _ (Code s) = withTag "code" $ escapeHtml s
+ toHtml r (FootnoteRef index) = withTag "sup" $ withTagAttrs "a"
+ [("href", "#" ++ (footnotePrefix r) ++ "-footnote-" ++ show index),
+ ("id", "a-" ++ (footnotePrefix r) ++ "-footnote-" ++ show index)]
+ ("[" ++ show (index + footnoteIndexFrom r) ++ "]")
+ toHtml r (Plaintext s) = escapeHtml $ if emDashes r
+ then replace "--" "—" s
+ 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))
+
+showHtmlContent :: Either String Html -> String
+showHtmlContent (Left s) = s
+showHtmlContent (Right h) = showHtml h
+
+showHtml :: Html -> String
+showHtml (PairTag open content) = "<" ++ showInnerTag open ++ ">" ++ concatMap showHtmlContent content ++ ""
+showHtml (SingleTag tag) = "<" ++ showInnerTag tag ++ "/>"
+
+instance ToHtml Html where
+ toHtml _ = showHtml
diff --git a/src/Rendering/RenderOptions.hs b/src/Rendering/RenderOptions.hs
new file mode 100644
--- /dev/null
+++ b/src/Rendering/RenderOptions.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Rendering.RenderOptions where
+
+import GHC.Generics (Generic)
+import System.Environment
+
+data RenderOptions = RenderOptions {
+ footnotePrefix :: String,
+ footnoteIndexFrom :: Int,
+ footnoteBacklinks :: Bool,
+ emDashes :: Bool,
+ inlineCSS :: Bool,
+ inlineJS :: Bool
+} deriving (Generic)
+
+defaultRenderOptions = RenderOptions {
+ footnotePrefix = "",
+ footnoteIndexFrom = 0,
+ footnoteBacklinks = False,
+ emDashes = False,
+ inlineCSS = False,
+ inlineJS = False
+}
+
+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}
+
+getRenderOptions :: IO RenderOptions
+getRenderOptions = fmap renderOptions getArgs
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,327 @@
+module Main where
+
+import Data.String.Utils
+import Text.Parsec
+import System.Exit
+
+import Parsing.Parse
+import Parsing.ParseBlock
+import Parsing.ParseHtml
+import Parsing.ParseInline
+import Parsing.State
+import Rendering.Render
+import Rendering.RenderOptions
+
+printExpectedSuccess :: (ToHtml a) => String -> String -> String -> a -> IO Bool
+printExpectedSuccess name input expected parsed = if output == expected
+ then do
+ putStrLn $ "PASS: " ++ name
+ return True
+ else do
+ putStrLn $ "FAIL: " ++ name
+ putStrLn "in:"
+ putStrLn input
+ putStrLn "out:"
+ putStrLn output
+ putStrLn "expect:"
+ putStrLn expected
+ return False
+ where
+ output = toHtml defaultRenderOptions parsed
+
+expectSuccess :: (ToHtml a) => String -> (Parser a) -> String -> String -> IO Bool
+expectSuccess name p input expected = either
+ (\err -> do
+ putStrLn $ "FAIL: " ++ name
+ putStrLn $ show err
+ return False)
+ (printExpectedSuccess name input expected)
+ $ runParser p initialState name input
+
+testItalics = expectSuccess "italics" inline "*abc*" "abc"
+testBold = expectSuccess "bold" inline "**abc**" "abc"
+testBoldItalics = expectSuccess "bold italics" inline "***abc***" "abc"
+testCode = expectSuccess "code" inline "`abc`" "abc"
+testInlineHtml = expectSuccess "inline html" html
+ "SQL"
+ "SQL"
+testMultipleAttrs = expectSuccess "html with multiple attrs" html
+ "SQL"
+ "SQL"
+testFootnoteRef = expectSuccess "footnote reference" inline
+ "^[x]"
+ ""
+testLink = expectSuccess "link" inline
+ "[Google](https://google.com)"
+ "Google"
+testLinkWithContents = expectSuccess "link with styling inside" inline
+ "[*Whence* `he` **came**](https://google.com)"
+ "Whence he came"
+testH1 = expectSuccess "h1" header "# hello" "hello
"
+testH6 = expectSuccess "h6" header "###### hello" "hello
"
+testHardRule = expectSuccess "hard rule" hardRule "---\n" "
"
+testHardRuleLong = expectSuccess "hard rule with extra dashes" hardRule "----\n" "
"
+testParagraph = expectSuccess "paragraph" paragraph
+ "This is a paragraph\n\
+ \of text.\n"
+ "This is a paragraph\n\
+ \of text.
"
+testEscapeCharacters = expectSuccess "paragraph with escaped special characters" paragraph
+ "These are special: \\~, \\*, \\[, \\], \\^\n"
+ "These are special: ~, *, [, ], ^
"
+testHashInParagraph = expectSuccess "paragraph containing literal '#'" paragraph
+ "This is a paragraph\n\
+ \containing '#'\n"
+ "This is a paragraph\n\
+ \containing '#'
"
+testOrderedList = expectSuccess "ol" orderedList
+ " - point 1\n\
+ \ - point 2\n"
+ "- point 1
\n\
+ \- point 2
\n
"
+testUnorderedList = expectSuccess "ul" unorderedList
+ " * point 1\n\
+ \ * point 2\n"
+ ""
+testBlockQuote = expectSuccess "blockquote" blockQuote
+ "> The politician said that\n\
+ \> he would fix the economy.\n"
+ "The politician said that\n\
+ \he would fix the economy.
"
+testBlockQuotePreFormatted = expectSuccess "blockquote pre-formatted" blockQuote
+ "> \"This is it... this is where I belong...\"\n\
+ \> I know everyone here... even if I've never met them, never talked to\n\
+ \> them, may never hear from them again... I know you all...\n"
+ " \"This is it... this is where I belong...\"\n\
+ \ I know everyone here... even if I've never met them, never talked to\n\
+ \them, may never hear from them again... I know you all...
"
+testBlockCode = expectSuccess "block code" blockCode
+ " var x = 0;\n\
+ \ alert(x);\n"
+ "var x = 0;\n\
+ \alert(x);\n\
+ \
"
+testBlockCodeWhitespace = expectSuccess "block code handles starting whitespace correctly" blockCode
+ " def f(x):\n\
+ \ return x\n"
+ "def f(x):\n\
+ \ return x\n\
+ \
"
+testBlockCodeSpecialChars = expectSuccess "any line beginning with four spaces should be a block of code, regardless of the first non-whitespace character" block
+ " > print(1)\n\
+ \ * 1"
+ "> print(1)\n\
+ \* 1\n\
+ \
"
+testBlockHtml = expectSuccess "block html" blockHtml
+ "\n\
+ \ \n\
+ \
"
+ "\n\
+ \ \n\
+ \
"
+testTable = expectSuccess "table" table
+ "+---+---+\n\
+ \| a | b |\n\
+ \| c | d |\n\
+ \+---+---+\n"
+ "| a | \n\
+ \ b | \n\
+ \
\n\
+ \| c | \n\
+ \ d | \n\
+ \
\n\
+ \
"
+testTableHeader = expectSuccess "table with header" table
+ "+---+---+\n\
+ \| a | b |\n\
+ \+---+---+\n\
+ \| c | d |\n\
+ \| e | f |\n\
+ \+---+---+\n"
+ "| a | \n\
+ \ b | \n\
+ \
|---|
\n\
+ \| c | \n\
+ \ d | \n\
+ \
\n\
+ \| e | \n\
+ \ f | \n\
+ \
\n\
+ \
"
+testTableMinimal = expectSuccess "minimal table" table
+ "| a | b |\n\
+ \| c | d |\n"
+ "| a | \n\
+ \ b | \n\
+ \
\n\
+ \| c | \n\
+ \ d | \n\
+ \
\n\
+ \
"
+testTableHeaderMinimal = expectSuccess "minimal table with header" table
+ "| a | b |\n\
+ \+\n\
+ \| c | d |\n\
+ \| e | f |\n"
+ "| a | \n\
+ \ b | \n\
+ \
|---|
\n\
+ \| c | \n\
+ \ d | \n\
+ \
\n\
+ \| e | \n\
+ \ f | \n\
+ \
\n\
+ \
"
+testFootnoteDef = expectSuccess "footnote definition" ast
+ "^[x]\n\
+ \~[x] This is a single list item\n\
+ \of footnote.\n"
+ "
\n\
+ \\n"
+testFootnoteDefs = expectSuccess "multiple footnote definitions" ast
+ "^[0]^[1]^[2]\n\
+ \~[0] a\n\
+ \~[1] b\n\
+ \\n\
+ \~[2] c\n"
+ "
\n\
+ \\n"
+testFootnoteOrdering = expectSuccess "footnotes should be sorted by first reference" ast
+ "^[0]^[1]\n\
+ \~[1] b\n\
+ \~[0] a\n"
+ "
\n\
+ \\n"
+testContinuation = expectSuccess "continuation character" paragraph
+ "a\\\nb"
+ "ab
"
+
+expectFailure :: String -> (Parser a) -> String -> String -> IO Bool
+expectFailure name p input expectedErr = either
+ (\err -> if endswith expectedErr $ show err
+ then do
+ putStrLn $ "PASS: " ++ name
+ return True
+ else do
+ putStrLn $ "FAIL: " ++ name
+ putStrLn "in:"
+ putStrLn input
+ putStrLn "out:"
+ putStrLn $ show err
+ putStrLn "expect:"
+ putStrLn expectedErr
+ return False)
+ (\_ -> do
+ putStrLn $ "FAIL: " ++ name
+ return False)
+ $ runParser p initialState name input
+
+testNestedBold = expectFailure "bold tags cannot be nested" inline
+ "****abc****"
+ "cannot have empty or nested bold nodes"
+testMismatchedBoldItalics = expectFailure "bold opening tag closed with italics tag" inline
+ "**a*"
+ "expecting content in italics node or extra \"*\" to close bold node"
+testSwappedItalicsBold = expectFailure "italics and bold closing tags swapped" paragraph
+ "*a**b*c**"
+ "unexpected \"c\"\n\
+ \expecting closing \"**\" (bold)"
+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\
+ \links cannot be nested"
+testUnclosedOpeningTag = expectFailure "unclosed opening tag should fail to parse" html
+ "\" (html tag)"
+testUnclosedTag = expectFailure "unclosed tag should fail to parse" html
+ "hello"
+ "unexpected end of input\n\
+ \expecting \"<\" (html tag) or \"hello"
+ "mismatched tags: 'a' and 'b'"
+
+goldenTest :: FilePath -> FilePath -> String -> IO Bool
+goldenTest inFilePath goldenFilePath renderArgs = do
+ let r = renderOptions $ words renderArgs
+ input <- readFile inFilePath
+ golden <- readFile goldenFilePath
+ either
+ (\_ -> do
+ putStrLn $ "FAIL: " ++ goldenFilePath
+ return False)
+ (\parsed -> do
+ let rendered = toHtml r parsed
+ if rendered == golden
+ then do
+ putStrLn $ "PASS: " ++ goldenFilePath
+ return True
+ else do
+ let failPath = goldenFilePath ++ ".fail"
+ writeFile failPath rendered
+ putStrLn $ "FAIL: " ++ goldenFilePath
+ return False)
+ $ runParser ast initialState inFilePath input
+
+main :: IO ()
+main = do
+ results <- sequence [
+ testItalics,
+ testBold,
+ testBoldItalics,
+ testCode,
+ testInlineHtml,
+ testMultipleAttrs,
+ testFootnoteRef,
+ testLink,
+ testLinkWithContents,
+ testH1,
+ testH6,
+ testHardRule,
+ testHardRuleLong,
+ testParagraph,
+ testEscapeCharacters,
+ testHashInParagraph,
+ testOrderedList,
+ testUnorderedList,
+ testBlockQuote,
+ testBlockQuotePreFormatted,
+ testBlockCode,
+ testBlockCodeWhitespace,
+ testBlockCodeSpecialChars,
+ testBlockHtml,
+ testTable,
+ testTableHeader,
+ testTableMinimal,
+ testTableHeaderMinimal,
+ testFootnoteDef,
+ testFootnoteDefs,
+ testFootnoteOrdering,
+ testContinuation,
+ testNestedBold,
+ testMismatchedBoldItalics,
+ testSwappedItalicsBold,
+ testNestedLink,
+ testUnclosedOpeningTag,
+ testUnclosedTag,
+ testMismatchedTags,
+ goldenTest "Readme.md" "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"]
+ if and results
+ then exitSuccess
+ else exitFailure