diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,123 @@ +## MMark 0.1.0.0 + +* Transformations can now report errors. A transformation runs in the new + `TransT` monad and can `report` an error at a `Span` and carry on, or + `abort` and give up on the document. Errors are collected in a + `ParseErrorBundle Text TransError`, the same type the parser produces, so + `errorBundlePretty` renders them against the source of the document + exactly like parse errors. + +* Extensions can now perform effects. `TransT` is a monad transformer, so a + transformation may be run in `IO` or in any other monad, see `runTransM`. + +* Every block and inline now carries the `Span` of the source it derives + from, see `blockSpan` and `inlineSpan`. A node that an extension creates + in place of another one inherits its `Span`, and a node assembled from + several others should be given the `spanUnion` of theirs. + +* `runScanner` and `runScannerM` take the document as their second argument + now rather than their first, which is the order the rest of the pipeline + already used and which lets a scanner be partially applied: + `documentMetadata = runScanner metadataScanner`. + +* Transformations are now applied to the document right away with `runTrans` + and `runTransM`, instead of being accumulated in an extension value and + applied just before rendering. `useExtension`, `useExtensions`, + `blockTrans`, and `inlineTrans` are gone, and so is the `Endo`-based + ordering that came with them: transformations are sequenced with `(>=>)` + and abort as soon as one of them reports an error. + +* Added `runCheck` and `runCheckM`, which run a computation in the + transformation monad once against a document instead of applying it to + every top-level block. This way a check that concerns the document as a + whole does not have to be written as a transformation of a block it has no + interest in. + +* Transformations are explicit and available in both directions: + `bottomUpBlocks`, `topDownBlocks`, `bottomUpInlines`, and + `topDownInlines`. The function given to `runTransM` is applied to + top-level blocks only, so the transformation that reaches the rest of the + document is the caller's choice. + +* Rendering extensions still cannot fail. They are collected in a + `RenderExtension` value, which is now passed to `render` explicitly rather + than being stored in the document: `render :: RenderExtension -> MMark -> + Html ()`. Use `mempty` when there are none. Anything that can fail belongs + in a transformation. + +* The `Text.MMark.Extension` module is gone. The two kinds of extension now + have a module each: `Text.MMark.Trans` for transformations and + `Text.MMark.Render` for render extensions. Both re-export the document + types, so writing either kind of extension takes one import. `scanner` and + `scannerM` moved to `Text.MMark`, next to `runScanner` and `runScannerM`. + +* Block quotes now follow the CommonMark specification. Every line of a + block quote must begin with a `>` character, one per level of nesting, + instead of the quote continuing for as long as its content is indented. + Paragraphs inside a block quote can be continued lazily, that is, on lines + that lack the character. Note that fenced code blocks still have to be + closed explicitly, so a code fence that is opened inside a block quote and + not closed before the quote ends is a parse error. + +* Block quotes now take precedence over tables. A line that begins with a + `>` character opens a block quote even when it looks like the header of a + table, so `> foo | bar` is a table inside a block quote instead of a table + whose first header cell is `> foo`. Unlike paragraphs, tables cannot be + continued lazily: a row that does not carry the block quote markers of the + table it belongs to ends both the table and the quote. + +* Emphasis, strong emphasis, strikeout, subscript, and superscript can now + be applied to a part of a word. A delimiter run that could both open or + close markup used to be rejected; it is now taken to close the markup it + is inside of and to open new markup otherwise. Delimiter runs that lean + unambiguously one way or the other are classified exactly as before. + +* A delimiter run now opens all of its markup as one group, however long the + run is, instead of being split into nested groups of at most two frames + each. The delimiters of a run consequently close from the inside out at + any length, which only changes the result for runs of five characters and + more: `_____foo_____` is now + `foo` as in CommonMark, rather + than `foo`. + +* A run of underscores surrounded by word characters is now literal text + rather than markup, so `snake_case` and `to_string()` no longer have to be + escaped. This is the only case in which a markup character does not have + to be backslash escaped to be taken literally. + +* Added the `UnmatchedClosingDelimiterRun` constructor to `MMarkErr`. A + delimiter run that can only close markup but has no markup to close used + to be reported as `NonFlankingDelimiterRun`; the latter is now reserved + for runs that have white space on both sides of them and so can neither + open nor close anything. Both errors are also reported at the beginning of + the whole delimiter run now, rather than at the beginning of the part of + it that MMark happened to recognize. + +* An unclosed code fence whose last line lacks a line ending is now reported + as “expecting closing code fence or code block content” rather than as + “expecting newline”. + +* The contents of a code span are no longer normalized by collapsing every + run of white space into a single space and trimming both ends. Following + CommonMark, only line endings become spaces now, and a single space is + removed from each end when the contents both begin and end with a space + without consisting of spaces alone. White space inside a code span is + therefore preserved verbatim, so `` `col1 col2` `` keeps its two spaces + and `` `ab` `` keeps its tab. + +* Fixed a bug that made the info string of a fenced code block reject + backtick characters even when the fence was made of tildes. Only a + backtick fence can be confused with a backtick in its info string, so + ` ~~~ aa ``` ~~~ ` opens a code block now instead of being a parse error. + +* Symbols such as `$`, `+`, and `=` now count as punctuation when the type + of the characters around a delimiter run is determined, as they do in + CommonMark since version 0.31. Emphasis cannot hang on such a character + anymore, so `*$*alpha` is a parse error rather than emphasized `$`. + +* The test suite now follows the CommonMark specification 0.31.2 rather than + 0.28. + ## MMark 0.0.8.0 * Exposed the following modules: `Text.MMark.Internal.Type`, @@ -150,7 +270,7 @@ ## MMark 0.0.3.0 -* Code can interrupt paragraphs now, as per Common Mark spec. +* Code can interrupt paragraphs now, as per CommonMark spec. * Implemented parsing of reference-links (including collapsed and shortcut-style links). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,10 +4,10 @@ [![Hackage](https://img.shields.io/hackage/v/mmark.svg?style=flat)](https://hackage.haskell.org/package/mmark) [![Stackage Nightly](http://stackage.org/package/mmark/badge/nightly)](http://stackage.org/nightly/package/mmark) [![Stackage LTS](http://stackage.org/package/mmark/badge/lts)](http://stackage.org/lts/package/mmark) -![CI](https://github.com/mmark-md/mmark/workflows/CI/badge.svg?branch=master) +[![CI](https://github.com/mmark-md/mmark/actions/workflows/ci.yaml/badge.svg)](https://github.com/mmark-md/mmark/actions/workflows/ci.yaml) * [Quick start: MMark vs GitHub-flavored markdown](#quick-start-mmark-vs-github-flavored-markdown) -* [MMark and Common Mark](#mmark-and-common-mark) +* [MMark and CommonMark](#mmark-and-commonmark) * [Differences in inline parsing](#differences-in-inline-parsing) * [Other differences](#other-differences) * [About MMark-specific extensions](#about-mmark-specific-extensions) @@ -17,71 +17,52 @@ * [License](#license) MMark (read “em-mark”) is a strict markdown processor for writers. “Strict” -means that not every input is considered valid markdown document and parse +means that not every input is considered a valid markdown document and parse errors are possible and even desirable, because they allow us to spot markup -issues without searching for them in rendered document. If a markdown -document passes the MMark parser, then it is likely to produce an HTML -output without quirks. This feature makes it a good choice for writers and +issues without searching for them in the rendered document. If a markdown +document passes the MMark parser, then it is likely to produce HTML output +without quirks. This feature makes it a good choice for writers and bloggers. -MMark in its current state features: +MMark features: * A parser that produces high-quality error messages and does not choke on the first parse error. It is capable of reporting several parse errors simultaneously. -* An extension system that allows us to create extensions that alter parsed - markdown document in some way. - -* A [`lucid`](https://hackage.haskell.org/package/lucid)-based render. - -There is also a blog post announcing the project: +* An extension system that allows us to create extensions that alter a + parsed markdown document or the way it is rendered. Extensions can perform + effects and can report errors of their own, which are shown against the + source of the document just like parse errors are. -https://markkarpov.com/post/announcing-mmark.html +* A [`lucid`](https://hackage.haskell.org/package/lucid)-based renderer. ## Quick start: MMark vs GitHub-flavored markdown It's easy to start using MMark if you're used to GitHub-flavored markdown. -There are four main differences: +There are three main differences: -1. URIs are not automatically recognized, you must enclose them in `<` and +1. URIs are not automatically recognized; you must enclose them in `<` and `>`. -2. Block quotes require only one `>` and they continue as long as the inner - content is indented. - - This is OK: - - ``` - > Here goes my block quote. - And this is the second line of the quote. - ``` - - This produces *two* block quotes: - - ``` - > Here goes my block quote. - > And this is another block quote! - ``` - -3. HTML blocks and inline HTML are not supported. +2. HTML blocks and inline HTML are not supported. -4. See [differences in inline parsing](#differences-in-inline-parsing). +3. See [differences in inline parsing](#differences-in-inline-parsing). -## MMark and Common Mark +## MMark and CommonMark -MMark mostly tries to follow the Common Mark specification as given here: +MMark mostly tries to follow the CommonMark specification as given here: -https://spec.commonmark.org/0.28/ +https://spec.commonmark.org/0.31.2/ However, due to the fact that we do not allow inputs that do not make sense, and also try to guard against common mistakes (like writing `##My header` -and having it rendered as a paragraph starting with hashes) MMark obviously +and having it rendered as a paragraph starting with hashes), MMark obviously can't follow the specification precisely. In particular, parsing of inlines -differs considerably from Common Mark (see below). +is stricter than CommonMark (see below). -Another difference between Common Mark and MMark is that the latter supports -more (pun alert) common markdown extensions out-of-the-box. In particular, +Another difference between CommonMark and MMark is that the latter supports +more (pun alert) common markdown extensions out of the box. In particular, MMark supports: * parsing of an optional YAML block @@ -96,42 +77,20 @@ ### Differences in inline parsing -Emphasis and strong emphasis is an especially hairy topic in the Common Mark +Emphasis and strong emphasis is an especially hairy topic in the CommonMark specification. There are 17 ad-hoc rules defining the interaction between -`*` and `_` -based emphasis and more than an half of all Common Mark +`*` and `_` -based emphasis and more than half of all CommonMark examples (that's about 300) test just this. -Not only it is hard to implement, it's hard to understand for humans too. -For example, this input: - -``` -*(*foo*)* -``` - -results in the following HTML: - -``` -

(foo)

-``` - -(Note the nested emphasis.) - -Could it produce something like this instead? - -``` -

(foo)

-``` - -Well, why not? Without remembering those 17 ad-hoc rules, there going to be -a lot of tricky cases when the user won't be able to tell how markdown will -be parsed. - -I decided to make parsing of emphasis, strong emphasis, and similar -constructs like strikethrough, subscript, and superscript more symmetric and -less ad-hoc. In 99% of practical cases it is identical to Common Mark, and -normal markdown intuitions will work OK for the users. +Almost none of that complexity is in deciding *what a delimiter run could +do*—CommonMark's notion of left- and right-flanking delimiter runs is +straightforward. It is in deciding what to do with a run that could just as +well open emphasis as close it, and the answer to that is a pile of special +cases that is hard to implement and harder for a human to remember. -Let's start by dividing all characters into four groups: +MMark classifies delimiter runs exactly the way CommonMark does and then +resolves the ambiguous ones with a single rule. Let's start by dividing all +characters into four groups: * **Space characters**, including space, tab, newline, carriage return, and other characters like non-breaking space. @@ -139,10 +98,12 @@ * **Markup characters**, including the following: `*`, `~`, `_`, `` ` ``, `^`, `[`, `]`. These are used for markup and whenever they appear in a document, they must form valid markup constructions. To be used as - ordinary punctuation characters they must be backslash escaped. + ordinary punctuation characters they must be backslash escaped (there is + exactly one exception to this, see below). * **Punctuation characters**, which include all punctuation characters that - are not **markup characters**. + are not **markup characters**. Following CommonMark, symbols such as `$`, + `+`, and `=` count as punctuation here too. * **Other characters**, which include all characters not falling into the three groups described above. @@ -156,61 +117,67 @@ When **markup characters** or **punctuation characters** are escaped with backslash they become **other characters**. -We'll call **markdown characters** placed between a character of level `L` -and a character of level `R` *left-flanking delimiter run* if and only if: - -``` -level(L) < level(R) -``` - -These **markup characters** sort of hang on the left hand side of a word. - -Similarly we'll call **markdown characters** placed between a character of -level `L` and a character of level `R` *right-flanking delimiter run* if and -only if: +Now take a run of **markup characters** placed between a character of level +`L` and a character of level `R`. It leans towards whichever of its two +neighbours is more solid, and that is what decides what it can do: -``` -level(L) > level (R) -``` +* `level(L) < level(R)`—the run hangs on the left hand side of a word, so it + can only *open* emphasis markup (and other similar things like + strikethrough, which we won't mention explicitly anymore for brevity); +* `level(L) > level(R)`—the run hangs on the right hand side of a word, so + it can only *close* emphasis markup; +* `level(L) == level(R) == 0`—there is white space on both sides of the run, + so it can do neither and the run is a parse error; +* `level(L) == level(R) > 0`—the run leans nowhere, so it is *ambiguous*. -These **markup characters** hang on the right hand side of a word. +The first two cases are exactly what the CommonMark specification calls a +left-flanking delimiter run that is not right-flanking, and a right-flanking +delimiter run that is not left-flanking. The last case is a run that is +both, and it is the only one where MMark has to make a decision of its own: -*Emphasis markup* (and other similar things like strikethrough, which we -won't mention explicitly anymore for brevity) can start only as -*left-flanking delimiter run* and end only as *right-flanking delimiter -run*. +> An ambiguous run closes the markup it is inside of and opens new markup +> otherwise. -This produces a parse error: +That is the whole rule, and it is what makes emphasis on a part of a word +work: ``` -*Something * is not right. -Something __is __ not right. +un*frigging*believable +H~2~O is not O~2~ +x^2^ + y^2^ = z^2^ ``` -And this too: +There is one exception to all of the above, and it is about the `_` +character. A run of underscores that has word characters on both sides of it +is not markup at all, it is literal text: ``` -__foo__bar +snake_case and to_string() and __dunder__ ``` -This means that inter-word emphasis is not supported. +This is the one place where a **markup character** does not have to be +backslash escaped to be taken literally, and it exists because underscores +are so common inside identifiers. Asterisks are the way to emphasize a part +of a word. -The next example is OK because `s` is an **other character** and `.` is a -**punctuation character**, so `level('s') > level('.')`. +A run with white space on both sides of it leans nowhere and can do nothing, +so these do not parse: ``` -Here it *goes*. +*Something * is not right. +Something __is __ not right. ``` -In some rare cases backslash escaping can help get the right result: +Neither does a run that closes markup that was never opened: ``` -Here goes *(something\)*. +Here goes bar* ``` -We escaped the closing parenthesis `)` so it becomes an **other character** -with level 2 and so its level is greater than the level of plain punctuation -character `.`. +Nor markup that is opened and never closed. That last one is what makes +`__foo__bar` an error rather than literal text: the first `__` opens strong +emphasis, the second one is inside a word and so is literal, and nothing +closes the strong emphasis afterwards. ### Other differences @@ -222,14 +189,11 @@ * Setext headings are not supported for the sake of simplicity. * Fenced code blocks must be explicitly closed by a closing fence. They are not closed by the end of document or by start of another block. -* Lists and block quotes are defined by column at which their content - starts. Content belonging to a particular list or block quote should start - at the same column (or greater column, up to the column where indented - code blocks start). As a consequence of this, block quotes do not feature - “laziness”. -* Block quotes are started by a single `>` character, it's not necessary to - put a `>` character at beginning of every line belonging to a quote (in - fact, this would make every line a separate block quote). +* Lists are defined by column at which their content starts. Content + belonging to a particular list should start at the same column (or greater + column, up to the column where indented code blocks start). As a + consequence of this, lists do not feature “laziness”, unlike in + CommonMark. * Paragraphs can be interrupted by unordered and ordered lists with any valid starting index. * HTML blocks are not supported because the syntax conflicts with autolinks @@ -244,15 +208,15 @@ * All URI references (in links, images, autolinks, etc.) are parsed as per RFC 3986, no support for escaping or support for entity and numeric character references is provided. In addition to that, when a URI - reference in not enclosed with `<` and `>`, then closing parenthesis - character `)` is not considered part of URI (use `` syntax if you + reference is not enclosed with `<` and `>`, then the closing parenthesis + character `)` is not considered part of the URI (use `` syntax if you want a closing parenthesis as part of a URI). Since the empty string is a valid URI and it may be confusing in some cases, we also force the user to write `<>` to represent the empty URI. -* Putting links in text of another link is not allowed, i.e. no nested links - is possible. -* Putting images in description of other images is not allowed (similarly to - the situation with links). +* Putting links in the text of another link is not allowed, i.e. no nested + links are possible. +* Putting images in the description of other images is not allowed (similarly + to the situation with links). * HTML inlines are not supported for the same reason why HTML blocks are not supported. @@ -265,26 +229,35 @@ ## Performance I [have compared](https://github.com/mrkkrp/md-bench) speed and memory -consumption of various Haskell markdown libraries by running them on an -identical, big-enough markdown document and by rendering it as HTML: +consumption of the Haskell markdown libraries that are still maintained by +running each of them on the same markdown document (the readme of +`megaparsec`, about 19 KB) and rendering it as HTML: -Library | Parsing library | Execution time | Allocated | Max residency ---------------------|---------------------|---------------:|------------:|-------------: -`cmark-0.5.6` | Custom C code | 323.4 μs | 228,440 | 9,608 -`mmark-0.0.5.1` | Megaparsec | 7.027 ms | 26,180,272 | 37,792 -`cheapskate-0.1.1` | Custom Haskell code | 10.76 ms | 44,686,272 | 799,200 -`markdown-0.1.16` † | Attoparsec | 14.13 ms | 69,261,816 | 699,656 -`pandoc-2.0.5` | Parsec | 37.90 ms | 141,868,840 | 1,471,080 +Library | Parsing library | Execution time | Allocated | Max residency +---------------------|-----------------|---------------:|------------:|-------------: +`cmark-0.6.1` | Custom C code | 177.7 μs | 175,464 | 63,112 +`commonmark-0.3` | Parsec | 7.502 ms | 39,616,824 | 1,042,184 +`mmark-0.1.0.0` | Megaparsec | 7.680 ms | 33,609,608 | 70,712 +`pandoc-3.10.2` | Parsec | 26.85 ms | 157,760,336 | 1,029,112 -*Results are ordered from fastest to slowest.* +*Results are ordered from fastest to slowest. Measured with GHC 9.10.3.* -† The `markdown` library is sloppy and parses markdown incorrectly. For -example, it parses the following `*My * text` as an inline containing -emphasis, while in reality both asterisks must form flanking delimiter runs -to create emphasis, like so `*My* text`. This allowed `markdown` to get away -with a far simpler approach to parsing at the price that it's not really a -valid markdown implementation. +`cmark` is a binding to the C reference implementation, so it is in a +different league and will stay there. Among the Haskell implementations, +`mmark` and `commonmark` take about the same time, `mmark` allocating +somewhat less, and `pandoc` costs about three and a half times as much as +either—which is the price of being able to read and write everything rather +than one thing. +The number I would draw attention to is the last column. `mmark` holds on to +about 70 KB while it works, where `commonmark` and `pandoc` hold on to +around a megabyte, roughly fifteen times as much. If you render many +documents in one process, that is the figure that decides how the memory +profile of your program looks. + +Two libraries that appeared in earlier versions of this table, `cheapskate` +and `markdown`, have been dropped: neither has had a release since 2020. + ## Related packages * [`mmark-ext`](https://hackage.haskell.org/package/mmark-ext) contains some @@ -305,4 +278,4 @@ Copyright © 2017–present Mark Karpov -Distributed under BSD 3 clause license. +Distributed under the BSD 3-clause license. diff --git a/Text/MMark.hs b/Text/MMark.hs --- a/Text/MMark.hs +++ b/Text/MMark.hs @@ -10,27 +10,27 @@ -- Portability : portable -- -- MMark (read “em-mark”) is a strict markdown processor for writers. --- “Strict” means that not every input is considered valid markdown document --- and parse errors are possible and even desirable, because they allow us --- to spot markup issues without searching for them in rendered document. If --- a markdown document passes the MMark parser, then it'll likely produce --- HTML without quirks. This feature makes it a good choice for writers and --- bloggers. +-- “Strict” means that not every input is considered a valid markdown +-- document and parse errors are possible and even desirable, because they +-- allow us to spot markup issues without searching for them in the rendered +-- document. If a markdown document passes the MMark parser, then it'll +-- likely produce HTML without quirks. This feature makes it a good choice +-- for writers and bloggers. -- --- === MMark and Common Mark +-- === MMark and CommonMark -- --- MMark mostly tries to follow the Common Mark specification as given here: +-- MMark mostly tries to follow the CommonMark specification as given here: -- --- +-- -- -- However, due to the fact that we do not allow inputs that do not make -- sense, and also try to guard against common mistakes (like writing @##My --- header@ and having it rendered as a paragraph starting with hashes) MMark +-- header@ and having it rendered as a paragraph starting with hashes), MMark -- obviously can't follow the specification precisely. In particular, --- parsing of inlines differs considerably from Common Mark. +-- parsing of inlines is stricter than CommonMark. -- --- Another difference between Common Mark and MMark is that the latter --- supports more (pun alert) common markdown extensions out-of-the-box. In +-- Another difference between CommonMark and MMark is that the latter +-- supports more (pun alert) common markdown extensions out of the box. In -- particular, MMark supports: -- -- * parsing of an optional YAML block @@ -44,7 +44,7 @@ -- built-in features. -- -- The readme contains a more detailed description of differences between --- Common Mark and MMark. +-- CommonMark and MMark. -- -- === How to use the library -- @@ -53,13 +53,17 @@ -- > import Text.MMark (MMark) -- > import qualified Text.MMark as MMark -- --- Working with MMark happens in three stages: +-- Working with MMark happens in four stages: -- --- 1. Parsing of markdown document. --- 2. Applying extensions, which optionally may require scanning of --- previously parsed document (for example to build a table of --- contents). --- 3. Rendering of HTML document. +-- 1. Parsing of a markdown document. +-- 2. Scanning of the parsed document, which is optional and collects +-- whatever a transformation may need to know about the document as a +-- whole (for example to build a table of contents). +-- 3. Applying transformations. A transformation is applied right away +-- and can fail, so this stage produces either a new document or a +-- collection of errors to report. +-- 4. Rendering of an HTML document, optionally augmented by render +-- extensions. -- -- The structure of the documentation below corresponds to these stages and -- should clarify the details. @@ -87,7 +91,7 @@ -- > Left bundle -> putStrLn (M.errorBundlePretty bundle) -- (3) -- > Right r -> TL.writeFile "output.html" -- (6) -- > . L.renderText -- (5) --- > . MMark.render -- (4) +-- > . MMark.render mempty -- (4) -- > $ r -- -- Let's break it down: @@ -98,103 +102,211 @@ -- or succeed returning a value of the opaque 'MMark' type. -- 3. If parsing fails, we pretty-print the parse errors with -- 'Text.Megaparsec.errorBundlePretty'. --- 4. Then we just render the document with 'render' first to Lucid's --- @'Lucid.Html' ()@. --- 5. …and then to lazy 'Data.Text.Lazy.Text' with 'Lucid.renderText'. +-- 4. We render the document with 'render' first to Lucid's +-- @'Lucid.Html' ()@, passing it the render extensions to use, or +-- 'mempty' when there are none. +-- 5. Then we render to lazy 'Data.Text.Lazy.Text' with 'Lucid.renderText'. -- 6. Finally we write the result as @\"output.html\"@. -- -- === Other modules of interest -- -- The "Text.MMark" module contains all the “core” functionality one may -- need. However, one of the main selling points of MMark is that it's --- possible to write your own extensions which stay highly composable (if --- done right), so proliferation of third-party extensions is to be expected --- and encouraged. To write an extension of your own import the --- "Text.MMark.Extension" module, which has some documentation focusing on --- extension writing. +-- possible to write your own extensions, so proliferation of third-party +-- extensions is to be expected and encouraged. To write an extension of +-- your own import "Text.MMark.Trans" if it rewrites the document, or +-- "Text.MMark.Render" if it changes the way the document is rendered. Both +-- modules have documentation focusing on extension writing. module Text.MMark ( -- * Parsing MMark, MMarkErr (..), parse, - -- * Extensions - Extension, - useExtension, - useExtensions, - -- * Scanning + scanner, + scannerM, runScanner, runScannerM, projectYaml, + -- * Transformation + TransT, + Trans, + TransError (..), + runTrans, + runTransM, + runCheck, + runCheckM, + -- * Rendering + RenderExtension, render, ) where import Control.Foldl qualified as L import Data.Aeson +import Data.Functor.Identity (runIdentity) +import Data.Text (Text) import Text.MMark.Internal.Type import Text.MMark.Parser (MMarkErr (..), parse) import Text.MMark.Render (render) +import Text.Megaparsec (ParseErrorBundle) ---------------------------------------------------------------------------- --- Extensions +-- Scanning --- | Apply an 'Extension' to an 'MMark' document. The order in which you --- apply 'Extension's /does matter/. Extensions you apply first take effect --- first. The extension system is designed in such a way that in many cases --- the order doesn't matter, but sometimes the difference is important. -useExtension :: Extension -> MMark -> MMark -useExtension ext mmark = - mmark {mmarkExtension = ext <> mmarkExtension mmark} +-- | Create a 'L.Fold' from an initial state and a folding function. +scanner :: + -- | Initial state + a -> + -- | Folding function + (a -> Bni -> a) -> + -- | Resulting 'L.Fold' + L.Fold Bni a +scanner a f = L.Fold f a id --- | Apply several 'Extension's to an 'MMark' document. --- --- This is a simple shortcut: --- --- > useExtensions exts = useExtension (mconcat exts) +-- | Create a 'L.FoldM' from an initial state and a folding function +-- operating in monadic context. -- --- As mentioned in the docs for 'useExtension', the order in which you apply --- extensions matters. Extensions closer to beginning of the list are --- applied later, i.e. the last extension in the list is applied first. -useExtensions :: [Extension] -> MMark -> MMark -useExtensions exts = useExtension (mconcat exts) - ----------------------------------------------------------------------------- --- Scanning +-- @since 0.0.2.0 +scannerM :: + (Monad m) => + -- | Initial state + m a -> + -- | Folding function + (a -> Bni -> m a) -> + -- | Resulting 'L.FoldM' + L.FoldM m Bni a +scannerM a f = L.FoldM f a return -- | Scan an 'MMark' document efficiently in one pass. This uses the -- excellent 'L.Fold' type, which see. -- --- Take a look at the "Text.MMark.Extension" module if you want to create --- scanners of your own. +-- __Note__: the type of this function changed in /0.1.0.0/. runScanner :: - -- | Document to scan - MMark -> -- | 'L.Fold' to use L.Fold Bni a -> + -- | Document to scan + MMark -> -- | Result of scanning a -runScanner MMark {..} f = L.fold f mmarkBlocks +runScanner f MMark {..} = L.fold f mmarkBlocks -- | Like 'runScanner', but allows us to run scanners with monadic context. -- -- To bring 'L.Fold' and 'L.FoldM' types to the “least common denominator” -- use 'L.generalize' and 'L.simplify'. -- +-- __Note__: the type of this function changed in /0.1.0.0/. +-- -- @since 0.0.2.0 runScannerM :: (Monad m) => - -- | Document to scan - MMark -> -- | 'L.FoldM' to use L.FoldM m Bni a -> + -- | Document to scan + MMark -> -- | Result of scanning m a -runScannerM MMark {..} f = L.foldM f mmarkBlocks +runScannerM f MMark {..} = L.foldM f mmarkBlocks -- | Extract contents of an optional YAML block that may have been parsed. projectYaml :: MMark -> Maybe Value projectYaml = mmarkYaml + +---------------------------------------------------------------------------- +-- Transformation + +-- | Apply a pure transformation to an 'MMark' document, see 'runTransM'. +-- +-- @since 0.1.0.0 +runTrans :: + -- | The transformation to apply to every top-level block + (Bni -> Trans Bni) -> + -- | Document to transform + MMark -> + -- | The transformed document, or the errors the transformation reported + Either (ParseErrorBundle Text TransError) MMark +runTrans f = runIdentity . runTransM f + +-- | Apply a transformation to an 'MMark' document, possibly performing +-- effects along the way. +-- +-- The function is applied to every top-level block of the document as it +-- is; to reach the blocks and inlines nested inside of those, wrap it in +-- one of the transformations from "Text.MMark.Trans", for example +-- 'Text.MMark.Trans.bottomUpBlocks' or +-- 'Text.MMark.Trans.bottomUpInlines'. +-- +-- Several transformations compose with @('Control.Monad.>=>')@ into one, +-- which is then applied in a single pass, and the errors all of them +-- reported are reported together: +-- +-- > let trans = bottomUpInlines checkLinks >=> bottomUpBlocks numberHeadings +-- > r <- runTransM trans doc +-- > case r of +-- > Left errs -> putStr (errorBundlePretty errs) +-- > Right doc' -> TL.putStr (renderText (render mempty doc')) +-- +-- A transformation that 'Text.MMark.Trans.report's an error does not stop +-- the ones that follow it, so a document with several problems in it names +-- them all at once. A transformation that 'Text.MMark.Trans.abort's gives +-- up on the rest of the document, but the errors that were reported before +-- it are still returned. +-- +-- @since 0.1.0.0 +runTransM :: + (Monad m) => + -- | The transformation to apply to every top-level block + (Bni -> TransT m Bni) -> + -- | Document to transform + MMark -> + -- | The transformed document, or the errors the transformation reported + m (Either (ParseErrorBundle Text TransError) MMark) +runTransM f mmark@MMark {..} = + fmap (fmap replaceBlocks) . runTransT mmarkSource $ + traverse f mmarkBlocks + where + replaceBlocks bs = mmark {mmarkBlocks = bs} + +-- | Run a pure check against an 'MMark' document, see 'runCheckM'. +-- +-- @since 0.1.0.0 +runCheck :: + -- | The check to run + Trans a -> + -- | Document to resolve the reported positions against + MMark -> + -- | The result of the check, or the errors it reported + Either (ParseErrorBundle Text TransError) a +runCheck t = runIdentity . runCheckM t + +-- | Run a check against an 'MMark' document, possibly performing effects +-- along the way. +-- +-- Unlike 'runTransM', which is given a function and applies it to every +-- top-level block, this runs the computation once and leaves the document +-- alone. Use it for a check that concerns the document as a whole, so that +-- the check does not have to pretend to be a transformation of a block it +-- has no interest in: +-- +-- > let fns = MMark.runScanner footnoteScanner doc +-- > case MMark.runCheck (validateFootnotes fns) doc of +-- > Left errs -> putStrLn (errorBundlePretty errs) +-- > Right () -> … +-- +-- The document is only needed to turn the offsets of the reported spans +-- back into lines and columns. +-- +-- @since 0.1.0.0 +runCheckM :: + (Monad m) => + -- | The check to run + TransT m a -> + -- | Document to resolve the reported positions against + MMark -> + -- | The result of the check, or the errors it reported + m (Either (ParseErrorBundle Text TransError) a) +runCheckM t MMark {..} = runTransT mmarkSource t diff --git a/Text/MMark/Extension.hs b/Text/MMark/Extension.hs deleted file mode 100644 --- a/Text/MMark/Extension.hs +++ /dev/null @@ -1,174 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - --- | --- Module : Text.MMark.Extension --- Copyright : © 2017–present Mark Karpov --- License : BSD 3 clause --- --- Maintainer : Mark Karpov --- Stability : experimental --- Portability : portable --- --- This module provides building blocks for creation of extensions. --- --- We suggest using a qualified import, like this: --- --- > import Text.MMark.Extension (Bni, Block (..), Inline (..)) --- > import qualified Text.MMark.Extension as Ext --- --- === The philosophy of MMark extensions --- --- The extension system is guided by the following goals: --- --- 1. Make it powerful, so users can write interesting extensions. --- 2. Make it efficient, so every type of transformation is only applied --- once and the number of traversals of the syntax tree stays --- constant no matter how many extensions the user chooses to use and --- how complex they are. --- 3. Make it easy to write extensions that are very focused in what --- they do and do not interfere with each other in weird and --- unexpected ways. --- --- I ruled out allowing users to mess with AST directly pretty quickly --- because it would be against the points 2 and 3. Instead, there are four --- kinds of extension-producing functions. They correspond internally to --- four functions that are applied to the parsed document in turn: --- --- * 'blockTrans' is applied first, as it's quite general and can change --- block-level structure of document as well as inline-level --- structure. --- * 'inlineTrans' is applied to every inline in the document obtained --- in the previous step. --- * 'inlineRender' is applied to every inline; this function produces --- HTML rendition of the inlines and we also preserve the original --- inlines so 'blockRender' can look at it (see 'Ois'). --- * 'blockRender' is applied to every block to obtain HTML rendition of --- the whole document. --- --- When one combines different extensions, extensions of the same kind get --- fused together into a single function. This allows for faster processing --- and constant number of traversals over AST in the end. --- --- One could note that the current design does not allow prepending or --- appending new elements to the AST. This is a limitation by design because --- we try to make the order in which extensions are applied unimportant --- (it's not always possible, though). Thus, if we want to e.g. insert a --- table of contents into a document, we need to do so by transforming an --- already existing element, such as code block with a special info string --- (this is how the extension works in the @mmark-ext@ package). --- --- Another limitation by design is that extensions cannot change how the --- parser works. I find endless syntax-changing (or syntax-augmenting, if --- you will) extensions (as implemented by Pandoc for example) ugly, because --- they erode the familiar markdown syntax and turn it into a monstrosity. --- In MMark we choose a different path of re-purposing existing markdown --- constructs, adding special meaning to them in certain situations. --- --- === Room for improvement --- --- One flaw of the current system is that it does not allow reporting --- errors, so we have to silently fallback to some default behavior when we --- can't apply an extension in a meaningful way. Such extension-produced --- errors obviously should contain their positions in the original markdown --- input, which would require us storing this information in AST in some --- way. I'm not sure if the additional complexity (and possible performance --- trade-offs) is really worth it, so it hasn't been implemented so far. -module Text.MMark.Extension - ( -- * Extension construction - Extension, - - -- ** Block-level manipulation - Bni, - Block (..), - CellAlign (..), - blockTrans, - blockRender, - Ois, - getOis, - - -- ** Inline-level manipulation - Inline (..), - inlineTrans, - inlineRender, - - -- * Scanner construction - scanner, - scannerM, - - -- * Utils - asPlainText, - headerId, - headerFragment, - ) -where - -import Control.Foldl qualified as L -import Data.Monoid hiding ((<>)) -import Lucid -import Text.MMark.Internal.Type -import Text.MMark.Util - --- | Create an extension that performs a transformation on 'Block's of --- markdown document. Since a block may contain other blocks we choose to --- perform transformations from the most deeply nested blocks moving --- upwards. This has the benefit that the result of any transformation is --- final in the sense that sub-elements of resulting block won't be --- traversed again. -blockTrans :: (Bni -> Bni) -> Extension -blockTrans f = mempty {extBlockTrans = Endo f} - --- | Create an extension that replaces or augments rendering of 'Block's of --- markdown document. The argument of 'blockRender' will be given the --- rendering function constructed so far @'Block' ('Ois', 'Html' ()) -> --- 'Html' ()@ as well as an actual block to render—@'Block' ('Ois', 'Html' --- ())@. The user can then decide whether to replace\/reuse that function to --- get the final rendering of the type @'Html' ()@. --- --- The argument of 'blockRender' can also be thought of as a function that --- transforms the rendering function constructed so far: --- --- > (Block (Ois, Html ()) -> Html ()) -> (Block (Ois, Html ()) -> Html ()) --- --- See also: 'Ois' and 'getOis'. -blockRender :: - ((Block (Ois, Html ()) -> Html ()) -> Block (Ois, Html ()) -> Html ()) -> - Extension -blockRender f = mempty {extBlockRender = Render f} - --- | Create an extension that performs a transformation on 'Inline' --- components in entire markdown document. Similarly to 'blockTrans' the --- transformation is applied from the most deeply nested elements moving --- upwards. -inlineTrans :: (Inline -> Inline) -> Extension -inlineTrans f = mempty {extInlineTrans = Endo f} - --- | Create an extension that replaces or augments rendering of 'Inline's of --- markdown document. This works like 'blockRender'. -inlineRender :: - ((Inline -> Html ()) -> Inline -> Html ()) -> - Extension -inlineRender f = mempty {extInlineRender = Render f} - --- | Create a 'L.Fold' from an initial state and a folding function. -scanner :: - -- | Initial state - a -> - -- | Folding function - (a -> Bni -> a) -> - -- | Resulting 'L.Fold' - L.Fold Bni a -scanner a f = L.Fold f a id - --- | Create a 'L.FoldM' from an initial state and a folding function --- operating in monadic context. --- --- @since 0.0.2.0 -scannerM :: - (Monad m) => - -- | Initial state - m a -> - -- | Folding function - (a -> Bni -> m a) -> - -- | Resulting 'L.FoldM' - L.FoldM m Bni a -scannerM a f = L.FoldM f a return diff --git a/Text/MMark/Internal/Type.hs b/Text/MMark/Internal/Type.hs --- a/Text/MMark/Internal/Type.hs +++ b/Text/MMark/Internal/Type.hs @@ -2,7 +2,12 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_HADDOCK not-home #-} -- | -- Module : Text.MMark.Internal.Type @@ -14,17 +19,34 @@ -- Portability : portable -- -- Internal type definitions. The public subset of these is re-exported from --- "Text.MMark.Extension". +-- "Text.MMark.Trans" and "Text.MMark.Render". -- -- @since 0.0.8.0 module Text.MMark.Internal.Type - ( MMark (..), - Extension (..), - Render (..), + ( -- * Documents + MMark (..), Bni, Block (..), CellAlign (..), Inline (..), + Span (..), + spanUnion, + blockSpan, + setBlockSpan, + inlineSpan, + setInlineSpan, + + -- * The transformation monad + TransT, + Trans, + runTransT, + report, + abort, + TransError (..), + + -- * Rendering + RenderExtension (..), + Render (..), Ois, mkOisInternal, getOis, @@ -32,27 +54,36 @@ where import Control.DeepSeq +import Control.Monad.Except +import Control.Monad.State.Strict import Data.Aeson import Data.Data (Data) -import Data.Function (on) +import Data.Functor.Identity (Identity) +import Data.List (sortOn) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Monoid hiding ((<>)) +import Data.List.NonEmpty qualified as NE +import Data.Set qualified as E import Data.Text (Text) -import Data.Typeable (Typeable) +import Data.Text qualified as T import GHC.Generics import Lucid +import Text.Megaparsec import Text.URI (URI (..)) --- | Representation of complete markdown document. You can't look inside of --- 'MMark' on purpose. The only way to influence an 'MMark' document you +---------------------------------------------------------------------------- +-- Documents + +-- | Representation of a complete markdown document. You can't look inside +-- of 'MMark' on purpose. The only way to influence an 'MMark' document you -- obtain as a result of parsing is via the extension mechanism. data MMark = MMark { -- | Parsed YAML document at the beginning (optional) mmarkYaml :: Maybe Value, -- | Actual contents of the document mmarkBlocks :: [Bni], - -- | Extension specifying how to process and render the blocks - mmarkExtension :: Extension + -- | The state that allows us to turn the offsets in 'Span's back into + -- lines and columns when an extension reports an error + mmarkSource :: PosState Text } instance NFData MMark where @@ -64,72 +95,6 @@ instance Show MMark where show = const "MMark {..}" --- | An extension. You can apply extensions with 'Text.MMark.useExtension' --- and 'Text.MMark.useExtensions' functions. The "Text.MMark.Extension" --- module provides tools for writing your own extensions. --- --- Note that 'Extension' is an instance of 'Semigroup' and 'Monoid', i.e. --- you can combine several extensions into one. Since the @('<>')@ operator --- is right-associative and 'mconcat' is a right fold under the hood, the --- expression --- --- > l <> r --- --- means that the extension @r@ will be applied before the extension @l@, --- similar to how 'Endo' works. This may seem counter-intuitive, but only --- with this logic we get consistency of ordering with more complex --- expressions: --- --- > e2 <> e1 <> e0 == e2 <> (e1 <> e0) --- --- Here, @e0@ will be applied first, then @e1@, then @e2@. The same applies --- to expressions involving 'mconcat'—extensions closer to beginning of the --- list passed to 'mconcat' will be applied later. -data Extension = Extension - { -- | Block transformation - extBlockTrans :: Endo Bni, - -- | Block render - extBlockRender :: Render (Block (Ois, Html ())), - -- | Inline transformation - extInlineTrans :: Endo Inline, - -- | Inline render - extInlineRender :: Render Inline - } - -instance Semigroup Extension where - x <> y = - Extension - { extBlockTrans = on (<>) extBlockTrans x y, - extBlockRender = on (<>) extBlockRender x y, - extInlineTrans = on (<>) extInlineTrans x y, - extInlineRender = on (<>) extInlineRender x y - } - -instance Monoid Extension where - mempty = - Extension - { extBlockTrans = mempty, - extBlockRender = mempty, - extInlineTrans = mempty, - extInlineRender = mempty - } - mappend = (<>) - --- | An internal type that captures the extensible rendering process we use. --- 'Render' has a function inside which transforms a rendering function of --- the type @a -> Html ()@. --- --- @since 0.0.8.0 -newtype Render a = Render - {runRender :: (a -> Html ()) -> a -> Html ()} - -instance Semigroup (Render a) where - Render f <> Render g = Render (f . g) - -instance Monoid (Render a) where - mempty = Render id - mappend = (<>) - -- | A shortcut for the frequently used type @'Block' ('NonEmpty' -- 'Inline')@. type Bni = Block (NonEmpty Inline) @@ -142,33 +107,38 @@ -- -- We can divide blocks into two types: container blocks, which can contain -- other blocks, and leaf blocks, which cannot. +-- +-- Every constructor carries the 'Span' of the source it derives from as its +-- first argument, see 'blockSpan'. +-- +-- __Note__: the constructors of this type changed in the version /0.1.0.0/. data Block a = -- | Thematic break, leaf block - ThematicBreak + ThematicBreak Span | -- | Heading (level 1), leaf block - Heading1 a + Heading1 Span a | -- | Heading (level 2), leaf block - Heading2 a + Heading2 Span a | -- | Heading (level 3), leaf block - Heading3 a + Heading3 Span a | -- | Heading (level 4), leaf block - Heading4 a + Heading4 Span a | -- | Heading (level 5), leaf block - Heading5 a + Heading5 Span a | -- | Heading (level 6), leaf block - Heading6 a + Heading6 Span a | -- | Code block, leaf block with info string and contents - CodeBlock (Maybe Text) Text + CodeBlock Span (Maybe Text) Text | -- | Naked content, without an enclosing tag - Naked a + Naked Span a | -- | Paragraph, leaf block - Paragraph a + Paragraph Span a | -- | Blockquote container block - Blockquote [Block a] + Blockquote Span [Block a] | -- | Ordered list ('Word' is the start index), container block - OrderedList Word (NonEmpty [Block a]) + OrderedList Span Word (NonEmpty [Block a]) | -- | Unordered list, container block - UnorderedList (NonEmpty [Block a]) + UnorderedList Span (NonEmpty [Block a]) | -- | Table, first argument is the alignment options, then we have a -- 'NonEmpty' list of rows, where every row is a 'NonEmpty' list of -- cells, where every cell is an @a@ thing. @@ -177,8 +147,8 @@ -- support cannot lack a header row. -- -- @since 0.0.4.0 - Table (NonEmpty CellAlign) (NonEmpty (NonEmpty a)) - deriving (Show, Eq, Ord, Data, Typeable, Generic, Functor, Foldable) + Table Span (NonEmpty CellAlign) (NonEmpty (NonEmpty a)) + deriving (Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable) instance (NFData a) => NFData (Block a) @@ -194,35 +164,290 @@ CellAlignRight | -- | Center-alignment CellAlignCenter - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) instance NFData CellAlign -- | Inline markdown content. +-- +-- Every constructor carries the 'Span' of the source it derives from as its +-- first argument, see 'inlineSpan'. +-- +-- __Note__: the constructors of this type changed in the version /0.1.0.0/. data Inline = -- | Plain text - Plain Text + Plain Span Text | -- | Line break (hard) - LineBreak + LineBreak Span | -- | Emphasis - Emphasis (NonEmpty Inline) + Emphasis Span (NonEmpty Inline) | -- | Strong emphasis - Strong (NonEmpty Inline) + Strong Span (NonEmpty Inline) | -- | Strikeout - Strikeout (NonEmpty Inline) + Strikeout Span (NonEmpty Inline) | -- | Subscript - Subscript (NonEmpty Inline) + Subscript Span (NonEmpty Inline) | -- | Superscript - Superscript (NonEmpty Inline) + Superscript Span (NonEmpty Inline) | -- | Code span - CodeSpan Text + CodeSpan Span Text | -- | Link with text, destination, and optionally title - Link (NonEmpty Inline) URI (Maybe Text) + Link Span (NonEmpty Inline) URI (Maybe Text) | -- | Image with description, URL, and optionally title - Image (NonEmpty Inline) URI (Maybe Text) - deriving (Show, Eq, Ord, Data, Typeable, Generic) + Image Span (NonEmpty Inline) URI (Maybe Text) + deriving (Show, Eq, Ord, Data, Generic) instance NFData Inline + +-- | A region of the source document. +-- +-- A 'Span' is the region of the source that a node __derives from__, not +-- necessarily the region it was parsed from. A node that an extension +-- creates in place of another one inherits its 'Span', and a node that an +-- extension assembles from several others should be given the 'spanUnion' +-- of their spans. This way every node in a transformed document can still +-- say which part of the input it came from, which is what makes it possible +-- to report extension errors against the source. +-- +-- @since 0.1.0.0 +data Span = Span + { -- | Offset of the first character of the region + spanStart :: !Int, + -- | Offset just past the last character of the region + spanEnd :: !Int + } + deriving (Show, Eq, Ord, Data, Generic) + +instance NFData Span + +-- | The smallest 'Span' that covers both of its arguments. +-- +-- @since 0.1.0.0 +spanUnion :: Span -> Span -> Span +spanUnion (Span a b) (Span c d) = Span (min a c) (max b d) + +-- | @since 0.1.0.0 +instance Semigroup Span where + (<>) = spanUnion + +-- | Project the annotation of a 'Block'. +-- +-- @since 0.1.0.0 +blockSpan :: Block a -> Span +blockSpan = \case + ThematicBreak spn -> spn + Heading1 spn _ -> spn + Heading2 spn _ -> spn + Heading3 spn _ -> spn + Heading4 spn _ -> spn + Heading5 spn _ -> spn + Heading6 spn _ -> spn + CodeBlock spn _ _ -> spn + Naked spn _ -> spn + Paragraph spn _ -> spn + Blockquote spn _ -> spn + OrderedList spn _ _ -> spn + UnorderedList spn _ -> spn + Table spn _ _ -> spn + +-- | Replace the annotation of a 'Block', leaving the annotations of the +-- blocks it contains alone. +-- +-- @since 0.1.0.0 +setBlockSpan :: Span -> Block a -> Block a +setBlockSpan spn = \case + ThematicBreak _ -> ThematicBreak spn + Heading1 _ a -> Heading1 spn a + Heading2 _ a -> Heading2 spn a + Heading3 _ a -> Heading3 spn a + Heading4 _ a -> Heading4 spn a + Heading5 _ a -> Heading5 spn a + Heading6 _ a -> Heading6 spn a + CodeBlock _ mi txt -> CodeBlock spn mi txt + Naked _ a -> Naked spn a + Paragraph _ a -> Paragraph spn a + Blockquote _ xs -> Blockquote spn xs + OrderedList _ w xs -> OrderedList spn w xs + UnorderedList _ xs -> UnorderedList spn xs + Table _ ca xs -> Table spn ca xs + +-- | Project the annotation of an 'Inline'. +-- +-- @since 0.1.0.0 +inlineSpan :: Inline -> Span +inlineSpan = \case + Plain spn _ -> spn + LineBreak spn -> spn + Emphasis spn _ -> spn + Strong spn _ -> spn + Strikeout spn _ -> spn + Subscript spn _ -> spn + Superscript spn _ -> spn + CodeSpan spn _ -> spn + Link spn _ _ _ -> spn + Image spn _ _ _ -> spn + +-- | Replace the annotation of an 'Inline', leaving the annotations of the +-- inlines it contains alone. +-- +-- @since 0.1.0.0 +setInlineSpan :: Span -> Inline -> Inline +setInlineSpan spn = \case + Plain _ txt -> Plain spn txt + LineBreak _ -> LineBreak spn + Emphasis _ xs -> Emphasis spn xs + Strong _ xs -> Strong spn xs + Strikeout _ xs -> Strikeout spn xs + Subscript _ xs -> Subscript spn xs + Superscript _ xs -> Superscript spn xs + CodeSpan _ txt -> CodeSpan spn txt + Link _ xs uri mt -> Link spn xs uri mt + Image _ xs uri mt -> Image spn xs uri mt + +---------------------------------------------------------------------------- +-- The transformation monad + +-- | The monad a transformation runs in. It gives a transformation a way to +-- report errors, see 'report' and 'abort', and it is a monad transformer, +-- so a transformation that needs to perform effects can have them. +-- +-- @since 0.1.0.0 +newtype TransT m a + = TransT (ExceptT Abort (StateT [ParseError Text TransError] m) a) + deriving (Functor, Applicative, Monad, MonadIO) + +-- | The signal 'abort' raises. It carries nothing, because the error that +-- caused it has already been recorded. +data Abort = Abort + +instance MonadTrans TransT where + lift = TransT . lift . lift + +-- | The non-transformer version of 'TransT'. +-- +-- @since 0.1.0.0 +type Trans = TransT Identity + +-- | Run a transformation, collecting the errors it reported. Errors +-- accumulate, so an extension that checks something about every node +-- reports every node that fails the check rather than only the first. +-- +-- @since 0.1.0.0 +runTransT :: + (Monad m) => + -- | The state to resolve the offsets in reported errors against + PosState Text -> + -- | The extension to run + TransT m a -> + m (Either (ParseErrorBundle Text TransError) a) +runTransT pstate (TransT m) = do + (r, errs) <- runStateT (runExceptT m) [] + -- A 'ParseErrorBundle' has to be sorted by offset, otherwise + -- 'errorBundlePretty' cannot go back for the source line of an error that + -- precedes the one before it and shows the wrong line. A transformation + -- reports in whatever order suits it, so we sort here. The sort is + -- stable, so errors at the same offset stay in the order in which they + -- were reported. + let sorted = sortOn errorOffset (reverse errs) + return $ case (NE.nonEmpty sorted, r) of + (Just errs', _) -> Left (bundle errs') + (Nothing, Left Abort) -> Left (bundle (unknown :| [])) + (Nothing, Right x) -> Right x + where + bundle errs' = + ParseErrorBundle + { bundleErrors = errs', + bundlePosState = pstate + } + unknown = + FancyError 0 (E.singleton (ErrorCustom (TransError "extension failed"))) + +-- | Report an error at the given 'Span' and carry on. Use this when the +-- rest of the document can still be processed, so that the user is told +-- about every problem at once instead of the first one only. +-- +-- @since 0.1.0.0 +report :: (Monad m) => Span -> Text -> TransT m () +report Span {..} msg = + TransT . lift . modify' $ + (FancyError spanStart (E.singleton (ErrorCustom (TransError msg))) :) + +-- | Report an error at the given 'Span' and give up on the document. Errors +-- reported before this one are preserved. +-- +-- @since 0.1.0.0 +abort :: (Monad m) => Span -> Text -> TransT m a +abort spn msg = report spn msg >> TransT (throwError Abort) + +-- | The error a transformation reports, see 'report' and 'abort'. The +-- errors of a transformation are collected in a @'ParseErrorBundle' 'Text' +-- 'TransError'@, the same type the parser produces, so 'errorBundlePretty' +-- renders them against the source of the document just like it renders +-- parse errors. +-- +-- @since 0.1.0.0 +newtype TransError = TransError Text + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData TransError + +instance ShowErrorComponent TransError where + showErrorComponent (TransError txt) = T.unpack txt + +---------------------------------------------------------------------------- +-- Rendering + +-- | A rendering extension. Unlike transformations, which are applied to a +-- document right away with 'Text.MMark.runTrans' and friends, renders can +-- only be applied while the document is being turned into HTML, so they are +-- collected in a value of this type and handed to 'Text.MMark.render'. +-- +-- Note that 'RenderExtension' is an instance of 'Semigroup' and 'Monoid', +-- i.e. you can combine several render extensions into one. Since the +-- @('<>')@ operator is right-associative and 'mconcat' is a right fold +-- under the hood, the expression +-- +-- > l <> r +-- +-- means that the extension @r@ will be applied before the extension @l@. +-- +-- @since 0.1.0.0 +data RenderExtension = RenderExtension + { -- | Block render + extBlockRender :: Render (Block (Ois, Html ())), + -- | Inline render + extInlineRender :: Render Inline + } + +instance Semigroup RenderExtension where + x <> y = + RenderExtension + { extBlockRender = extBlockRender x <> extBlockRender y, + extInlineRender = extInlineRender x <> extInlineRender y + } + +instance Monoid RenderExtension where + mempty = + RenderExtension + { extBlockRender = mempty, + extInlineRender = mempty + } + mappend = (<>) + +-- | An internal type that captures the extensible rendering process we use. +-- 'Render' has a function inside which transforms a rendering function of +-- the type @a -> Html ()@. +-- +-- @since 0.0.8.0 +newtype Render a = Render + {runRender :: (a -> Html ()) -> a -> Html ()} + +instance Semigroup (Render a) where + Render f <> Render g = Render (f . g) + +instance Monoid (Render a) where + mempty = Render id + mappend = (<>) -- | A wrapper for “original inlines”. Source inlines are wrapped in this -- during rendering of inline components and then it's available to block diff --git a/Text/MMark/Parser.hs b/Text/MMark/Parser.hs --- a/Text/MMark/Parser.hs +++ b/Text/MMark/Parser.hs @@ -34,6 +34,7 @@ import Data.DList qualified as DList import Data.HTML.Entities (htmlEntityMap) import Data.HashMap.Strict qualified as HM +import Data.List (delete) import Data.List.NonEmpty (NonEmpty (..), (<|)) import Data.List.NonEmpty qualified as NE import Data.Maybe (catMaybes, fromJust, isJust, isNothing) @@ -60,36 +61,6 @@ #endif ---------------------------------------------------------------------------- --- Auxiliary data types - --- | Frame that describes where we are in parsing inlines. -data InlineFrame - = -- | Emphasis with asterisk @*@ - EmphasisFrame - | -- | Emphasis with underscore @_@ - EmphasisFrame_ - | -- | Strong emphasis with asterisk @**@ - StrongFrame - | -- | Strong emphasis with underscore @__@ - StrongFrame_ - | -- | Strikeout - StrikeoutFrame - | -- | Subscript - SubscriptFrame - | -- | Superscript - SuperscriptFrame - deriving (Eq, Ord, Show) - --- | State of inline parsing that specifies whether we expect to close one --- frame or there is a possibility to close one of two alternatives. -data InlineState - = -- | One frame to be closed - SingleFrame InlineFrame - | -- | Two frames to be closed - DoubleFrame InlineFrame InlineFrame - deriving (Eq, Ord, Show) - ----------------------------------------------------------------------------- -- Top-level API -- | Parse a markdown document in the form of a strict 'Text' value and @@ -117,22 +88,33 @@ MMark { mmarkYaml = myaml, mmarkBlocks = fmap fromRight <$> parsed, - mmarkExtension = mempty + mmarkSource = initialPosState file input } Just errs -> Left ParseErrorBundle { bundleErrors = errs, - bundlePosState = - PosState - { pstateInput = input, - pstateOffset = 0, - pstateSourcePos = initialPos file, - pstateTabWidth = mkPos 4, - pstateLinePrefix = "" - } + bundlePosState = initialPosState file input } +-- | The 'PosState' that lets us render errors against the source, both the +-- parser's own and the ones extensions report later on. +initialPosState :: FilePath -> Text -> PosState Text +initialPosState file input = + PosState + { pstateInput = input, + pstateOffset = 0, + pstateSourcePos = initialPos file, + pstateTabWidth = mkPos 4, + pstateLinePrefix = "" + } + +-- | The placeholder that block and inline parsers construct their results +-- with. 'pBlock' and 'pInlines' replace it with the real span of the source +-- the node was parsed from. +noSpan :: Span +noSpan = Span 0 0 + ---------------------------------------------------------------------------- -- Block parser @@ -169,16 +151,31 @@ -- | Parse several (possibly zero) blocks in a row. pBlocks :: BParser [Block Isp] -pBlocks = catMaybes <$> many pBlock +pBlocks = scQ *> (catMaybes <$> many pBlock) --- | Parse a single block of markdown document. +-- | Parse a single block of a markdown document, recording the span of the +-- source it was parsed from. pBlock :: BParser (Maybe (Block Isp)) pBlock = do - sc + o <- getOffset + r <- pBlock' + o' <- getOffset + return (setBlockSpan (Span o o') <$> r) + +-- | Parse a single block of a markdown document. +pBlock' :: BParser (Maybe (Block Isp)) +pBlock' = do rlevel <- refLevel - alevel <- L.indentLevel + alevel <- indentLevel' done <- atEnd - if done || alevel < rlevel + -- 'scQ' stops in front of a line ending when the next line does not + -- continue the block quote we are in, and it does not move at all when the + -- line we are on is not a part of it either. Both mean that the block + -- quote ends here. + inQuote <- quoteOk + atLineEnd <- succeeds (void (lookAhead eol)) + let quoteEnded = not inQuote || atLineEnd + if done || quoteEnded || alevel < rlevel then empty else case compare alevel (ilevel rlevel) of LT -> @@ -186,10 +183,13 @@ [ Just <$> pThematicBreak, Just <$> pAtxHeading, Just <$> pFencedCodeBlock, + -- NOTE This has to be tried before 'pTable', otherwise a line + -- such as @> | a | b |@ is taken for the header of a table + -- whose first cell happens to begin with a @>@ character. + Just <$> pBlockquote, Just <$> pTable, Just <$> pUnorderedList, Just <$> pOrderedList, - Just <$> pBlockquote, pReferenceDef, Just <$> pParagraph ] @@ -206,7 +206,7 @@ || T.all (== '-') l || T.all (== '_') l ) - then ThematicBreak <$ nonEmptyLine <* sc + then ThematicBreak noSpan <$ nonEmptyLine <* scQ else empty -- | Parse an ATX heading. @@ -219,28 +219,38 @@ ispOffset <- getOffset r <- someTill (satisfy notNewline "heading character") . try $ - optional (sc1' *> some (char '#') *> sc') *> (eof <|> eol) + optional (sc1' *> some (char '#') *> sc') + *> (eof <|> void (lookAhead eol)) let toBlock = case hlevel of - 1 -> Heading1 - 2 -> Heading2 - 3 -> Heading3 - 4 -> Heading4 - 5 -> Heading5 - _ -> Heading6 - toBlock (IspSpan ispOffset (T.strip (T.pack r))) <$ sc + 1 -> Heading1 noSpan + 2 -> Heading2 noSpan + 3 -> Heading3 noSpan + 4 -> Heading4 noSpan + 5 -> Heading5 noSpan + _ -> Heading6 noSpan + toBlock (IspSpan ispOffset (T.strip (T.pack r))) <$ scQ where hashIntro = count' 1 6 (char '#') recover err = - Heading1 (IspError err) <$ takeWhileP Nothing notNewline <* sc + Heading1 noSpan (IspError err) <$ takeWhileP Nothing notNewline <* scQ -- | Parse a fenced code block. pFencedCodeBlock :: BParser (Block Isp) pFencedCodeBlock = do - alevel <- L.indentLevel + alevel <- indentLevel' (ch, n, infoString) <- pOpeningFence - let content = label "code block content" (option "" nonEmptyLine <* eol) + let content = label "code block content" $ do + quoteOk >>= guard + l <- option "" nonEmptyLine + done <- atEnd + -- The last line of the input may lack a line ending, but only when + -- it is not empty, otherwise we would keep producing empty lines + -- forever. + let lastLine = done && not (T.null l) + unless lastLine eolLazy + return l ls <- manyTill content (pClosingFence ch n) - CodeBlock infoString (assembleCodeBlock alevel ls) <$ sc + CodeBlock noSpan infoString (assembleCodeBlock alevel ls) <$ scQ -- | Parse the opening fence of a fenced code block. pOpeningFence :: BParser (Char, Int, Maybe Text) @@ -252,7 +262,10 @@ ml <- optional (T.strip <$> someEscapedWith notNewline "info string") - guard (maybe True (not . T.any (== '`')) ml) + -- A backtick in the info string of a backtick fence would be + -- ambiguous with the fence itself. Tilde fences have no such problem. + when (ch == '`') $ + guard (maybe True (not . T.any (== '`')) ml) ( ch, n, case ml of @@ -262,31 +275,41 @@ then Nothing else Just l ) - <$ eol + <$ eolLazy -- | Parse the closing fence of a fenced code block. pClosingFence :: Char -> Int -> BParser () -pClosingFence ch n = try . label "closing code fence" $ do +pClosingFence ch n = tryB . label "closing code fence" $ do + quoteOk >>= guard clevel <- ilevel <$> refLevel - void $ L.indentGuard sc' LT clevel + sc' + alevel <- indentLevel' + guard (alevel < clevel) void $ count n (char ch) (void . many . char) ch sc' - eof <|> eol + eof <|> eolLazy -- | Parse an indented code block. pIndentedCodeBlock :: BParser (Block Isp) pIndentedCodeBlock = do - alevel <- L.indentLevel + alevel <- indentLevel' clevel <- ilevel <$> refLevel let go ls = do - indented <- - lookAhead $ - (>= clevel) <$> (sc *> L.indentLevel) + indented <- lookAheadB $ do + scQ + inQuote <- quoteOk + done <- atEnd + atLineEnd <- succeeds (void (lookAhead eol)) + if not inQuote || done || atLineEnd + then return False + else do + nextLevel <- indentLevel' + return (nextLevel >= clevel) if indented then do l <- option "" nonEmptyLine - continue <- eol' + continue <- eolLazy' let ls' = ls . (l :) if continue then go ls' @@ -300,26 +323,28 @@ g [] = [] g (x : xs) = f x : xs ls <- g . ($ []) <$> go id - CodeBlock Nothing (assembleCodeBlock clevel ls) <$ sc + CodeBlock noSpan Nothing (assembleCodeBlock clevel ls) <$ scQ --- | Parse an unorederd list. +-- | Parse an unordered list. pUnorderedList :: BParser (Block Isp) pUnorderedList = do (bullet, bulletPos, minLevel, indLevel) <- pListBullet Nothing x <- innerBlocks bulletPos minLevel indLevel xs <- many $ do + -- A list cannot continue past the end of the block quote it is in. + quoteOk >>= guard (_, bulletPos', minLevel', indLevel') <- pListBullet (Just (bullet, bulletPos)) innerBlocks bulletPos' minLevel' indLevel' - return (UnorderedList (normalizeListItems (x :| xs))) + UnorderedList noSpan (normalizeListItems (x :| xs)) <$ scQ where innerBlocks bulletPos minLevel indLevel = do - p <- getSourcePos + p <- sourcePos' let tooFar = sourceLine p > sourceLine bulletPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel - then return [bool Naked Paragraph tooFar emptyIspSpan] + then return [bool Naked Paragraph tooFar noSpan emptyIspSpan] else subEnv True rlevel pBlocks -- | Parse a list bullet. Return a tuple with the following components (in @@ -333,17 +358,17 @@ -- | Bullet 'Char' and start position of the first bullet in a list Maybe (Char, SourcePos) -> BParser (Char, SourcePos, Pos, Pos) -pListBullet mbullet = try $ do - pos <- getSourcePos - l <- (<> mkPos 2) <$> L.indentLevel +pListBullet mbullet = tryB $ do + pos <- sourcePos' + l <- (<> mkPos 2) <$> indentLevel' bullet <- case mbullet of Nothing -> char '-' <|> char '+' <|> char '*' Just (bullet, bulletPos) -> do guard (sourceColumn pos >= sourceColumn bulletPos) char bullet - eof <|> sc1 - l' <- L.indentLevel + eof <|> sc1Q + l' <- indentLevel' return (bullet, pos, l, l') -- | Parse an ordered list. @@ -354,6 +379,8 @@ pListIndex Nothing x <- innerBlocks startPos minLevel indLevel xs <- manyIndexed (startIx + 1) $ \expectedIx -> do + -- A list cannot continue past the end of the block quote it is in. + quoteOk >>= guard startOffset' <- getOffset (actualIx, _, startPos', minLevel', indLevel') <- pListIndex (Just (del, startPos)) @@ -366,19 +393,21 @@ (ListIndexOutOfOrder actualIx expectedIx) blocks f <$> innerBlocks startPos' minLevel' indLevel' - return . OrderedList startIx . normalizeListItems $ - ( if startIx <= 999999999 - then x - else prependErr startOffset (ListStartIndexTooBig startIx) x + ( OrderedList noSpan startIx . normalizeListItems $ + ( if startIx <= 999999999 + then x + else prependErr startOffset (ListStartIndexTooBig startIx) x + ) + :| xs ) - :| xs + <$ scQ where innerBlocks indexPos minLevel indLevel = do - p <- getSourcePos + p <- sourcePos' let tooFar = sourceLine p > sourceLine indexPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel - then return [bool Naked Paragraph tooFar emptyIspSpan] + then return [bool Naked Paragraph tooFar noSpan emptyIspSpan] else subEnv True rlevel pBlocks -- | Parse a list index. Return a tuple with the following components (in @@ -393,49 +422,44 @@ -- | Delimiter 'Char' and start position of the first index in a list Maybe (Char, SourcePos) -> BParser (Word, Char, SourcePos, Pos, Pos) -pListIndex mstart = try $ do - pos <- getSourcePos +pListIndex mstart = tryB $ do + pos <- sourcePos' i <- L.decimal del <- case mstart of Nothing -> char '.' <|> char ')' Just (del, startPos) -> do guard (sourceColumn pos >= sourceColumn startPos) char del - l <- (<> pos1) <$> L.indentLevel - eof <|> sc1 - l' <- L.indentLevel + l <- (<> pos1) <$> indentLevel' + eof <|> sc1Q + l' <- indentLevel' return (i, del, pos, l, l') -- | Parse a block quote. pBlockquote :: BParser (Block Isp) pBlockquote = do - minLevel <- try $ do - minLevel <- (<> pos1) <$> L.indentLevel - void (char '>') - eof <|> sc - l <- L.indentLevel - return $ - if l > minLevel - then minLevel <> pos1 - else minLevel - indLevel <- L.indentLevel - if indLevel >= minLevel - then do - let rlevel = slevel minLevel indLevel - xs <- subEnv False rlevel pBlocks - return (Blockquote xs) - else return (Blockquote []) + -- The marker that opens the block quote is consumed here, the markers + -- that continue it on the following lines are consumed by 'eolQ' and + -- friends, which know how many of them to expect from 'quoteDepth'. + ls <- try (pQuoteMarkersAll 1) + ldepth <- lineDepth + setLineState (mkLineState (ldepth + 1) (ls ^. lsBase)) + -- The content of a block quote always starts in the first (virtual) + -- column of the quote, whatever the width of the marker on any particular + -- line. + xs <- subQuote (subEnv False pos1 pBlocks) + Blockquote noSpan xs <$ scQ -- | Parse a link\/image reference definition and register it. pReferenceDef :: BParser (Maybe (Block Isp)) pReferenceDef = do (o, dlabel) <- try (pRefLabel <* char ':') withRecovery recover $ do - sc' <* optional eol <* sc' + sc' <* optional eolQ <* sc' uri <- pUri hadSpN <- optional $ - (sc1' *> option False (True <$ eol)) <|> (True <$ (sc' <* eol)) + (sc1' *> option False (True <$ eolQ)) <|> (True <$ (sc' <* eolQ)) sc' mtitle <- if isJust hadSpN @@ -443,20 +467,20 @@ else return Nothing case (hadSpN, mtitle) of (Just True, Nothing) -> return () - _ -> hidden eof <|> eol + _ -> hidden eof <|> void (lookAhead eol) conflict <- registerReference dlabel (uri, mtitle) when conflict $ customFailure' o (DuplicateReferenceDefinition dlabel) - Nothing <$ sc + Nothing <$ scQ where recover err = - Just (Naked (IspError err)) <$ takeWhileP Nothing notNewline <* sc + Just (Naked noSpan (IspError err)) <$ takeWhileP Nothing notNewline <* scQ -- | Parse a pipe table. pTable :: BParser (Block Isp) pTable = do - (n, headerRow) <- try $ do - pos <- L.indentLevel + (n, headerRow) <- tryB $ do + pos <- indentLevel' option False (T.any (== '|') <$> lookAhead nonEmptyLine) >>= guard let pipe' = option False (True <$ pipe) l <- pipe' @@ -464,8 +488,8 @@ r <- pipe' let n = NE.length headerRow guard (n > 1 || l || r) - eol <* sc' - L.indentLevel >>= \i -> guard (i == pos || i == (pos <> pos1)) + eolQ <* sc' + indentLevel' >>= \i -> guard (i == pos || i == (pos <> pos1)) lookAhead nonEmptyLine >>= guard . isHeaderLike return (n, headerRow) withRecovery recover $ do @@ -474,7 +498,7 @@ otherRows <- many $ do endOfTable >>= guard . not rowWrapper (NE.fromList <$> sepByCount n cell pipe) - Table caligns (headerRow :| otherRows) <$ sc + Table noSpan caligns (headerRow :| otherRows) <$ scQ where cell = do o <- getOffset @@ -490,7 +514,7 @@ void (optional pipe) r <- p void (optional pipe) - eof <|> eol + eof <|> eolLazy sc' return r pipe = char '|' <* sc' @@ -511,14 +535,17 @@ > 8 % 10 isHeaderConstituent x = isSpace x || x == '|' || x == '-' || x == ':' - endOfTable = - lookAhead (option True (isBlank <$> nonEmptyLine)) + endOfTable = do + inQuote <- quoteOk + if inQuote + then lookAhead (option True (isBlank <$> nonEmptyLine)) + else return True recover err = - Naked (IspError (replaceEof "end of table block" err)) + Naked noSpan (IspError (replaceEof "end of table block" err)) <$ manyTill (optional nonEmptyLine) (endOfTable >>= guard) - <* sc + <* scQ -- | Parse a paragraph or naked text (in some cases). pParagraph :: BParser (Block Isp) @@ -526,13 +553,20 @@ startOffset <- getOffset allowNaked <- isNakedAllowed rlevel <- refLevel - let go ls = do + let go ls pad = do l <- lookAhead (option "" nonEmptyLine) - broken <- succeeds . lookAhead . try $ do - sc - alevel <- L.indentLevel - guard (alevel < ilevel rlevel) - unless (alevel < rlevel) . choice $ + -- A line that does not carry all the block quote markers it should + -- may still continue this paragraph: CommonMark calls such lines + -- lazy continuation lines. Since the missing markers are simply + -- assumed to be there, such a line is judged as if it were at the + -- top level of the document. + lazy <- not <$> quoteOk + let rlevel' = if lazy then pos1 else rlevel + broken <- succeeds . lookAheadB $ do + sc' + alevel <- indentLevel' + guard (alevel < ilevel rlevel') + unless (alevel < rlevel') . choice $ [ void (char '>'), void pThematicBreak, void pAtxHeading, @@ -541,28 +575,179 @@ void (pListIndex Nothing) ] if isBlank l - then return (ls, Paragraph) + then return (ls, Paragraph noSpan) else if broken - then return (ls, Naked) + then return (ls, Naked noSpan) else do void nonEmptyLine - continue <- eol' - let ls' = ls . (l :) - if continue - then go ls' - else return (ls', Naked) + mpad <- eolLazyPad + let ls' = ls . ((pad <> l) :) + case mpad of + Just pad' -> go ls' pad' + Nothing -> return (ls', Naked noSpan) l <- nonEmptyLine - continue <- eol' + mpad <- eolLazyPad (ls, toBlock) <- - if continue - then go id - else return (id, Naked) - (if allowNaked then toBlock else Paragraph) + case mpad of + Just pad -> go id pad + Nothing -> return (id, Naked noSpan) + (if allowNaked then toBlock else Paragraph noSpan) (IspSpan startOffset (assembleParagraph (l : ls []))) - <$ sc + <$ scQ ---------------------------------------------------------------------------- +-- Block quote prefixes and virtual columns + +-- Every line inside a block quote must begin with a @>@ marker per level of +-- nesting (CommonMark calls this the block quote's continuation). Since the +-- markers may be of different width on different lines, the block parser +-- cannot work with real columns; instead it works with /virtual/ columns +-- which are obtained by subtracting from a real column the width of the +-- block quote markers of the line in question, see @bstLineBase@. At the +-- top level of a document the two coincide. + +-- | Convert a real column into a virtual one. +toVirtual :: Pos -> Pos -> Pos +toVirtual base c = mkPos (max 1 (unPos c - unPos base + 1)) + +-- | Like 'L.indentLevel', but the level is virtual. +indentLevel' :: BParser Pos +indentLevel' = toVirtual <$> lineBase <*> L.indentLevel + +-- | Like 'getSourcePos', but 'sourceColumn' of the result is virtual. +sourcePos' :: BParser SourcePos +sourcePos' = do + base <- lineBase + p <- getSourcePos + return p {sourceColumn = toVirtual base (sourceColumn p)} + +-- | Consume up to the given number of block quote markers starting at the +-- beginning of the current line. Return the number of markers that were +-- found and the column at which the content of the line begins. This does +-- not update 'LineState', it is up to the caller to do that once it has +-- decided to commit to the result. +pQuoteMarkers :: Int -> BParser LineState +pQuoteMarkers n = go 0 pos1 + where + go !k base + | k >= n = return (mkLineState k base) + | otherwise = do + r <- optional . try . label "block quote marker" $ do + c0 <- L.indentLevel + sc' + c1 <- L.indentLevel + -- Just like the other block level constructs, a block quote + -- marker may be preceded by up to three spaces. + guard (unPos c1 - unPos c0 < 4) + void (char '>') + c2 <- L.indentLevel + -- A single space after the marker is a part of it. A tab is not + -- consumed, but one column of it belongs to the marker all the + -- same, which is why we only shift the base here. + padded <- + option False . choice $ + [ True <$ char ' ', + True <$ lookAhead (char '\t') + ] + return (if padded then c2 <> pos1 else c2) + case r of + Nothing -> return (mkLineState k base) + Just base' -> go (k + 1) base' + +-- | Like 'pQuoteMarkers', but fail unless all the markers are found. Since +-- some of them may have been consumed before the failure, this should be +-- used inside 'try'. +pQuoteMarkersAll :: Int -> BParser LineState +pQuoteMarkersAll n = do + ls <- pQuoteMarkers n + guard (ls ^. lsDepth == n) + return ls + +-- | Check that the line we are on begins with all the block quote markers +-- that the current container requires. +quoteOk :: BParser Bool +quoteOk = (>=) <$> lineDepth <*> quoteDepth + +-- | Cross a line ending and consume the block quote markers of the new +-- line. Fail without consuming input if the line ending is not there or the +-- new line does not begin with all the required markers. +eolQ :: BParser () +eolQ = do + d <- quoteDepth + ls <- try (eol *> pQuoteMarkersAll d) + setLineState ls + +-- | Cross a line ending and consume as many of the block quote markers of +-- the new line as happen to be there. This is what makes lazy continuation +-- lines possible: the caller can inspect 'lineDepth' and decide for itself +-- whether the missing markers matter. +eolLazy :: BParser () +eolLazy = do + d <- quoteDepth + void eol + ls <- pQuoteMarkers d + setLineState ls + +-- | 'eolLazy' returning 'False' instead of failing at the end of input. +eolLazy' :: BParser Bool +eolLazy' = option False (True <$ eolLazy) + +-- | Like 'eolLazy'', but instead of a 'Bool' return the block quote markers +-- of the new line replaced by that many spaces. Paragraphs collect their +-- lines with this padding in place of the markers so that the offsets inside +-- the collected text still match the original input. +eolLazyPad :: BParser (Maybe Text) +eolLazyPad = optional $ do + d <- quoteDepth + void eol + o <- getOffset + ls <- pQuoteMarkers d + setLineState ls + o' <- getOffset + return (T.replicate (o' - o) " ") + +-- | White space, including blank lines, the block quote markers of every +-- line we cross being consumed. Stops before a line ending that is not +-- followed by the required markers, as well as when the line we are on does +-- not belong to the current block quote in the first place. +scQ :: BParser () +scQ = do + inQuote <- quoteOk + sc' + when inQuote . void . many $ eolQ <* sc' + +-- | 'scQ' that requires at least some white space to be consumed. +sc1Q :: BParser () +sc1Q = do + o <- getOffset + scQ + o' <- getOffset + guard (o' > o) + +-- | Like 'try', but 'LineState' is restored in case of failure too. Parsers +-- that consume block quote markers and may fail afterwards must use this, +-- because 'LineState' lives in the state monad underlying 'BParser' and so +-- is not subject to backtracking. +tryB :: BParser a -> BParser a +tryB m = do + ls <- getLineState + observing (try m) >>= \case + Right x -> return x + Left err -> do + setLineState ls + parseError err + +-- | Like 'lookAhead', but 'LineState' is restored as well and failure never +-- consumes input. +lookAheadB :: BParser a -> BParser a +lookAheadB m = do + ls <- getLineState + r <- observing (lookAhead (try m)) + setLineState ls + either parseError return r + +---------------------------------------------------------------------------- -- Auxiliary block-level parsers -- | 'match' a code span, this is a specialised and adjusted version of @@ -590,7 +775,7 @@ eof <|> void pLfdr return inlines --- | Parse inlines using settings from given 'InlineConfig'. +-- | Parse inlines using the settings in the inline parser state. pInlines :: IParser (NonEmpty Inline) pInlines = do done <- atEnd @@ -598,38 +783,48 @@ if done then if allowsEmpty - then (return . nes . Plain) "" + then (return . nes . Plain noSpan) "" else unexpEic EndOfInput else NE.some $ do - mch <- lookAhead (anySingle "inline content") - case mch of - '`' -> pCodeSpan - '[' -> do - allowsLinks <- isLinksAllowed - if allowsLinks - then pLink - else unexpEic (Tokens $ nes '[') - '!' -> do - gotImage <- (succeeds . void . lookAhead . string) "![" - allowsImages <- isImagesAllowed - if gotImage - then - if allowsImages - then pImage - else unexpEic (Tokens . NE.fromList $ "![") - else pPlain - '<' -> do - allowsLinks <- isLinksAllowed - if allowsLinks - then try pAutolink <|> pPlain - else pPlain - '\\' -> - try pHardLineBreak <|> pPlain - ch -> - if isFrameConstituent ch - then pEnclosedInline - else pPlain + o <- getOffset + r <- pInline + o' <- getOffset + return (setInlineSpan (Span o o') r) +-- | Parse a single inline of a markdown document. +pInline :: IParser Inline +pInline = do + mch <- lookAhead (anySingle "inline content") + case mch of + '`' -> pCodeSpan + '[' -> do + allowsLinks <- isLinksAllowed + if allowsLinks + then pLink + else unexpEic (Tokens $ nes '[') + '!' -> do + gotImage <- (succeeds . void . lookAhead . string) "![" + allowsImages <- isImagesAllowed + if gotImage + then + if allowsImages + then pImage + else unexpEic (Tokens . NE.fromList $ "![") + else pPlain + '<' -> do + allowsLinks <- isLinksAllowed + if allowsLinks + then try pAutolink <|> pPlain + else pPlain + '\\' -> + try pHardLineBreak <|> pPlain + ch -> + if isFrameConstituent ch + then do + literal <- lookingAtWordUnderscores + if literal then pPlain else pEnclosedInline + else pPlain + -- | Parse a code span. -- -- See also: 'pCodeSpanB'. @@ -640,7 +835,7 @@ void $ count n (char '`') notFollowedBy (char '`') r <- - CodeSpan . collapseWhiteSpace . T.concat + CodeSpan noSpan . normalizeCodeSpan . T.concat <$> manyTill ( label "code span content" $ takeWhile1P Nothing (== '`') @@ -654,26 +849,26 @@ pLink = do void (char '[') o <- getOffset - txt <- disallowLinks (disallowEmpty pInlines) + txt <- outsideFrames (disallowLinks (disallowEmpty pInlines)) void (char ']') (dest, mtitle) <- pLocation o txt - Link txt dest mtitle <$ lastChar OtherChar + Link noSpan txt dest mtitle <$ lastChar OtherChar -- | Parse an image. pImage :: IParser Inline pImage = do (pos, alt) <- emptyAlt <|> nonEmptyAlt (src, mtitle) <- pLocation pos alt - Image alt src mtitle <$ lastChar OtherChar + Image noSpan alt src mtitle <$ lastChar OtherChar where emptyAlt = do o <- getOffset void (string "![]") - return (o + 2, nes (Plain "")) + return (o + 2, nes (Plain noSpan "")) nonEmptyAlt = do void (string "![") o <- getOffset - alt <- disallowImages (disallowEmpty pInlines) + alt <- outsideFrames (disallowImages (disallowEmpty pInlines)) void (char ']') return (o, alt) @@ -685,35 +880,37 @@ let (txt, uri) = case isEmailUri uri' of Nothing -> - ( (nes . Plain . URI.render) uri', + ( (nes . Plain noSpan . URI.render) uri', uri' ) Just email -> - ( nes (Plain email), + ( nes (Plain noSpan email), URI.makeAbsolute mailtoScheme uri' ) - Link txt uri Nothing <$ lastChar OtherChar + Link noSpan txt uri Nothing <$ lastChar OtherChar -- | Parse inline content inside an enclosing construction such as emphasis, -- strikeout, superscript, and\/or subscript markup. pEnclosedInline :: IParser Inline -pEnclosedInline = - disallowEmpty $ - pLfdr >>= \case - SingleFrame x -> - liftFrame x <$> pInlines <* pRfdr x - DoubleFrame x y -> do - inlines0 <- pInlines - thisFrame <- pRfdr x <|> pRfdr y - let thatFrame = if thisFrame == x then y else x - minlines1 <- optional pInlines - void (pRfdr thatFrame) - return . liftFrame thatFrame $ - case minlines1 of - Nothing -> - nes (liftFrame thisFrame inlines0) - Just inlines1 -> - liftFrame thisFrame inlines0 <| inlines1 +pEnclosedInline = disallowEmpty $ do + frames <- pLfdr + inlines <- insideFrames frames pInlines + go frames inlines + where + -- The frames of one group close in whatever order the closing runs + -- dictate, and the one that closes first ends up innermost. This is + -- what makes both @***foo** bar*@ and @***foo* bar**@ work. + go frames inlines = do + frame <- choice (pRfdr <$> frames) + let frames' = delete frame frames + inline = liftFrame frame inlines + if null frames' + then return inline + else do + minlines <- optional (insideFrames frames' pInlines) + go frames' $ case minlines of + Nothing -> nes inline + Just inlines' -> inline <| inlines' -- | Parse a hard line break. pHardLineBreak :: IParser Inline @@ -723,11 +920,11 @@ notFollowedBy eof sc' lastChar SpaceChar - return LineBreak + return (LineBreak noSpan) -- | Parse plain text. pPlain :: IParser Inline -pPlain = fmap (Plain . bakeText) . foldSome $ do +pPlain = fmap (Plain noSpan . bakeText) . foldSome $ do ch <- lookAhead (anySingle "inline content") let newline' = (('\n' :) . dropWhile isSpace) <$ eol <* sc' <* lastChar SpaceChar @@ -754,6 +951,14 @@ (:) <$> char '&' ] <* lastChar PunctChar + '_' -> do + literal <- lookingAtWordUnderscores + if literal + then do + run <- takeWhile1P Nothing (== '_') + lastChar OtherChar + return ((++) (reverse (T.unpack run))) + else unexpEic (Tokens (nes ch)) _ -> (:) <$> if Char.isSpace ch @@ -765,7 +970,7 @@ (Just . Tokens . nes $ ch) (E.singleton . Label . NE.fromList $ "inline content") else - if Char.isPunctuation ch + if isPunctuationChar ch then char ch <* lastChar PunctChar else char ch <* lastChar OtherChar @@ -857,36 +1062,50 @@ void (char ']') return (o, dlabel) --- | Parse an opening markup sequence corresponding to given 'InlineState'. -pLfdr :: IParser InlineState +-- | Parse an opening markup sequence, that is, a delimiter run that opens a +-- group of inline frames. The whole run is consumed, however long it is. +pLfdr :: IParser [InlineFrame] pLfdr = try $ do o <- getOffset - let r st = st <$ string (inlineStateDel st) - st <- - hidden $ - choice - [ r (DoubleFrame StrongFrame StrongFrame), - r (DoubleFrame StrongFrame EmphasisFrame), - r (SingleFrame StrongFrame), - r (SingleFrame EmphasisFrame), - r (DoubleFrame StrongFrame_ StrongFrame_), - r (DoubleFrame StrongFrame_ EmphasisFrame_), - r (SingleFrame StrongFrame_), - r (SingleFrame EmphasisFrame_), - r (DoubleFrame StrikeoutFrame StrikeoutFrame), - r (DoubleFrame StrikeoutFrame SubscriptFrame), - r (SingleFrame StrikeoutFrame), - r (SingleFrame SubscriptFrame), - r (SingleFrame SuperscriptFrame) - ] - let dels = inlineStateDel st - failNow = - customFailure' o (NonFlankingDelimiterRun (toNesTokens dels)) + (ch, run, rch) <- lookAhead $ do + ch <- satisfy isFrameConstituent + run <- T.cons ch <$> takeWhileP Nothing (== ch) + rch <- getNextChar OtherChar + return (ch, run, rch) + let failNow e = customFailure' o (e (toNesTokens run)) + open = runFrames ch (T.length run) <$ takeWhile1P Nothing (== ch) lch <- getLastChar - rch <- getNextChar OtherChar - when (lch >= rch) failNow - return st + frames <- getFrames + case flanking lch rch of + OpensFrame -> + open + NotFlanking -> + failNow NonFlankingDelimiterRun + ClosesFrame -> + if null frames + then failNow UnmatchedClosingDelimiterRun + else empty + AmbiguousFrame -> + if closesFrames run frames + then empty + else open +-- | The frames that a delimiter run of the given character and length +-- opens, in the order in which we prefer to close them. Preferring the +-- longer delimiters is what puts the strong emphasis inside the emphasis in +-- @***foo***@ and, more generally, leaves the odd delimiter of a run on the +-- outside. +runFrames :: Char -> Int -> [InlineFrame] +runFrames ch n = case ch of + '*' -> pairsThenSingle StrongFrame EmphasisFrame + '_' -> pairsThenSingle StrongFrame_ EmphasisFrame_ + '~' -> pairsThenSingle StrikeoutFrame SubscriptFrame + '^' -> replicate n SuperscriptFrame + _ -> [] + where + pairsThenSingle paired odd' = + replicate (n `div` 2) paired ++ replicate (n `mod` 2) odd' + -- | Parse a closing markup sequence corresponding to given 'InlineFrame'. pRfdr :: InlineFrame -> IParser InlineFrame pRfdr frame = try $ do @@ -902,9 +1121,41 @@ customFailure' o (NonFlankingDelimiterRun (toNesTokens dels)) lch <- getLastChar rch <- getNextChar SpaceChar - when (lch <= rch) failNow - return frame + case flanking lch rch of + ClosesFrame -> return frame + -- We only get here when 'pLfdr' has already decided that an ambiguous + -- run closes the frame we are in. + AmbiguousFrame -> return frame + _ -> failNow +-- | Check whether the given delimiter run is exactly what the given open +-- frames are waiting for, innermost first. A run that closes a frame only +-- partially, as the @**@ does in @*foo**bar**baz*@, is not a closing run: +-- there it opens strong emphasis inside the emphasis instead. +closesFrames :: Text -> [InlineFrame] -> Bool +closesFrames dels = \case + [] -> False + f : fs -> + case T.stripPrefix (inlineFrameDel f) dels of + Nothing -> False + Just dels' -> T.null dels' || closesFrames dels' fs + +-- | Check whether the input begins with a run of underscores that has word +-- characters on both sides. Underscores are common inside words, so such a +-- run is not markup at all but literal text; this is the one place where a +-- markup character does not have to be escaped to be taken literally. +lookingAtWordUnderscores :: IParser Bool +lookingAtWordUnderscores = do + lch <- getLastChar + if lch /= OtherChar + then return False + else lookAhead . option False $ do + void (takeWhile1P Nothing (== '_')) + -- Markup characters do not count as word characters here: in + -- @*_foo_*@ the closing @_@ is markup, not part of a word. + rch <- getNextChar SpaceChar + return (rch == OtherChar) + -- | Get 'CharType' of the next char in the input stream. getNextChar :: -- | What we should consider frame constituent characters @@ -916,7 +1167,7 @@ | isFrameConstituent ch = frameType | Char.isSpace ch = SpaceChar | ch == '\\' = OtherChar - | Char.isPunctuation ch = PunctChar + | isPunctuationChar ch = PunctChar | otherwise = OtherChar ---------------------------------------------------------------------------- @@ -1034,9 +1285,6 @@ string "\r" ] -eol' :: (MonadParsec e Text m) => m Bool -eol' = option False (True <$ eol) - ---------------------------------------------------------------------------- -- Char classification @@ -1072,6 +1320,13 @@ isSpecialChar :: Char -> Bool isSpecialChar x = isMarkupChar x || x == '\\' || x == '!' || x == '<' +-- | Check whether the character is a punctuation character in the sense of +-- the CommonMark specification, which counts the Unicode symbol categories +-- as punctuation in addition to the punctuation categories proper. This is +-- what @$@ in @*$*alpha@ is: emphasis cannot hang on it. +isPunctuationChar :: Char -> Bool +isPunctuationChar x = Char.isPunctuation x || Char.isSymbol x + isAsciiPunctuation :: Char -> Bool isAsciiPunctuation x = (x >= '!' && x <= '/') @@ -1112,45 +1367,39 @@ go [x] = T.dropWhileEnd isSpace x go (x : xs) = x <> "\n" <> go xs -collapseWhiteSpace :: Text -> Text -collapseWhiteSpace = - T.stripEnd . T.filter (/= '\0') . snd . T.mapAccumL f True +-- | Normalize the contents of a code span the way the CommonMark +-- specification prescribes: every line ending becomes a space, and when the +-- result both begins and ends with a space but does not consist of spaces +-- alone, one space is removed from each end. Everything else is preserved +-- verbatim, so a code span is the one place where the exact spelling of the +-- input survives. +-- +-- The indentation of a continuation line goes with its line ending because +-- it belongs to the block that contains the paragraph, not to the code +-- span: it is the indentation of a list item or the padding that replaced +-- the markers of a block quote. +normalizeCodeSpan :: Text -> Text +normalizeCodeSpan txt = + if padded && not (T.all (== ' ') oneLine) + then (T.init . T.tail) oneLine + else oneLine where - f seenSpace ch = - case (seenSpace, g ch) of - (False, False) -> (False, ch) - (True, False) -> (False, ch) - (False, True) -> (True, ' ') - (True, True) -> (True, '\0') - g ' ' = True - g '\t' = True - g '\n' = True - g _ = False - -inlineStateDel :: InlineState -> Text -inlineStateDel = \case - SingleFrame x -> inlineFrameDel x - DoubleFrame x y -> inlineFrameDel x <> inlineFrameDel y + padded = " " `T.isPrefixOf` oneLine && " " `T.isSuffixOf` oneLine + oneLine = T.intercalate " " (unindent (T.splitOn "\n" unified)) + unindent = \case + [] -> [] + x : xs -> x : fmap (T.dropWhile isSpace) xs + unified = T.replace "\r" "\n" (T.replace "\r\n" "\n" txt) liftFrame :: InlineFrame -> NonEmpty Inline -> Inline liftFrame = \case - StrongFrame -> Strong - EmphasisFrame -> Emphasis - StrongFrame_ -> Strong - EmphasisFrame_ -> Emphasis - StrikeoutFrame -> Strikeout - SubscriptFrame -> Subscript - SuperscriptFrame -> Superscript - -inlineFrameDel :: InlineFrame -> Text -inlineFrameDel = \case - EmphasisFrame -> "*" - EmphasisFrame_ -> "_" - StrongFrame -> "**" - StrongFrame_ -> "__" - StrikeoutFrame -> "~~" - SubscriptFrame -> "~" - SuperscriptFrame -> "^" + StrongFrame -> Strong noSpan + EmphasisFrame -> Emphasis noSpan + StrongFrame_ -> Strong noSpan + EmphasisFrame_ -> Emphasis noSpan + StrikeoutFrame -> Strikeout noSpan + SubscriptFrame -> Subscript noSpan + SuperscriptFrame -> Superscript noSpan replaceEof :: String -> ParseError Text e -> ParseError Text e replaceEof altLabel = \case @@ -1172,8 +1421,8 @@ else Nothing _ -> Nothing --- | Decode the yaml block to a 'Aeson.Value'. On GHCJs, without access to --- libyaml we just return an empty object. It's worth using a pure haskell +-- | Decode the yaml block to an 'Aeson.Value'. On GHCJS, without access to +-- libyaml, we just return an empty object. It's worth using a pure Haskell -- parser later if this is unacceptable for someone's needs. decodeYaml :: [T.Text] -> Int -> (Either (Int, String) Aeson.Value) #ifdef ghcjs_HOST_OS @@ -1236,20 +1485,20 @@ (x :| xs) = r xs' r = NE.reverse . fmap reverse isParagraph = \case - OrderedList _ _ -> False - UnorderedList _ -> False - Naked _ -> False + OrderedList {} -> False + UnorderedList {} -> False + Naked {} -> False _ -> True - toParagraph (Naked inner) = Paragraph inner + toParagraph (Naked ann inner) = Paragraph ann inner toParagraph other = other - toNaked (Paragraph inner) = Naked inner + toNaked (Paragraph ann inner) = Naked ann inner toNaked other = other succeeds :: (Alternative m) => m () -> m Bool succeeds m = True <$ m <|> pure False prependErr :: Int -> MMarkErr -> [Block Isp] -> [Block Isp] -prependErr o custom blocks = Naked (IspError err) : blocks +prependErr o custom blocks = Naked noSpan (IspError err) : blocks where err = FancyError o (E.singleton $ ErrorCustom custom) diff --git a/Text/MMark/Parser/Internal.hs b/Text/MMark/Parser/Internal.hs --- a/Text/MMark/Parser/Internal.hs +++ b/Text/MMark/Parser/Internal.hs @@ -18,6 +18,16 @@ isNakedAllowed, refLevel, subEnv, + quoteDepth, + subQuote, + LineState, + mkLineState, + lsDepth, + lsBase, + getLineState, + setLineState, + lineDepth, + lineBase, registerReference, -- * Inline-level parser monad @@ -31,9 +41,16 @@ isImagesAllowed, getLastChar, lastChar, + getFrames, + insideFrames, + outsideFrames, lookupReference, Isp (..), CharType (..), + Flanking (..), + flanking, + InlineFrame (..), + inlineFrameDel, -- * Reference and footnote definitions Defs, @@ -86,7 +103,7 @@ isNakedAllowed :: BParser Bool isNakedAllowed = gets (^. bstAllowNaked) --- | Lookup current reference indentation level. +-- | Look up the current reference indentation level. refLevel :: BParser Pos refLevel = gets (^. bstRefLevel) @@ -104,6 +121,36 @@ locally bstAllowNaked allowNaked . locally bstRefLevel rlevel +-- | Look up the number of block quote markers the lines of the current +-- container are required to begin with. +quoteDepth :: BParser Int +quoteDepth = gets (^. bstQuoteDepth) + +-- | Execute a 'BParser' computation inside one more level of block quote. +subQuote :: BParser a -> BParser a +subQuote m = do + d <- quoteDepth + locally bstQuoteDepth (d + 1) m + +-- | Get 'LineState'. Note that it is not restored on backtracking +-- automatically, so parsers that may fail after having changed it should +-- take care of that themselves. +getLineState :: BParser LineState +getLineState = gets (^. bstLineState) + +-- | Set 'LineState'. +setLineState :: LineState -> BParser () +setLineState = modify' . set bstLineState + +-- | Look up the number of block quote markers found at the beginning of the +-- current line. +lineDepth :: BParser Int +lineDepth = gets (^. bstLineState . lsDepth) + +-- | Look up the column at which the content of the current line begins. +lineBase :: BParser Pos +lineBase = gets (^. bstLineState . lsBase) + -- | Register a reference (link\/image) definition. registerReference :: -- | Reference name @@ -190,7 +237,23 @@ lastChar = modify' . set istLastChar {-# INLINE lastChar #-} --- | Lookup a link\/image reference definition. +-- | Get the inline frames that are currently open, innermost first. +getFrames :: IParser [InlineFrame] +getFrames = gets (view istFrames) + +-- | Run a parser with the given frames opened, innermost first. +insideFrames :: [InlineFrame] -> IParser a -> IParser a +insideFrames frames m = do + frames' <- getFrames + locally istFrames (frames ++ frames') m + +-- | Run a parser with no frame open at all. An inline frame cannot span the +-- boundary of a link's text or an image's description, so a delimiter run +-- inside one of those cannot close a frame that was opened outside of it. +outsideFrames :: IParser a -> IParser a +outsideFrames = locally istFrames [] + +-- | Look up a link\/image reference definition. lookupReference :: -- | Reference name Text -> @@ -199,7 +262,7 @@ IParser (Either [Text] (URI, Maybe Text)) lookupReference = lookupGeneric referenceDefs --- | A generic function for looking up definition in 'IParser'. +-- | A generic function for looking up a definition in 'IParser'. lookupGeneric :: -- | How to access the definition map Lens' Defs (HashMap DefLabel a) -> diff --git a/Text/MMark/Parser/Internal/Type.hs b/Text/MMark/Parser/Internal/Type.hs --- a/Text/MMark/Parser/Internal/Type.hs +++ b/Text/MMark/Parser/Internal/Type.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- | @@ -20,8 +21,17 @@ initialBlockState, bstAllowNaked, bstRefLevel, + bstQuoteDepth, + bstLineState, bstDefs, + -- * Line state + LineState, + initialLineState, + mkLineState, + lsDepth, + lsBase, + -- * Inline-level parser state InlineState, initialInlineState, @@ -29,10 +39,17 @@ istAllowEmpty, istAllowLinks, istAllowImages, + istFrames, istDefs, Isp (..), CharType (..), + Flanking (..), + flanking, + -- * Inline frames + InlineFrame (..), + inlineFrameDel, + -- * Reference and footnote definitions Defs, referenceDefs, @@ -58,7 +75,6 @@ import Data.Proxy import Data.Text (Text) import Data.Text qualified as T -import Data.Typeable (Typeable) import GHC.Generics import Lens.Micro.TH import Text.Megaparsec @@ -70,12 +86,18 @@ -- | Block-level parser state. data BlockState = BlockState { -- | Should we consider a paragraph that does not end with a blank line - -- 'Naked'? It does not make sense to do so in the top-level document, - -- but in lists, 'Naked' text is pretty common. + -- 'Text.MMark.Internal.Type.Naked'? It does not make sense to do so in + -- the top-level document, but in lists, naked text is pretty common. _bstAllowNaked :: Bool, -- | Current reference level: 1 column for top-level of document, column - -- where content starts for block quotes and lists. + -- where content starts for block quotes and lists. Note that this is a + -- /virtual/ column, i.e. it is relative to @bstLineBase@. _bstRefLevel :: Pos, + -- | The number of block quote markers that the lines of the current + -- container are required to begin with. + _bstQuoteDepth :: Int, + -- | Facts about the line we are currently on. + _bstLineState :: LineState, -- | Reference and footnote definitions _bstDefs :: Defs } @@ -86,10 +108,49 @@ BlockState { _bstAllowNaked = False, _bstRefLevel = pos1, + _bstQuoteDepth = 0, + _bstLineState = initialLineState, _bstDefs = emptyDefs } ---------------------------------------------------------------------------- +-- Line state + +-- | Facts about the line the parser is currently on. Unlike the rest of +-- 'BlockState' these are tied to the position in the input, so they have to +-- be restored whenever that position is restored. +data LineState = LineState + { -- | The number of block quote markers that were actually found at the + -- beginning of the line. When it is less than @bstQuoteDepth@ the + -- innermost block quotes have ended (or, in the case of a paragraph, + -- are being continued lazily). + _lsDepth :: Int, + -- | The (real) column at which the content of the line begins, that is, + -- the column just after its block quote markers. Virtual columns, which + -- is what the block parser works with, are obtained by subtracting this + -- value from real columns. + _lsBase :: Pos + } + +-- | Initial value for 'LineState': the first line of a document carries no +-- block quote markers. +initialLineState :: LineState +initialLineState = mkLineState 0 pos1 + +-- | Smart constructor for the 'LineState' type. +mkLineState :: + -- | The number of block quote markers found at the beginning of the line + Int -> + -- | The column at which the content of the line begins + Pos -> + LineState +mkLineState depth base = + LineState + { _lsDepth = depth, + _lsBase = base + } + +---------------------------------------------------------------------------- -- Inline-level parser state -- | Inline-level parser state. @@ -102,6 +163,10 @@ _istAllowLinks :: Bool, -- | Whether to allow parsing of images _istAllowImages :: Bool, + -- | The inline frames that are currently open, innermost first. A + -- delimiter run that could both open or close a frame is resolved by + -- looking at this stack. + _istFrames :: [InlineFrame], -- | Reference link definitions _istDefs :: Defs } @@ -114,10 +179,11 @@ _istAllowEmpty = True, _istAllowLinks = True, _istAllowImages = True, + _istFrames = [], _istDefs = emptyDefs } --- | 'Inline' source pending parsing. +-- | 'Text.MMark.Internal.Type.Inline' source pending parsing. data Isp = -- | We have an inline source pending parsing IspSpan Int Text @@ -125,7 +191,9 @@ IspError (ParseError Text MMarkErr) deriving (Eq, Show) --- | Type of the last seen character. +-- | Type of the last seen character. The 'Ord' instance orders the +-- constructors by how “solid” the characters are, which is what the +-- classification of delimiter runs is based on, see 'flanking'. data CharType = -- | White space or a transparent character SpaceChar @@ -135,7 +203,72 @@ OtherChar deriving (Eq, Ord, Show) +-- | What a delimiter run can do to the stack of open inline frames. +data Flanking + = -- | The run can only open a frame + OpensFrame + | -- | The run can only close a frame + ClosesFrame + | -- | The run could do either, so the frames that are currently open have + -- to decide + AmbiguousFrame + | -- | The run can do neither, which is always an error + NotFlanking + deriving (Eq, Show) + +-- | Classify a delimiter run by the characters that surround it. A run that +-- leans towards the more solid of its two neighbours (see the 'Ord' +-- instance of 'CharType') hangs on that side of the word and so opens or +-- closes a frame accordingly. When both neighbors are equally solid the run +-- leans nowhere: white space on both sides means it cannot be markup at +-- all, anything else means it could go either way. +flanking :: + -- | Type of the character to the left of the run + CharType -> + -- | Type of the character to the right of the run + CharType -> + Flanking +flanking lch rch = case compare lch rch of + LT -> OpensFrame + GT -> ClosesFrame + EQ -> + if lch == SpaceChar + then NotFlanking + else AmbiguousFrame + ---------------------------------------------------------------------------- +-- Inline frames + +-- | Frame that describes where we are in parsing inlines. +data InlineFrame + = -- | Emphasis with asterisk @*@ + EmphasisFrame + | -- | Emphasis with underscore @_@ + EmphasisFrame_ + | -- | Strong emphasis with asterisk @**@ + StrongFrame + | -- | Strong emphasis with underscore @__@ + StrongFrame_ + | -- | Strikeout + StrikeoutFrame + | -- | Subscript + SubscriptFrame + | -- | Superscript + SuperscriptFrame + deriving (Eq, Ord, Show) + +-- | The delimiter that opens and closes the given 'InlineFrame'. +inlineFrameDel :: InlineFrame -> Text +inlineFrameDel = \case + EmphasisFrame -> "*" + EmphasisFrame_ -> "_" + StrongFrame -> "**" + StrongFrame_ -> "__" + StrikeoutFrame -> "~~" + SubscriptFrame -> "~" + SuperscriptFrame -> "^" + +---------------------------------------------------------------------------- -- Reference and footnote definitions -- | An opaque container for reference and footnote definitions. @@ -176,8 +309,8 @@ -- -- @since 0.0.2.0 ListStartIndexTooBig Word - | -- | The index in an ordered list is out of order, first number is the - -- actual index we ran into, the second number is the expected index + | -- | The index in an ordered list is out of order; the first number is + -- the actual index we ran into, the second number is the expected index -- -- @since 0.0.2.0 ListIndexOutOfOrder Word Word @@ -198,7 +331,12 @@ -- -- @since 0.0.3.0 UnknownHtmlEntityName Text - deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) + | -- | This delimiter run can only close an inline frame, but there is no + -- frame for it to close + -- + -- @since 0.1.0.0 + UnmatchedClosingDelimiterRun (NonEmpty Char) + deriving (Eq, Ord, Show, Read, Generic, Data) instance ShowErrorComponent MMarkErr where showErrorComponent = \case @@ -236,6 +374,9 @@ "invalid numeric character: " ++ show n UnknownHtmlEntityName name -> "unknown HTML5 entity name: \"" ++ T.unpack name ++ "\"" + UnmatchedClosingDelimiterRun dels -> + showTokens (Proxy :: Proxy Text) dels + ++ " does not have a matching opening delimiter run" instance NFData MMarkErr @@ -250,5 +391,6 @@ -- Lens TH makeLenses ''BlockState +makeLenses ''LineState makeLenses ''InlineState makeLenses ''Defs diff --git a/Text/MMark/Render.hs b/Text/MMark/Render.hs --- a/Text/MMark/Render.hs +++ b/Text/MMark/Render.hs @@ -11,16 +11,48 @@ -- Stability : experimental -- Portability : portable -- --- MMark rendering machinery. +-- Everything needed to write a render extension, that is, an extension that +-- changes the way an element of a markdown document is turned into HTML. -- +-- A render extension cannot be applied ahead of time, because it needs the +-- rendering function it is wrapping, so renders are collected in a +-- 'RenderExtension' value and given to 'render'. A render cannot fail. +-- Anything that can fail belongs in a transformation, see +-- "Text.MMark.Trans". +-- -- @since 0.0.8.0 module Text.MMark.Render - ( render, + ( -- * Rendering + RenderExtension, + render, + + -- * Render extension construction + blockRender, + inlineRender, + Ois, + getOis, + + -- * Documents + Bni, + Block (..), + CellAlign (..), + Inline (..), + Span (..), + blockSpan, + inlineSpan, + + -- * Rendering machinery + Render (..), applyBlockRender, defaultBlockRender, applyInlineRender, defaultInlineRender, newline, + + -- * Utils + asPlainText, + headerId, + headerFragment, ) where @@ -33,31 +65,29 @@ import Data.Text qualified as T import Lucid import Text.MMark.Internal.Type -import Text.MMark.Trans import Text.MMark.Util import Text.URI qualified as URI --- | Render a 'MMark' markdown document. You can then render @'Html' ()@ to +-- | Render an 'MMark' markdown document. You can then render @'Html' ()@ to -- various things: -- --- * to lazy 'Data.Taxt.Lazy.Text' with 'renderText' +-- * to lazy 'Data.Text.Lazy.Text' with 'renderText' -- * to lazy 'Data.ByteString.Lazy.ByteString' with 'renderBS' -- * directly to file with 'renderToFile' -render :: MMark -> Html () -render MMark {..} = +-- +-- __Note__: the type of this function changed in /0.1.0.0/. +render :: RenderExtension -> MMark -> Html () +render RenderExtension {..} MMark {..} = mapM_ rBlock mmarkBlocks where - Extension {..} = mmarkExtension - rBlock = - applyBlockRender extBlockRender - . fmap rInlines - . applyBlockTrans extBlockTrans + rBlock = applyBlockRender extBlockRender . fmap rInlines rInlines = - (mkOisInternal &&& mapM_ (applyInlineRender extInlineRender)) - . fmap (applyInlineTrans extInlineTrans) + mkOisInternal &&& mapM_ (applyInlineRender extInlineRender) -- | Apply a 'Render' to a given @'Block' 'Html' ()@. -- +-- __Note__: the type of this function changed in /0.1.0.0/. +-- -- @since 0.0.8.0 applyBlockRender :: Render (Block (Ois, Html ())) -> @@ -67,54 +97,56 @@ -- | The default 'Block' render. -- +-- __Note__: the type of this function changed in /0.1.0.0/. +-- -- @since 0.0.8.0 defaultBlockRender :: -- | Rendering function to use to render sub-blocks (Block (Ois, Html ()) -> Html ()) -> Block (Ois, Html ()) -> Html () -defaultBlockRender blockRender = \case - ThematicBreak -> +defaultBlockRender rBlock = \case + ThematicBreak _ -> hr_ [] >> newline - Heading1 (h, html) -> + Heading1 _ (h, html) -> h1_ (mkId h) html >> newline - Heading2 (h, html) -> + Heading2 _ (h, html) -> h2_ (mkId h) html >> newline - Heading3 (h, html) -> + Heading3 _ (h, html) -> h3_ (mkId h) html >> newline - Heading4 (h, html) -> + Heading4 _ (h, html) -> h4_ (mkId h) html >> newline - Heading5 (h, html) -> + Heading5 _ (h, html) -> h5_ (mkId h) html >> newline - Heading6 (h, html) -> + Heading6 _ (h, html) -> h6_ (mkId h) html >> newline - CodeBlock infoString txt -> do + CodeBlock _ infoString txt -> do let f x = class_ $ "language-" <> T.takeWhile (not . isSpace) x pre_ $ code_ (maybe [] (pure . f) infoString) (toHtml txt) newline - Naked (_, html) -> + Naked _ (_, html) -> html >> newline - Paragraph (_, html) -> + Paragraph _ (_, html) -> p_ html >> newline - Blockquote blocks -> do - blockquote_ (newline <* mapM_ blockRender blocks) + Blockquote _ blocks -> do + blockquote_ (newline <* mapM_ rBlock blocks) newline - OrderedList i items -> do + OrderedList _ i items -> do let startIndex = [start_ (T.pack $ show i) | i /= 1] ol_ startIndex $ do newline forM_ items $ \x -> do - li_ (newline <* mapM_ blockRender x) + li_ (newline <* mapM_ rBlock x) newline newline - UnorderedList items -> do + UnorderedList _ items -> do ul_ $ do newline forM_ items $ \x -> do - li_ (newline <* mapM_ blockRender x) + li_ (newline <* mapM_ rBlock x) newline newline - Table calign (hs :| rows) -> do + Table _ calign (hs :| rows) -> do table_ $ do newline thead_ $ do @@ -143,39 +175,43 @@ -- | Apply a render to a given 'Inline'. -- +-- __Note__: the type of this function changed in /0.1.0.0/. +-- -- @since 0.0.8.0 applyInlineRender :: Render Inline -> Inline -> Html () applyInlineRender r = fix (runRender r . defaultInlineRender) -- | The default render for 'Inline' elements. -- +-- __Note__: the type of this function changed in /0.1.0.0/. +-- -- @since 0.0.8.0 defaultInlineRender :: -- | Rendering function to use to render sub-inlines (Inline -> Html ()) -> Inline -> Html () -defaultInlineRender inlineRender = \case - Plain txt -> +defaultInlineRender rInline = \case + Plain _ txt -> toHtml txt - LineBreak -> + LineBreak _ -> br_ [] >> newline - Emphasis inner -> - em_ (mapM_ inlineRender inner) - Strong inner -> - strong_ (mapM_ inlineRender inner) - Strikeout inner -> - del_ (mapM_ inlineRender inner) - Subscript inner -> - sub_ (mapM_ inlineRender inner) - Superscript inner -> - sup_ (mapM_ inlineRender inner) - CodeSpan txt -> + Emphasis _ inner -> + em_ (mapM_ rInline inner) + Strong _ inner -> + strong_ (mapM_ rInline inner) + Strikeout _ inner -> + del_ (mapM_ rInline inner) + Subscript _ inner -> + sub_ (mapM_ rInline inner) + Superscript _ inner -> + sup_ (mapM_ rInline inner) + CodeSpan _ txt -> code_ (toHtml txt) - Link inner dest mtitle -> + Link _ inner dest mtitle -> let title = maybe [] (pure . title_) mtitle - in a_ (href_ (URI.render dest) : title) (mapM_ inlineRender inner) - Image desc src mtitle -> + in a_ (href_ (URI.render dest) : title) (mapM_ rInline inner) + Image _ desc src mtitle -> let title = maybe [] (pure . title_) mtitle in img_ (alt_ (asPlainText desc) : src_ (URI.render src) : title) @@ -184,3 +220,30 @@ -- @since 0.0.8.0 newline :: Html () newline = "\n" + +-- | Create an extension that replaces or augments rendering of 'Block's of +-- a markdown document. The argument of 'blockRender' will be given the +-- rendering function constructed so far @'Block' ('Ois', 'Html' ()) -> +-- 'Html' ()@ as well as an actual block to render—@'Block' ('Ois', 'Html' +-- ())@. The user can then decide whether to replace\/reuse that function to +-- get the final rendering of the type @'Html' ()@. +-- +-- See also: 'Ois' and 'getOis'. +-- +-- __Note__: the type of this function changed in /0.1.0.0/. +blockRender :: + ( (Block (Ois, Html ()) -> Html ()) -> + Block (Ois, Html ()) -> + Html () + ) -> + RenderExtension +blockRender f = mempty {extBlockRender = Render f} + +-- | Create an extension that replaces or augments rendering of 'Inline's of +-- a markdown document. This works like 'blockRender'. +-- +-- __Note__: the type of this function changed in /0.1.0.0/. +inlineRender :: + ((Inline -> Html ()) -> Inline -> Html ()) -> + RenderExtension +inlineRender f = mempty {extInlineRender = Render f} diff --git a/Text/MMark/Trans.hs b/Text/MMark/Trans.hs --- a/Text/MMark/Trans.hs +++ b/Text/MMark/Trans.hs @@ -9,43 +9,129 @@ -- Stability : experimental -- Portability : portable -- --- MMark block\/inline transformation helpers. +-- Everything needed to write a transformation. -- +-- A transformation is applied to a document with 'Text.MMark.runTrans' or +-- 'Text.MMark.runTransM', so the order in which transformations happen is +-- the order in which you sequence them, and the document that results from +-- one is an ordinary value you can inspect before you apply the next. A +-- transformation runs in the 'TransT' monad, which means it can perform +-- effects and it can 'report' errors against the source of the document. +-- +-- Every block and inline carries the 'Span' of the source it derives from, +-- see 'blockSpan' and 'inlineSpan'. That is what lets a transformation +-- report an error that points at the offending markup: +-- +-- > brokenLinks :: Inline -> TransT IO Inline +-- > brokenLinks = \case +-- > l@(Link spn _ uri _) -> do +-- > ok <- liftIO (checkUri uri) +-- > unless ok $ +-- > report spn ("cannot reach " <> URI.render uri) +-- > return l +-- > other -> return other +-- +-- See also: "Text.MMark.Render", which is about changing the way rendering +-- to HTML happens. +-- -- @since 0.0.8.0 module Text.MMark.Trans - ( applyBlockTrans, - applyInlineTrans, + ( -- * Documents + Bni, + Block (..), + CellAlign (..), + Inline (..), + Span (..), + spanUnion, + blockSpan, + setBlockSpan, + inlineSpan, + setInlineSpan, + + -- * Transformations + bottomUpBlocks, + topDownBlocks, + bottomUpInlines, + topDownInlines, + + -- * Reporting errors + TransT, + Trans, + TransError (..), + report, + abort, + + -- * Utils + asPlainText, + headerId, + headerFragment, ) where -import Data.Monoid hiding ((<>)) import Text.MMark.Internal.Type +import Text.MMark.Util --- | Apply block transformation in the @'Endo' 'Bni'@ form to a block 'Bni'. +-- | Apply a function to every block of a block tree, innermost blocks +-- first. A container block is therefore given to the function with its +-- children already transformed. -- --- @since 0.0.8.0 -applyBlockTrans :: Endo Bni -> Bni -> Bni -applyBlockTrans trans@(Endo f) = \case - Blockquote xs -> f (Blockquote (s xs)) - OrderedList w xs -> f (OrderedList w (s <$> xs)) - UnorderedList xs -> f (UnorderedList (s <$> xs)) - other -> f other +-- @since 0.1.0.0 +bottomUpBlocks :: (Monad m) => (Bni -> m Bni) -> Bni -> m Bni +bottomUpBlocks f = go where - s = fmap (applyBlockTrans trans) + go = \case + Blockquote spn xs -> traverse go xs >>= f . Blockquote spn + OrderedList spn w xs -> traverse (traverse go) xs >>= f . OrderedList spn w + UnorderedList spn xs -> traverse (traverse go) xs >>= f . UnorderedList spn + other -> f other --- | Apply inline transformation in the @'Endo' 'Inline'@ form to an --- 'Inline'. +-- | Apply a function to every block of a block tree, outermost blocks +-- first. A container block is therefore given to the function before its +-- children, and the children that are then visited are the ones the +-- function returned. -- --- @since 0.0.8.0 -applyInlineTrans :: Endo Inline -> Inline -> Inline -applyInlineTrans trans@(Endo f) = \case - Emphasis xs -> f (Emphasis (s xs)) - Strong xs -> f (Strong (s xs)) - Strikeout xs -> f (Strikeout (s xs)) - Subscript xs -> f (Subscript (s xs)) - Superscript xs -> f (Superscript (s xs)) - Link xs uri mt -> f (Link (s xs) uri mt) - Image xs uri mt -> f (Image (s xs) uri mt) - other -> f other +-- @since 0.1.0.0 +topDownBlocks :: (Monad m) => (Bni -> m Bni) -> Bni -> m Bni +topDownBlocks f = go where - s = fmap (applyInlineTrans trans) + go x = + f x >>= \case + Blockquote spn xs -> Blockquote spn <$> traverse go xs + OrderedList spn w xs -> OrderedList spn w <$> traverse (traverse go) xs + UnorderedList spn xs -> UnorderedList spn <$> traverse (traverse go) xs + other -> return other + +-- | Apply a function to every inline of a block tree, innermost inlines +-- first. +-- +-- @since 0.1.0.0 +bottomUpInlines :: (Monad m) => (Inline -> m Inline) -> Bni -> m Bni +bottomUpInlines f = bottomUpBlocks (traverse (traverse go)) + where + go = \case + Emphasis spn xs -> traverse go xs >>= f . Emphasis spn + Strong spn xs -> traverse go xs >>= f . Strong spn + Strikeout spn xs -> traverse go xs >>= f . Strikeout spn + Subscript spn xs -> traverse go xs >>= f . Subscript spn + Superscript spn xs -> traverse go xs >>= f . Superscript spn + Link spn xs uri mt -> traverse go xs >>= \ys -> f (Link spn ys uri mt) + Image spn xs uri mt -> traverse go xs >>= \ys -> f (Image spn ys uri mt) + other -> f other + +-- | Apply a function to every inline of a block tree, outermost inlines +-- first. +-- +-- @since 0.1.0.0 +topDownInlines :: (Monad m) => (Inline -> m Inline) -> Bni -> m Bni +topDownInlines f = bottomUpBlocks (traverse (traverse go)) + where + go x = + f x >>= \case + Emphasis spn xs -> Emphasis spn <$> traverse go xs + Strong spn xs -> Strong spn <$> traverse go xs + Strikeout spn xs -> Strikeout spn <$> traverse go xs + Subscript spn xs -> Subscript spn <$> traverse go xs + Superscript spn xs -> Superscript spn <$> traverse go xs + Link spn xs uri mt -> (\ys -> Link spn ys uri mt) <$> traverse go xs + Image spn xs uri mt -> (\ys -> Image spn ys uri mt) <$> traverse go xs + other -> return other diff --git a/Text/MMark/Util.hs b/Text/MMark/Util.hs --- a/Text/MMark/Util.hs +++ b/Text/MMark/Util.hs @@ -34,20 +34,20 @@ -- @since 0.0.8.0 asPlainText :: NonEmpty Inline -> Text asPlainText = foldMap $ \case - Plain txt -> txt - LineBreak -> "\n" - Emphasis xs -> asPlainText xs - Strong xs -> asPlainText xs - Strikeout xs -> asPlainText xs - Subscript xs -> asPlainText xs - Superscript xs -> asPlainText xs - CodeSpan txt -> txt - Link xs _ _ -> asPlainText xs - Image xs _ _ -> asPlainText xs + Plain _ txt -> txt + LineBreak _ -> "\n" + Emphasis _ xs -> asPlainText xs + Strong _ xs -> asPlainText xs + Strikeout _ xs -> asPlainText xs + Subscript _ xs -> asPlainText xs + Superscript _ xs -> asPlainText xs + CodeSpan _ txt -> txt + Link _ xs _ _ -> asPlainText xs + Image _ xs _ _ -> asPlainText xs --- | Generate value of id attribute for a given header. This is used during --- rendering and also can be used to get id of a header for linking to it in --- extensions. +-- | Generate the value of the id attribute for a given header. This is used +-- during rendering and also can be used to get the id of a header for +-- linking to it in extensions. -- -- See also: 'headerFragment'. -- @@ -61,7 +61,7 @@ . asPlainText -- | Generate a 'URI' containing only a fragment from its textual --- representation. Useful for getting URL from id of a header. +-- representation. Useful for getting a URL from the id of a header. -- -- @since 0.0.8.0 headerFragment :: Text -> URI diff --git a/data/bench-blockquote.md b/data/bench-blockquote.md --- a/data/bench-blockquote.md +++ b/data/bench-blockquote.md @@ -1,9 +1,9 @@ > Curabitur ullamcorper, lectus id porttitor vehicula, augue purus ornare - orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit - amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non - cursus et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis - tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at - eros fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo - tellus auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa - hendrerit mollis a nec ipsum. Sed porta erat vitae justo sodales gravida - nec sed augue. Maecenas ultrices tristique hendrerit. +> orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit +> amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non +> cursus et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis +> tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at +> eros fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo +> tellus auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa +> hendrerit mollis a nec ipsum. Sed porta erat vitae justo sodales gravida +> nec sed augue. Maecenas ultrices tristique hendrerit. diff --git a/data/comprehensive.md b/data/comprehensive.md --- a/data/comprehensive.md +++ b/data/comprehensive.md @@ -74,14 +74,14 @@ ### Curabitur ullamcorper > Curabitur ullamcorper, lectus id porttitor vehicula, augue purus ornare - orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit - amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non - cursus et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis - tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at - eros fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo - tellus auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa - hendrerit mollis a nec ipsum. Sed porta erat vitae justo sodales gravida - nec sed augue. Maecenas ultrices tristique hendrerit. +> orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit +> amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non +> cursus et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis +> tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at +> eros fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo +> tellus auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa +> hendrerit mollis a nec ipsum. Sed porta erat vitae justo sodales gravida +> nec sed augue. Maecenas ultrices tristique hendrerit. Curabitur venenatis vestibulum quam, a facilisis odio dignissim in. Vestibulum ut turpis pharetra, aliquam metus a, dapibus massa. Mauris @@ -141,11 +141,11 @@ egestas. Sed interdum eget ipsum id ullamcorper. > Aenean feugiat orci leo. Morbi fringilla, tortor id posuere mollis, lectus - est ullamcorper tellus, nec sagittis augue nibh nec est. Sed pulvinar orci - a justo eleifend dapibus. Phasellus aliquam enim in semper tincidunt. - Donec tempor tristique purus eu pretium. In ornare est at varius - elementum. Cras finibus nisl in nisi vestibulum, sed sollicitudin eros - finibus. +> est ullamcorper tellus, nec sagittis augue nibh nec est. Sed pulvinar orci +> a justo eleifend dapibus. Phasellus aliquam enim in semper tincidunt. +> Donec tempor tristique purus eu pretium. In ornare est at varius +> elementum. Cras finibus nisl in nisi vestibulum, sed sollicitudin eros +> finibus. 1. Nullam sed nisi blandit, ultrices neque a, finibus ligula. diff --git a/mmark.cabal b/mmark.cabal --- a/mmark.cabal +++ b/mmark.cabal @@ -1,11 +1,11 @@ cabal-version: 2.4 name: mmark -version: 0.0.8.0 +version: 0.1.0.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov author: Mark Karpov -tested-with: ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1 +tested-with: ghc ==9.10.3 ghc ==9.12.4 ghc ==9.14.1 homepage: https://github.com/mmark-md/mmark bug-reports: https://github.com/mmark-md/mmark/issues synopsis: Strict markdown processor for writers @@ -32,7 +32,6 @@ library exposed-modules: Text.MMark - Text.MMark.Extension Text.MMark.Internal.Type Text.MMark.Render Text.MMark.Trans @@ -48,7 +47,7 @@ aeson >=0.11 && <3, base >=4.15 && <5, case-insensitive >=1.2 && <1.3, - containers >=0.5 && <0.7, + containers >=0.5 && <0.9, deepseq >=1.3 && <1.6, dlist >=0.8 && <2, email-validate >=2.2 && <2.4, @@ -57,7 +56,7 @@ html-entity-map >=0.1 && <0.2, lucid >=2.9.13 && <3, megaparsec >=8 && <10, - microlens >=0.4 && <0.5, + microlens >=0.4 && <0.6, microlens-th >=0.4 && <0.5, modern-uri >=0.3.4.4 && <0.4, mtl >=2 && <3, @@ -72,7 +71,7 @@ if flag(dev) ghc-options: -Wall -Werror -Wredundant-constraints -Wpartial-fields - -Wunused-packages + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall @@ -106,7 +105,7 @@ if flag(dev) ghc-options: -Wall -Werror -Wredundant-constraints -Wpartial-fields - -Wunused-packages + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall @@ -128,7 +127,7 @@ if flag(dev) ghc-options: -Wall -Werror -Wredundant-constraints -Wpartial-fields - -Wunused-packages + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall @@ -150,7 +149,7 @@ if flag(dev) ghc-options: -Wall -Werror -Wredundant-constraints -Wpartial-fields - -Wunused-packages + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -1,7 +1,10 @@ module Main (main) where import Test.Hspec -import Text.MMarkSpec (spec) +import Text.MMark.ExtensionSpec qualified as ExtensionSpec +import Text.MMarkSpec qualified as MMarkSpec main :: IO () -main = hspec spec +main = hspec $ do + MMarkSpec.spec + ExtensionSpec.spec diff --git a/tests/Text/MMark/ExtensionSpec.hs b/tests/Text/MMark/ExtensionSpec.hs --- a/tests/Text/MMark/ExtensionSpec.hs +++ b/tests/Text/MMark/ExtensionSpec.hs @@ -4,105 +4,180 @@ module Text.MMark.ExtensionSpec (spec) where +import Control.Monad.IO.Class (liftIO) +import Data.IORef +import Data.List (isSuffixOf) import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text qualified as T import Lucid qualified as L import Test.Hspec -import Test.QuickCheck +import Test.QuickCheck hiding (collect) +import Text.MMark (MMark) import Text.MMark qualified as MMark -import Text.MMark.Extension (Block (..), Inline (..)) -import Text.MMark.Extension qualified as Ext +import Text.MMark.Render qualified as Render import Text.MMark.TestUtils +import Text.MMark.Trans (Block (..), Bni, Inline (..), Span (..), Trans, TransT) +import Text.MMark.Trans qualified as Trans +import Text.Megaparsec (errorBundlePretty) import Text.URI qualified as URI spec :: Spec spec = parallel $ do - describe "blockTrans" $ do + describe "bottomUpBlocks" $ do it "works" $ do doc <- mkDoc "# My heading" - toText (MMark.useExtension h1_to_h2 doc) - `shouldBe` "

My heading

\n" - it "extensions can affect nested block structures" $ do + trans h1_to_h2 doc + `shouldReturn` "

My heading

\n" + it "reaches nested block structures" $ do doc <- mkDoc "* # My heading" - toText (MMark.useExtension h1_to_h2 doc) - `shouldBe` "
    \n
  • \n

    My heading

    \n
    • \n
\n" + trans h1_to_h2 doc + `shouldReturn` "
    \n
  • \n

    My heading

    \n
    • \n
\n" + it "visits the innermost blocks first" $ do + doc <- mkDoc "> * a" + order (Trans.bottomUpBlocks . note) doc + `shouldReturn` ["Naked", "UnorderedList", "Blockquote"] + describe "topDownBlocks" $ + it "visits the outermost blocks first" $ do + doc <- mkDoc "> * a" + order (Trans.topDownBlocks . note) doc + `shouldReturn` ["Blockquote", "UnorderedList", "Naked"] describe "blockRender" $ do it "works" $ do doc <- mkDoc "# My heading" - toText (MMark.useExtension add_h1_content doc) + toTextWith add_h1_content doc `shouldBe` "

My heading

\n" it "extensions can affect nested block structures" $ do doc <- mkDoc "* # Something" - toText (MMark.useExtension add_h1_content doc) + toTextWith add_h1_content doc `shouldBe` "
    \n
  • \n

    Something

    \n
    • \n
\n" - describe "inlineTrans" $ do + describe "bottomUpInlines" $ do it "works" $ do doc <- mkDoc "# My *heading*" - toText (MMark.useExtension em_to_strong doc) - `shouldBe` "

My heading

\n" - it "extensions can affect nested inline structures" $ do + trans (Trans.bottomUpInlines em_to_strong) doc + `shouldReturn` "

My heading

\n" + it "reaches nested inline structures" $ do doc <- mkDoc "# My ~*heading*~" - toText (MMark.useExtension em_to_strong doc) - `shouldBe` "

My heading

\n" + trans (Trans.bottomUpInlines em_to_strong) doc + `shouldReturn` "

My heading

\n" describe "inlineRender" $ do it "works" $ do doc <- mkDoc "# My *heading*" - toText (MMark.useExtension (add_em_class "foo") doc) + toTextWith (add_em_class "foo") doc `shouldBe` "

My heading

\n" it "extensions can affect nested inline structures" $ do doc <- mkDoc "[*heading*](/url)" - toText (MMark.useExtension (add_em_class "foo") doc) + toTextWith (add_em_class "foo") doc `shouldBe` "

heading

\n" + describe "spans" $ do + it "cover a block and the white space that follows it" $ do + doc <- mkDoc "# One\n\nTwo three." + spansOf doc `shouldBe` [Span 0 7, Span 7 17] + it "point at the source an inline was parsed from" $ do + doc <- mkDoc "a *b* c" + inlineSpansOf doc `shouldBe` [Span 0 2, Span 2 5, Span 5 7] + describe "report" $ do + it "reports every offending node, not only the first" $ do + doc <- mkDoc "*a* and *b*" + errs <- transErrors (Trans.bottomUpInlines noEmphasis) doc + errs `shouldBe` ["1:1:", "1:9:"] + it "renders errors against the source of the document" $ do + doc <- mkDoc "*a*" + errs <- transErrorText (Trans.bottomUpInlines noEmphasis) doc + errs `shouldSatisfy` T.isInfixOf "no emphasis allowed" + it "orders the errors by position, not by when they were reported" $ do + doc <- mkDoc "one *a* two *b* three" + errs <- transErrors reportBackwards doc + errs `shouldBe` ["1:5:", "1:13:"] + it "renders an error against the right source line whatever the order" $ do + doc <- mkDoc "one *a* two *b* three" + txt <- transErrorText reportBackwards doc + txt `shouldSatisfy` T.isInfixOf "1:5:" + txt `shouldSatisfy` T.isInfixOf "1:13:" + describe "abort" $ + it "gives up but keeps the errors reported before it" $ do + doc <- mkDoc "*a* and *b*" + errs <- transErrors (Trans.bottomUpInlines noEmphasisAbort) doc + errs `shouldBe` ["1:1:"] + describe "runCheck" $ do + it "runs the check once, whatever the document contains" $ do + doc <- mkDoc "one\n\ntwo\n\nthree\n\nfour" + let check = Trans.report (Span 0 3) "just once" + case MMark.runCheck check doc of + Right () -> expectationFailure "the check was expected to report" + Left errs -> length (T.lines (T.pack (errorBundlePretty errs))) `shouldBe` 5 + it "gives back what the check returns when it reports nothing" $ do + doc <- mkDoc "one" + MMark.runCheck (return (42 :: Int)) doc `shouldBe` Right 42 + it "resolves positions against the document" $ do + doc <- mkDoc "one\ntwo\nthree" + let check = Trans.report (Span 8 13) "here" + case MMark.runCheck check doc of + Right () -> expectationFailure "the check was expected to report" + Left errs -> T.pack (errorBundlePretty errs) `shouldSatisfy` T.isInfixOf "3:1:" + describe "runCheckM" $ + it "can perform effects" $ do + doc <- mkDoc "one" + ref <- newIORef (0 :: Int) + _ <- MMark.runCheckM (liftIO (modifyIORef ref (+ 1))) doc + readIORef ref `shouldReturn` 1 + describe "runTransM" $ + it "can perform effects" $ do + doc <- mkDoc "# a\n\n# b" + ref <- newIORef [] + _ <- MMark.runTransM (collect ref) doc + reverse <$> readIORef ref `shouldReturn` ["a", "b"] describe "asPlainText" $ do - let f x = Ext.asPlainText (x :| []) + let f x = Trans.asPlainText (x :| []) + sp = Span 0 0 context "with Plain" $ it "works" $ property $ \txt -> - f (Plain txt) `shouldBe` txt - context "with LineBreak" $ - it "works" $ - f LineBreak `shouldBe` "\n" + f (Plain sp txt) `shouldBe` txt + context "with LineBreak" + $ it "works" + $ f (LineBreak sp) `shouldBe` "\n" context "with Emphasis" $ it "works" $ property $ \txt -> - f (Emphasis $ Plain txt :| []) `shouldBe` txt + f (Emphasis sp $ Plain sp txt :| []) `shouldBe` txt context "with Strong" $ it "works" $ property $ \txt -> - f (Strong $ Plain txt :| []) `shouldBe` txt + f (Strong sp $ Plain sp txt :| []) `shouldBe` txt context "with Strikeout" $ it "works" $ property $ \txt -> - f (Strikeout $ Plain txt :| []) `shouldBe` txt + f (Strikeout sp $ Plain sp txt :| []) `shouldBe` txt context "with Subscript" $ it "works" $ property $ \txt -> - f (Subscript $ Plain txt :| []) `shouldBe` txt + f (Subscript sp $ Plain sp txt :| []) `shouldBe` txt context "with Superscript" $ it "works" $ property $ \txt -> - f (Superscript $ Plain txt :| []) `shouldBe` txt + f (Superscript sp $ Plain sp txt :| []) `shouldBe` txt context "with CodeSpan" $ it "works" $ property $ \txt -> - f (CodeSpan txt) `shouldBe` txt + f (CodeSpan sp txt) `shouldBe` txt context "with Link" $ it "works" $ property $ \txt uri -> - f (Link (Plain txt :| []) uri Nothing) `shouldBe` txt + f (Link sp (Plain sp txt :| []) uri Nothing) `shouldBe` txt context "with Image" $ it "works" $ property $ \txt uri -> - f (Image (Plain txt :| []) uri Nothing) `shouldBe` txt - describe "headerId" $ - it "works" $ - Ext.headerId (Plain "Something like that" :| []) - `shouldBe` "something-like-that" + f (Image sp (Plain sp txt :| []) uri Nothing) `shouldBe` txt + describe "headerId" + $ it "works" + $ Trans.headerId (Plain (Span 0 0) "Something like that" :| []) + `shouldBe` "something-like-that" describe "headerFragment" $ it "generates URIs with just that fragment" $ property $ \fragment -> do - let uri = Ext.headerFragment fragment + let uri = Trans.headerFragment fragment frag <- URI.mkFragment fragment URI.uriScheme uri `shouldBe` Nothing URI.uriAuthority uri `shouldBe` Left False @@ -120,32 +195,115 @@ -- Testing extensions -- | Convert H1 headings into H2 headings. -h1_to_h2 :: MMark.Extension -h1_to_h2 = Ext.blockTrans $ \case - Heading1 inner -> Heading2 inner - other -> other +h1_to_h2 :: Bni -> Trans Bni +h1_to_h2 = Trans.bottomUpBlocks $ \case + Heading1 ann inner -> return (Heading2 ann inner) + other -> return other -- | Add a data attribute calculated based on plain text contents of the --- level 1 heading to test the 'Ext.getOis' thing and 'Ext.blockRender' in +-- level 1 heading to test the 'Render.getOis' thing and 'Render.blockRender' in -- general. -add_h1_content :: MMark.Extension -add_h1_content = Ext.blockRender $ \old block -> +add_h1_content :: MMark.RenderExtension +add_h1_content = Render.blockRender $ \old block -> case block of - Heading1 inner -> + Heading1 ann inner -> L.with - (old (Heading1 inner)) - [L.data_ "content" (Ext.asPlainText . Ext.getOis . fst $ inner)] + (old (Heading1 ann inner)) + [L.data_ "content" (Trans.asPlainText . Render.getOis . fst $ inner)] other -> old other -- | Convert all 'Emphasis' to 'Strong'. -em_to_strong :: MMark.Extension -em_to_strong = Ext.inlineTrans $ \case - Emphasis inner -> Strong inner - other -> other +em_to_strong :: Inline -> Trans Inline +em_to_strong = \case + Emphasis ann inner -> return (Strong ann inner) + other -> return other +-- | Report every 'Emphasis' of a block, last one first, so that the errors +-- are reported in the opposite of document order. +reportBackwards :: Bni -> Trans Bni +reportBackwards b = b <$ mapM_ report (reverse (spansOfEmphases b)) + where + report spn = Trans.report spn "emphasis" + spansOfEmphases = foldMap (foldMap go) + go = \case + Emphasis spn xs -> spn : foldMap go xs + Strong _ xs -> foldMap go xs + other -> const [] other + +-- | Report every 'Emphasis' and carry on. +noEmphasis :: Inline -> Trans Inline +noEmphasis i = case i of + Emphasis ann _ -> i <$ Trans.report ann "no emphasis allowed" + other -> return other + +-- | Report the first 'Emphasis' and give up. +noEmphasisAbort :: Inline -> Trans Inline +noEmphasisAbort i = case i of + Emphasis ann _ -> Trans.abort ann "no emphasis allowed" + other -> return other + +-- | Record the plain text of every heading, in an effect. +collect :: IORef [Text] -> Bni -> TransT IO Bni +collect ref = Trans.bottomUpBlocks $ \b -> case b of + Heading1 _ inner -> do + liftIO (modifyIORef ref (Trans.asPlainText inner :)) + return b + other -> return other + +-- | Record the name of the constructor of every block visited. +note :: IORef [String] -> Bni -> TransT IO Bni +note ref b = b <$ liftIO (modifyIORef ref (con b :)) + where + con = \case + Blockquote {} -> "Blockquote" + UnorderedList {} -> "UnorderedList" + OrderedList {} -> "OrderedList" + Paragraph {} -> "Paragraph" + Naked {} -> "Naked" + Heading1 {} -> "Heading1" + _ -> "other" + -- | Add given class to all 'Emphasis' things. -add_em_class :: Text -> MMark.Extension -add_em_class given = Ext.inlineRender $ \old inline -> +add_em_class :: Text -> MMark.RenderExtension +add_em_class given = Render.inlineRender $ \old inline -> case inline of - Emphasis inner -> L.with (old (Emphasis inner)) [L.class_ given] + Emphasis ann inner -> L.with (old (Emphasis ann inner)) [L.class_ given] other -> old other + +---------------------------------------------------------------------------- +-- Helpers + +-- | Apply a pure transformation and render the result. +trans :: (Bni -> Trans Bni) -> MMark -> IO Text +trans f doc = case MMark.runTrans f doc of + Left errs -> fail (errorBundlePretty errs) + Right doc' -> return (toText doc') + +-- | Apply a transformation that is expected to fail and return the +-- position of every error it reported. +transErrors :: (Bni -> Trans Bni) -> MMark -> IO [String] +transErrors f doc = case MMark.runTrans f doc of + Left errs -> return (filter (isSuffixOf ":") (words (errorBundlePretty errs))) + Right _ -> fail "the transformation was expected to fail" + +-- | Like 'transErrors', but return the rendered errors themselves. +transErrorText :: (Bni -> Trans Bni) -> MMark -> IO Text +transErrorText f doc = case MMark.runTrans f doc of + Left errs -> return (T.pack (errorBundlePretty errs)) + Right _ -> fail "the transformation was expected to fail" + +-- | Run a transformation that records the order in which nodes are visited. +order :: (IORef [String] -> Bni -> TransT IO Bni) -> MMark -> IO [String] +order f doc = do + ref <- newIORef [] + _ <- MMark.runTransM (f ref) doc + reverse <$> readIORef ref + +-- | The spans of the top-level blocks of a document. +spansOf :: MMark -> [Span] +spansOf doc = MMark.runScanner (MMark.scanner [] (\acc b -> acc ++ [Trans.blockSpan b])) doc + +-- | The spans of the inlines of the last block of a document. +inlineSpansOf :: MMark -> [Span] +inlineSpansOf doc = + MMark.runScanner (MMark.scanner [] (\acc b -> acc ++ foldMap (fmap Trans.inlineSpan . NE.toList) b)) doc diff --git a/tests/Text/MMark/TestUtils.hs b/tests/Text/MMark/TestUtils.hs --- a/tests/Text/MMark/TestUtils.hs +++ b/tests/Text/MMark/TestUtils.hs @@ -4,6 +4,7 @@ ( -- * Document creation and rendering mkDoc, toText, + toTextWith, -- * Parser expectations (~~->), @@ -41,7 +42,11 @@ -- | Render an 'MMark' document to 'Text'. toText :: MMark -> Text -toText = TL.toStrict . L.renderText . MMark.render +toText = toTextWith mempty + +-- | Render an 'MMark' document to 'Text' using the given render extension. +toTextWith :: MMark.RenderExtension -> MMark -> Text +toTextWith ext = TL.toStrict . L.renderText . MMark.render ext ---------------------------------------------------------------------------- -- Parser expectations diff --git a/tests/Text/MMarkSpec.hs b/tests/Text/MMarkSpec.hs --- a/tests/Text/MMarkSpec.hs +++ b/tests/Text/MMarkSpec.hs @@ -4,2171 +4,2422 @@ module Text.MMarkSpec (spec) where import Control.Foldl qualified as L -import Data.Aeson -import Data.Char -import Data.List.NonEmpty (NonEmpty (..)) -import Data.List.NonEmpty qualified as NE -import Data.Monoid -import Data.Text (Text) -import Data.Text qualified as T -import Data.Text.IO qualified as TIO -import Lucid -import Test.Hspec -import Test.Hspec.Megaparsec -import Text.MMark (MMarkErr (..)) -import Text.MMark qualified as MMark -import Text.MMark.Extension (Inline (..)) -import Text.MMark.Extension qualified as Ext -import Text.MMark.TestUtils -import Text.Megaparsec (ErrorFancy (..)) - --- NOTE This test suite is mostly based on (sometimes altered) examples from --- the Common Mark specification. We use the version 0.28 (2017-08-01), --- which can be found online here: --- --- - -spec :: Spec -spec = parallel $ do - describe "parse and render" $ do - context "2.2 Tabs" $ do - it "CM1" $ - "\tfoo\tbaz\t\tbim" - ==-> "
foo\tbaz\t\tbim\n
\n" - it "CM2" $ - " \tfoo\tbaz\t\tbim" - ==-> "
foo\tbaz\t\tbim\n
\n" - it "CM3" $ - " a\ta\n ὐ\ta" - ==-> "
a\ta\nὐ\ta\n
\n" - it "CM4" $ - " - foo\n\n\tbar" - ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" - it "CM5" $ - "- foo\n\n\t\tbar" - ==-> "
    \n
  • \n

    foo

    \n
      bar\n
    \n
    • \n
\n" - it "CM6" $ - ">\t\tfoo" - ==-> "
\n
  foo\n
\n
\n" - it "CM7" $ - "-\t\tfoo" - ==-> "
    \n
  • \n
      foo\n
    \n
    • \n
\n" - it "CM8" $ - " foo\n\tbar" - ==-> "
foo\nbar\n
\n" - it "CM9" $ - " - foo\n - bar\n\t - baz" - ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \nbaz\n
        • \n
      \n
      • \n
    \n
    • \n
\n" - it "CM10" $ - "#\tFoo" ==-> "

Foo

\n" - it "CM11" $ - "*\t*\t*\t" ==-> "
\n" - context "3.1 Precedence" $ - it "CM12" $ - let s = "- `one\n- two`" - in s - ~~-> [ err 6 (ueib <> etok '`' <> ecsc), - err 13 (ueib <> etok '`' <> ecsc) - ] - context "4.1 Thematic breaks" $ do - it "CM13" $ - "***\n---\n___" ==-> "
\n
\n
\n" - it "CM14" $ - "+++" ==-> "

+++

\n" - it "CM15" $ - "===" ==-> "

===

\n" - it "CM16" $ - let s = "--\n**\n__\n" - in s ~-> errFancy 3 (nonFlanking "**") - it "CM17" $ - " ***\n ***\n ***" ==-> "
\n
\n
\n" - it "CM18" $ - " ***" ==-> "
***\n
\n" - it "CM19" $ - let s = "Foo\n ***\n" - in s ~-> errFancy 8 (nonFlanking "***") - it "CM20" $ - "_____________________________________" - ==-> "
\n" - it "CM21" $ - " - - -" ==-> "
\n" - it "CM22" $ - " ** * ** * ** * **" ==-> "
\n" - it "CM23" $ - "- - - -" ==-> "
\n" - it "CM24" $ - "- - - - " ==-> "
\n" - it "CM25" $ - let s = "_ _ _ _ a\n\na------\n\n---a---\n" - in s ~-> errFancy 0 (nonFlanking "_") - it "CM26" $ - " *-*" ==-> "

-

\n" - it "CM27" $ - "- foo\n***\n- bar" - ==-> "
    \n
  • \nfoo\n
    • \n
\n
\n
    \n
  • \nbar\n
    • \n
\n" - it "CM28" $ - "Foo\n***\nbar" - ==-> "

Foo

\n
\n

bar

\n" - it "CM29" $ - "Foo\n---\nbar" - ==-> "

Foo

\n
\n

bar

\n" - it "CM30" $ - "* Foo\n* * *\n* Bar" - ==-> "
    \n
  • \nFoo\n
    • \n
  • \n
      \n
    • \n
        \n
      • \n\n
        • \n
      \n
      • \n
    \n
    • \n
  • \nBar\n
    • \n
\n" - it "CM31" $ - "- Foo\n- * * *" - ==-> "
    \n
  • \nFoo\n
    • \n
  • \n
    \n
    • \n
\n" - context "4.2 ATX headings" $ do - it "CM32" $ - "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo" - ==-> "

foo

\n

foo

\n

foo

\n

foo

\n
foo
\n
foo
\n" - it "CM33" $ - let s = "####### foo" - in s ~-> err 6 (utok '#' <> ews) - it "CM34" $ - let s = "#5 bolt\n\n#hashtag" - in s - ~~-> [ err 1 (utok '5' <> etok '#' <> ews), - err 10 (utok 'h' <> etok '#' <> ews) - ] - it "CM35" $ - "\\## foo" ==-> "

## foo

\n" - it "CM36" $ - "# foo *bar* \\*baz\\*" ==-> "

foo bar *baz*

\n" - it "CM37" $ - "# foo " - ==-> "

foo

\n" - it "CM38" $ - " ### foo\n ## foo\n # foo" - ==-> "

foo

\n

foo

\n

foo

\n" - it "CM39" $ - " # foo" ==-> "
# foo\n
\n" - it "CM40" $ - "foo\n # bar" ==-> "

foo\n# bar

\n" - it "CM41" $ - "## foo ##\n ### bar ###" - ==-> "

foo

\n

bar

\n" - it "CM42" $ - "# foo ##################################\n##### foo ##" - ==-> "

foo

\n
foo
\n" - it "CM43" $ - "### foo ### " ==-> "

foo

\n" - it "CM44" $ - "### foo ### b" ==-> "

foo ### b

\n" - it "CM45" $ - "# foo#" ==-> "

foo#

\n" - it "CM46" $ - "### foo \\###\n## foo #\\##\n# foo \\#" - ==-> "

foo ###

\n

foo ###

\n

foo #

\n" - it "CM47" $ - "****\n## foo\n****" - ==-> "
\n

foo

\n
\n" - it "CM48" $ - "Foo bar\n# baz\nBar foo" - ==-> "

Foo bar

\n

baz

\n

Bar foo

\n" - it "CM49" $ - let s = "## \n#\n### ###" - in s - ~~-> [ err 3 (utok '\n' <> elabel "heading character" <> ews), - err 5 (utok '\n' <> etok '#' <> ews) - ] - context "4.3 Setext headings" $ do - -- NOTE we do not support them, the tests have been adjusted - -- accordingly. - it "CM50" $ - "Foo *bar*\n=========\n\nFoo *bar*\n---------" - ==-> "

Foo bar\n=========

\n

Foo bar

\n
\n" - it "CM51" $ - "Foo *bar\nbaz*\n====" - ==-> "

Foo bar\nbaz\n====

\n" - it "CM52" $ - "Foo\n-------------------------\n\nFoo\n=" - ==-> "

Foo

\n
\n

Foo\n=

\n" - it "CM53" $ - " Foo\n---\n\n Foo\n-----\n\n Foo\n ===" - ==-> "

Foo

\n
\n

Foo

\n
\n

Foo\n===

\n" - it "CM54" $ - " Foo\n ---\n\n Foo\n---" - ==-> "
Foo\n---\n\nFoo\n
\n
\n" - it "CM55" $ - "Foo\n ---- " - ==-> "

Foo

\n
\n" - it "CM56" $ - "Foo\n ---" - ==-> "

Foo\n---

\n" - it "CM57" $ - "Foo\n= =\n\nFoo\n--- -" - ==-> "

Foo\n= =

\n

Foo

\n
\n" - it "CM58" $ - "Foo \n-----" - ==-> "

Foo

\n
\n" - it "CM59" $ - "Foo\\\n----" - ==-> "

Foo\\

\n
\n" - it "CM60" $ - let s = "`Foo\n----\n`\n\n\n" - in s - ~~-> [ err 4 (ueib <> etok '`' <> ecsc), - err 11 (ueib <> etok '`' <> ecsc) - ] - it "CM61" $ - "> Foo\n---" - ==-> "
\n

Foo

\n
\n
\n" - it "CM62" $ - "> foo\nbar\n===" - ==-> "
\n

foo

\n
\n

bar\n===

\n" - it "CM63" $ - "- Foo\n---" - ==-> "
    \n
  • \nFoo\n
    • \n
\n
\n" - it "CM64" $ - "Foo\nBar\n---" - ==-> "

Foo\nBar

\n
\n" - it "CM65" $ - "---\nFoo\n---\nBar\n---\nBaz" - ==-> "

Bar

\n
\n

Baz

\n" - it "CM66" $ - "\n====" - ==-> "

====

\n" - it "CM67" $ - "---\n---" - ==-> "" -- thinks that it's got a YAML block - it "CM68" $ - "- foo\n-----" - ==-> "
    \n
  • \nfoo\n
    • \n
\n
\n" - it "CM69" $ - " foo\n---" - ==-> "
foo\n
\n
\n" - it "CM70" $ - "> foo\n-----" - ==-> "
\n

foo

\n
\n
\n" - it "CM71" $ - "\\> foo\n------" - ==-> "

> foo

\n
\n" - it "CM72" $ - "Foo\n\nbar\n---\nbaz" - ==-> "

Foo

\n

bar

\n
\n

baz

\n" - it "CM73" $ - "Foo\nbar\n\n---\n\nbaz" - ==-> "

Foo\nbar

\n
\n

baz

\n" - it "CM74" $ - "Foo\nbar\n* * *\nbaz" - ==-> "

Foo\nbar

\n
\n

baz

\n" - it "CM75" $ - "Foo\nbar\n\\---\nbaz" - ==-> "

Foo\nbar\n---\nbaz

\n" - context "4.4 Indented code blocks" $ do - it "CM76" $ - " a simple\n indented code block" - ==-> "
a simple\n  indented code block\n
\n" - it "CM77" $ - " - foo\n\n bar" - ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" - it "CM78" $ - "1. foo\n\n - bar" - ==-> "
    \n
  1. \n

    foo

    \n
      \n
    • \nbar\n
      • \n
    \n
    2. \n
\n" - it "CM79" $ - " \n *hi*\n\n - one" - ==-> "
<a/>\n*hi*\n\n- one\n
\n" - it "CM80" $ - " chunk1\n\n chunk2\n \n \n \n chunk3" - ==-> "
chunk1\n\nchunk2\n\n\n\nchunk3\n
\n" - it "CM81" $ - " chunk1\n \n chunk2" - ==-> "
chunk1\n  \n  chunk2\n
\n" - it "CM82" $ - "Foo\n bar\n" - ==-> "

Foo\nbar

\n" - it "CM83" $ - " foo\nbar" - ==-> "
foo\n
\n

bar

\n" - it "CM84" $ - "# Heading\n foo\nHeading\n------\n foo\n----\n" - ==-> "

Heading

\n
foo\n
\n

Heading

\n
\n
foo\n
\n
\n" - it "CM85" $ - " foo\n bar" - ==-> "
    foo\nbar\n
\n" - it "CM86" $ - "\n \n foo\n \n" - ==-> "
foo\n
\n" - it "CM87" $ - " foo " - ==-> "
foo  \n
\n" - context "4.5 Fenced code blocks" $ do - it "CM88" $ - "```\n<\n >\n```" - ==-> "
<\n >\n
\n" - it "CM89" $ - "~~~\n<\n >\n~~~" - ==-> "
<\n >\n
\n" - it "CM90" $ - "``\nfoo\n``\n" - ==-> "

foo

\n" - it "CM91" $ - "```\naaa\n~~~\n```" - ==-> "
aaa\n~~~\n
\n" - it "CM92" $ - "~~~\naaa\n```\n~~~" - ==-> "
aaa\n```\n
\n" - it "CM93" $ - "````\naaa\n```\n``````" - ==-> "
aaa\n```\n
\n" - it "CM94" $ - "~~~~\naaa\n~~~\n~~~~" - ==-> "
aaa\n~~~\n
\n" - it "CM95" $ - let s = "```" - in s ~-> err 3 (ueib <> etok '`' <> ecsc) - it "CM96" $ - let s = "`````\n\n```\naaa\n" - in s - ~-> err - 15 - (ueof <> elabel "closing code fence" <> elabel "code block content") - it "CM97" $ - let s = "> ```\n> aaa\n\nbbb\n" - in s ~-> err 17 (ueof <> elabel "closing code fence" <> elabel "code block content") - it "CM98" $ - "```\n\n \n```" - ==-> "
\n  \n
\n" - it "CM99" $ - "```\n```" - ==-> "
\n" - it "CM100" $ - " ```\n aaa\naaa\n```" - ==-> "
aaa\naaa\n
\n" - it "CM101" $ - " ```\naaa\n aaa\naaa\n ```" - ==-> "
aaa\naaa\naaa\n
\n" - it "CM102" $ - " ```\n aaa\n aaa\n aaa\n ```" - ==-> "
aaa\n aaa\naaa\n
\n" - it "CM103" $ - " ```\n aaa\n ```" - ==-> "
```\naaa\n```\n
\n" - it "CM104" $ - "```\naaa\n ```" - ==-> "
aaa\n
\n" - it "CM105" $ - " ```\naaa\n ```" - ==-> "
aaa\n
\n" - it "CM106" $ - let s = "```\naaa\n ```\n" - in s - ~-> err - 16 - (ueof <> elabel "closing code fence" <> elabel "code block content") - it "CM107" $ - "``` ```\naaa" - ==-> "

\naaa

\n" - it "CM108" $ - let s = "~~~~~~\naaa\n~~~ ~~\n" - in s - ~-> err - 18 - (ueof <> elabel "closing code fence" <> elabel "code block content") - it "CM109" $ - "foo\n```\nbar\n```\nbaz" - ==-> "

foo

\n
bar\n
\n

baz

\n" - it "CM110" $ - "foo\n---\n~~~\nbar\n~~~\n# baz" - ==-> "

foo

\n
\n
bar\n
\n

baz

\n" - it "CM111" $ - "```ruby\ndef foo(x)\n return 3\nend\n```" - ==-> "
def foo(x)\n  return 3\nend\n
\n" - it "CM112" $ - "~~~~ ruby startline=3 $%@#$\ndef foo(x)\n return 3\nend\n~~~~~~~" - ==-> "
def foo(x)\n  return 3\nend\n
\n" - it "CM113" $ - "````;\n````" - ==-> "
\n" - it "CM114" $ - "``` aa ```\nfoo" - ==-> "

aa\nfoo

\n" - it "CM115" $ - "```\n``` aaa\n```" - ==-> "
``` aaa\n
\n" - context "4.6 HTML blocks" $ - -- NOTE We do not support HTML blocks, see the readme. - return () - context "4.7 Link reference definitions" $ do - it "CM159" $ - "[foo]: /url \"title\"\n\n[foo]" ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") - it "CM160" $ - " [foo]: \n /url \n 'the title' \n\n[foo]" - ##-> p_ (a_ [href_ "/url", title_ "the title"] "foo") - it "CM161" $ - let s = "[Foo bar\\]]:my_(url) 'title (with parens)'\n\n[Foo bar\\]]" - in s - ~~-> [ err 19 (utoks ") " <> euric <> elabel "newline" <> ews), - errFancy 45 (couldNotMatchRef "Foo bar]" []) - ] - it "CM162" $ - "[Foo bar]:\n\n'title'\n\n[Foo bar]" - ##-> p_ (a_ [href_ "my%20url", title_ "title"] "Foo bar") - it "CM163" $ - "[foo]: /url '\ntitle\nline1\nline2\n'\n\n[foo]" - ##-> p_ (a_ [href_ "/url", title_ "\ntitle\nline1\nline2\n"] "foo") - it "CM164" $ - "[foo]: /url 'title\n\nwith blank line'\n\n[foo]" - ##-> p_ (a_ [href_ "/url", title_ "title\n\nwith blank line"] "foo") - it "CM165" $ - "[foo]:\n/url\n\n[foo]" - ==-> "

foo

\n" - it "CM166" $ - let s = "[foo]:\n\n[foo]" - in s - ~~-> [ err 7 (utok '\n' <> etok '<' <> elabel "URI" <> ews), - errFancy 9 (couldNotMatchRef "foo" []) - ] - it "CM167" $ - let s = "[foo]: /url\\bar\\*baz \"foo\\\"bar\\baz\"\n\n[foo]\n" - in s ~-> err 11 (utok '\\' <> euric <> euri) - it "CM168" $ - "[foo]\n\n[foo]: url" - ==-> "

foo

\n" - it "CM169" $ - let s = "[foo]\n\n[foo]: first\n[foo]: second\n" - in s ~-> errFancy 21 (duplicateRef "foo") - it "CM170" $ - "[FOO]: /url\n\n[Foo]" - ==-> "

Foo

\n" - it "CM171" $ - "[ΑΓΩ]: /%CF%86%CE%BF%CF%85\n\n[αγω]" - ==-> "

αγω

\n" - it "CM172" $ - "[foo]: /url" - ==-> "" - it "CM173" $ - "[\nfoo\n]: /url\nbar" - ==-> "

bar

\n" - it "CM174" $ - let s = "[foo]: /url \"title\" ok" - in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) - it "CM175" $ - let s = "[foo]: /url\n\"title\" ok\n" - in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) - it "CM176" $ - " [foo]: /url \"title\"" - ==-> "
[foo]: /url "title"\n
\n" - it "CM177" $ - "```\n[foo]: /url\n```" - ==-> "
[foo]: /url\n
\n" - it "CM178" $ - let s = "Foo\n[bar]: /baz\n\n[bar]\n" - in s - ~~-> [ errFancy 5 (couldNotMatchRef "bar" []), - errFancy 18 (couldNotMatchRef "bar" []) - ] - it "CM179" $ - "# [Foo]\n[foo]: /url\n> bar" - ==-> "

Foo

\n
\n

bar

\n
\n" - it "CM180" $ - "[foo]: /foo-url \"foo\"\n[bar]: /bar-url\n \"bar\"\n[baz]: /baz-url\n\n[foo],\n[bar],\n[baz]" - ##-> p_ - ( do - a_ [href_ "/foo-url", title_ "foo"] "foo" - ",\n" - a_ [href_ "/bar-url", title_ "bar"] "bar" - ",\n" - a_ [href_ "/baz-url"] "baz" - ) - it "CM181" $ - "[foo]\n\n> [foo]: /url" - ==-> "

foo

\n
\n
\n" - context "4.8 Paragraphs" $ do - it "CM182" $ - "aaa\n\nbbb" - ==-> "

aaa

\n

bbb

\n" - it "CM183" $ - "aaa\nbbb\n\nccc\nddd" - ==-> "

aaa\nbbb

\n

ccc\nddd

\n" - it "CM184" $ - "aaa\n\n\nbbb" - ==-> "

aaa

\n

bbb

\n" - it "CM185" $ - " aaa\n bbb" - ==-> "

aaa\nbbb

\n" - it "CM186" $ - "aaa\n bbb\n ccc" - ==-> "

aaa\nbbb\nccc

\n" - it "CM187" $ - " aaa\nbbb" ==-> "

aaa\nbbb

\n" - it "CM188" $ - " aaa\nbbb" - ==-> "
aaa\n
\n

bbb

\n" - it "CM189" $ - "aaa \nbbb " - ==-> "

aaa\nbbb

\n" - context "4.9 Blank lines" $ - it "CM190" $ - " \n\naaa\n \n\n# aaa\n\n " - ==-> "

aaa

\n

aaa

\n" - context "5.1 Block quotes" $ do - it "CM191" $ - "> # Foo\n bar\n baz" - ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" - it "CM192" $ - "># Foo\n bar\n baz" - ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" - it "CM193" $ - " > # Foo\n bar\n baz" - ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" - it "CM194" $ - " > # Foo\n > bar\n > baz" - ==-> "
> # Foo\n> bar\n> baz\n
\n" - it "CM195" $ - "> # Foo\n> bar\nbaz" - ==-> "
\n

Foo

\n
\n
\n

bar

\n
\n

baz

\n" - it "CM196" $ - "> bar\nbaz\n> foo" - ==-> "
\n

bar

\n
\n

baz

\n
\n

foo

\n
\n" - it "CM197" $ - "> foo\n---" - ==-> "
\n

foo

\n
\n
\n" - it "CM198" $ - "> - foo\n- bar" - ==-> "
\n
    \n
  • \nfoo\n
    • \n
\n
\n
    \n
  • \nbar\n
    • \n
\n" - it "CM199" $ - "> foo\n bar" - ==-> "
\n
foo\n
\n

bar

\n
\n" - it "CM200" $ - "> ```\nfoo\n```" - ==-> "
\n
foo\n
\n
\n" - it "CM201" $ - "> foo\n - bar" - ==-> "
\n

foo

\n
    \n
  • \nbar\n
    • \n
\n
\n" - it "CM202" $ - ">" - ==-> "
\n
\n" - it "CM203" $ - ">\n> \n> " - ==-> "
\n
\n
\n
\n
\n
\n" - it "CM204" $ - ">\n foo\n " - ==-> "
\n

foo

\n
\n" - it "CM205" $ - "> foo\n\n> bar" - ==-> "
\n

foo

\n
\n
\n

bar

\n
\n" - it "CM206" $ - "> foo\n bar" - ==-> "
\n

foo\nbar

\n
\n" - it "CM207" $ - "> foo\n\n bar" - ==-> "
\n

foo

\n

bar

\n
\n" - it "CM208" $ - "foo\n> bar" - ==-> "

foo

\n
\n

bar

\n
\n" - it "CM209" $ - "> aaa\n***\n> bbb" - ==-> "
\n

aaa

\n
\n
\n
\n

bbb

\n
\n" - it "CM210" $ - "> bar\n baz" - ==-> "
\n

bar\nbaz

\n
\n" - it "CM211" $ - "> bar\n\nbaz" - ==-> "
\n

bar

\n
\n

baz

\n" - it "CM212" $ - "> bar\n\nbaz" - ==-> "
\n

bar

\n
\n

baz

\n" - it "CM213" $ - "> > > foo\nbar" - ==-> "
\n
\n
\n

foo

\n
\n
\n
\n

bar

\n" - it "CM214" $ - ">>> foo\n bar\n baz" - ==-> "
\n
\n
\n

foo\nbar\nbaz

\n
\n
\n
\n" - it "CM215" $ - "> code\n\n> not code" - ==-> "
\n
code\n
\n
\n
\n

not code

\n
\n" - context "5.2 List items" $ do - it "CM216" $ - "A paragraph\nwith two lines.\n\n indented code\n\n> A block quote." - ==-> "

A paragraph\nwith two lines.

\n
indented code\n
\n
\n

A block quote.

\n
\n" - it "CM217" $ - "1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." - ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" - it "CM218" $ - "- one\n\n two" - ==-> "
    \n
  • \none\n
    • \n
\n

two

\n" - it "CM219" $ - "- one\n\n two" - ==-> "
    \n
  • \n

    one

    \n

    two

    \n
    • \n
\n" - it "CM220" $ - " - one\n\n two" - ==-> "
    \n
  • \none\n
    • \n
\n
 two\n
\n" - it "CM221" $ - " - one\n\n two" - ==-> "
    \n
  • \n

    one

    \n

    two

    \n
    • \n
\n" - it "CM222" $ - " > > 1. one\n\n two" - ==-> "
\n
\n
    \n
  1. \none\n
    2. \n
\n

two

\n
\n
\n" - it "CM223" $ - ">>- one\n\n two" - ==-> "
\n
\n
    \n
  • \n

    one

    \n

    two

    \n
    • \n
\n
\n
\n" - it "CM224" $ - "-one\n\n2.two" - ==-> "

-one

\n

2.two

\n" - it "CM225" $ - "- foo\n\n\n bar" - ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" - it "CM226" $ - "1. foo\n\n ```\n bar\n ```\n\n baz\n\n > bam" - ==-> "
    \n
  1. \n

    foo

    \n
    bar\n
    \n

    baz

    \n
    \n

    bam

    \n
    \n
    2. \n
\n" - it "CM227" $ - "- Foo\n\n bar\n\n\n baz" - ==-> "
    \n
  • \n

    Foo

    \n
    bar\n\n\nbaz\n
    \n
    • \n
\n" - it "CM228" $ - "123456789. ok" - ==-> "
    \n
  1. \nok\n
    2. \n
\n" - it "CM229" $ - let s = "1234567890. not ok\n" - in s ~-> errFancy 0 (indexTooBig 1234567890) - it "CM230" $ - "0. ok" - ==-> "
    \n
  1. \nok\n
    2. \n
\n" - it "CM231" $ - "003. ok" - ==-> "
    \n
  1. \nok\n
    2. \n
\n" - it "CM232" $ - "-1. not ok" - ==-> "

-1. not ok

\n" - it "CM233" $ - "- foo\n\n bar" - ==-> "
    \n
  • \n

    foo

    \n
    bar\n
    \n
    • \n
\n" - it "CM234" $ - " 10. foo\n\n bar" - ==-> "
    \n
  1. \n

    foo

    \n
    bar\n
    \n
    2. \n
\n" - it "CM235" $ - " indented code\n\nparagraph\n\n more code" - ==-> "
indented code\n
\n

paragraph

\n
more code\n
\n" - it "CM236" $ - "1. indented code\n\n paragraph\n\n more code" - ==-> "
    \n
  1. \n
    indented code\n
    \n

    paragraph

    \n
    more code\n
    \n
    2. \n
\n" - it "CM237" $ - "1. indented code\n\n paragraph\n\n more code" - ==-> "
    \n
  1. \n
     indented code\n
    \n

    paragraph

    \n
    more code\n
    \n
    2. \n
\n" - it "CM238" $ - " foo\n\nbar" - ==-> "

foo

\n

bar

\n" - it "CM239" $ - "- foo\n\n bar" - ==-> "
    \n
  • \nfoo\n
    • \n
\n

bar

\n" - it "CM240" $ - "- foo\n\n bar" - ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" - it "CM241" $ - "-\n foo\n-\n ```\n bar\n ```\n-\n baz" - ==-> "
    \n
  • \n

    foo

    \n
    • \n
  • \n
    bar\n
    \n
    • \n
  • \n
    baz\n
    \n
    • \n
\n" - it "CM242" $ - "- \n foo" - ==-> "
    \n
  • \nfoo\n
    • \n
\n" - it "CM243a" $ - "-\n\n foo" - ==-> "
    \n
  • \n\n
    • \n
\n

foo

\n" - it "CM243b" $ - "1.\n\n foo" - ==-> "
    \n
  1. \n\n
    2. \n
\n

foo

\n" - it "CM244" $ - "- foo\n-\n- bar" - ==-> "
    \n
  • \nfoo\n
    • \n
  • \n\n
    • \n
  • \nbar\n
    • \n
\n" - it "CM245" $ - "- foo\n- \n- bar" - ==-> "
    \n
  • \nfoo\n
    • \n
  • \n\n
    • \n
  • \nbar\n
    • \n
\n" - it "CM246" $ - "1. foo\n2.\n3. bar" - ==-> "
    \n
  1. \nfoo\n
    2. \n
  2. \n\n
    3. \n
  3. \nbar\n
    4. \n
\n" - it "CM247" $ - "*" - ==-> "
    \n
  • \n\n
    • \n
\n" - it "CM248" $ - "foo\n*\n\nfoo\n1." - ==-> "

foo

\n
    \n
  • \n\n
    • \n
\n

foo

\n
    \n
  1. \n\n
    2. \n
\n" - it "CM249" $ - " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." - ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" - it "CM250" $ - " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." - ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" - it "CM251" $ - " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." - ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" - it "CM252" $ - " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." - ==-> "
1.  A paragraph\n    with two lines.\n\n        indented code\n\n    > A block quote.\n
\n" - it "CM253" $ - " 1. A paragraph\nwith two lines.\n\n indented code\n\n > A block quote." - ==-> "
    \n
  1. \nA paragraph\n
    2. \n
\n

with two lines.

\n
      indented code\n\n  > A block quote.\n
\n" - it "CM254" $ - " 1. A paragraph\n with two lines." - ==-> "
    \n
  1. \nA paragraph\n
    2. \n
\n
with two lines.\n
\n" - it "CM255" $ - "> 1. > Blockquote\ncontinued here." - ==-> "
\n
    \n
  1. \n
    \n

    Blockquote

    \n
    \n
    2. \n
\n
\n

continued here.

\n" - it "CM256" $ - "> 1. > Blockquote\n continued here." - ==-> "
\n
    \n
  1. \n
    \n

    Blockquote

    \n
    \n
    2. \n
\n

continued here.

\n
\n" - it "CM257" $ - "- foo\n - bar\n - baz\n - boo" - ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \nbaz\n
          \n
        • \nboo\n
          • \n
        \n
        • \n
      \n
      • \n
    \n
    • \n
\n" - it "CM258" $ - "- foo\n - bar\n - baz\n - boo" - ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
  • \nbaz\n
    • \n
  • \nboo\n
    • \n
\n" - it "CM259" $ - "10) foo\n - bar" - ==-> "
    \n
  1. \nfoo\n
      \n
    • \nbar\n
      • \n
    \n
    2. \n
\n" - it "CM260" $ - "10) foo\n - bar" - ==-> "
    \n
  1. \nfoo\n
    2. \n
\n
    \n
  • \nbar\n
    • \n
\n" - it "CM261" $ - "- - foo" - ==-> "
    \n
  • \n
      \n
    • \nfoo\n
      • \n
    \n
    • \n
\n" - it "CM262" $ - "1. - 2. foo" - ==-> "
    \n
  1. \n
      \n
    • \n
        \n
      1. \nfoo\n
        2. \n
      \n
      • \n
    \n
    2. \n
\n" - it "CM263" $ - "- # Foo\n- Bar\n ---\n baz" - ==-> "
    \n
  • \n

    Foo

    \n
    • \n
  • \n

    Bar

    \n
    \n

    baz

    \n
    • \n
\n" - context "5.3 Lists" $ do - it "CM264" $ - "- foo\n- bar\n+ baz" - ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
\n
    \n
  • \nbaz\n
    • \n
\n" - it "CM265" $ - "1. foo\n2. bar\n3) baz" - ==-> "
    \n
  1. \nfoo\n
    2. \n
  2. \nbar\n
    3. \n
\n
    \n
  1. \nbaz\n
    2. \n
\n" - it "CM266" $ - "Foo\n- bar\n- baz" - ==-> "

Foo

\n
    \n
  • \nbar\n
    • \n
  • \nbaz\n
    • \n
\n" - it "CM267" $ - "The number of windows in my house is\n14. The number of doors is 6." - ==-> "

The number of windows in my house is

\n
    \n
  1. \nThe number of doors is 6.\n
    2. \n
\n" - it "CM268" $ - "The number of windows in my house is\n1. The number of doors is 6." - ==-> "

The number of windows in my house is

\n
    \n
  1. \nThe number of doors is 6.\n
    2. \n
\n" - it "CM269" $ - "- foo\n\n- bar\n\n\n- baz" - ==-> "
    \n
  • \n

    foo

    \n
    • \n
  • \n

    bar

    \n
    • \n
  • \n

    baz

    \n
    • \n
\n" - it "CM270" $ - "- foo\n - bar\n - baz\n\n\n bim" - ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \n

        baz

        \n

        bim

        \n
        • \n
      \n
      • \n
    \n
    • \n
\n" - it "CM271" $ - "- foo\n- bar\n\n\n\n- baz\n- bim" - ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
\n

<!-- -->

\n
    \n
  • \nbaz\n
    • \n
  • \nbim\n
    • \n
\n" - it "CM272" $ - "- foo\n\n notcode\n\n- foo\n\n\n\n code" - ==-> "
    \n
  • \n

    foo

    \n

    notcode

    \n
    • \n
  • \n

    foo

    \n
    • \n
\n

<!-- -->

\n
code\n
\n" - it "CM273" $ - "- a\n - b\n - c\n - d\n - e\n - f\n - g\n - h\n- i" - ==-> "
    \n
  • \na\n
    • \n
  • \nb\n
    • \n
  • \nc\n
    • \n
  • \nd\n
    • \n
  • \ne\n
    • \n
  • \nf\n
    • \n
  • \ng\n
    • \n
  • \nh\n
    • \n
  • \ni\n
    • \n
\n" - it "CM274" $ - "1. a\n\n 2. b\n\n 3. c" - ==-> "
    \n
  1. \n

    a

    \n
    2. \n
  2. \n

    b

    \n
    3. \n
  3. \n

    c

    \n
    4. \n
\n" - it "CM275" $ - "- a\n- b\n\n- c" - ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n
    • \n
  • \n

    c

    \n
    • \n
\n" - it "CM276" $ - "* a\n*\n\n* c" - ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    \n
    • \n
  • \n

    c

    \n
    • \n
\n" - it "CM277" $ - "- a\n- b\n\n c\n- d" - ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n

    c

    \n
    • \n
  • \n

    d

    \n
    • \n
\n" - it "CM278" $ - "- a\n- b\n\n [ref]: /url\n- d" - ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n
    • \n
  • \n

    d

    \n
    • \n
\n" - it "CM279" $ - "- a\n- ```\n b\n\n\n ```\n- c" - ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n
    b\n\n\n
    \n
    • \n
  • \n

    c

    \n
    • \n
\n" - it "CM280" $ - "- a\n - b\n\n c\n- d" - ==-> "
    \n
  • \na\n
      \n
    • \n

      b

      \n

      c

      \n
      • \n
    \n
    • \n
  • \nd\n
    • \n
\n" - it "CM281" $ - "* a\n > b\n >\n* c" - ==-> "
    \n
  • \n

    a

    \n
    \n

    b

    \n
    \n
    \n
    \n
    • \n
  • \n

    c

    \n
    • \n
\n" - it "CM282" $ - "- a\n > b\n ```\n c\n ```\n- d" - ==-> "
    \n
  • \n

    a

    \n
    \n

    b

    \n
    \n
    c\n
    \n
    • \n
  • \n

    d

    \n
    • \n
\n" - it "CM283" $ - "- a" - ==-> "
    \n
  • \na\n
    • \n
\n" - it "CM284" $ - "- a\n - b" - ==-> "
    \n
  • \na\n
      \n
    • \nb\n
      • \n
    \n
    • \n
\n" - it "CM285" $ - "1. ```\n foo\n ```\n\n bar" - ==-> "
    \n
  1. \n
    foo\n
    \n

    bar

    \n
    2. \n
\n" - it "CM286" $ - "* foo\n * bar\n\n baz" - ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
      • \n
    \nbaz\n
    • \n
\n" - it "CM287" $ - "- a\n - b\n - c\n\n- d\n - e\n - f" - ==-> "
    \n
  • \na\n
      \n
    • \nb\n
      • \n
    • \nc\n
      • \n
    \n
    • \n
  • \nd\n
      \n
    • \ne\n
      • \n
    • \nf\n
      • \n
    \n
    • \n
\n" - context "6 Inlines" $ - it "CM288" $ - let s = "`hi`lo`\n" - in s ~-> err 7 (ueib <> etok '`' <> ecsc) - context "6.1 Blackslash escapes" $ do - it "CM289" $ - "\\!\\\"\\#\\$\\%\\&\\'\\(\\)\\*\\+\\,\\-\\.\\/\\:\\;\\<\\=\\>\\?\\@\\[\\\\\\]\\^\\_\\`\\{\\|\\}\\~\n" - ==-> "

!"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~

\n" - it "CM290" $ - "\\\t\\A\\a\\ \\3\\φ\\«" - ==-> "

\\\t\\A\\a\\ \\3\\φ\\«

\n" - it "CM291" $ - "\\*not emphasized\\*\n\\
not a tag\n\\[not a link\\](/foo)\n\\`not code\\`\n1\\. not a list\n\\* not a list\n\\# not a heading\n\\[foo\\]: /url \"not a reference\"\n" - ==-> "

*not emphasized*\n<br/> not a tag\n[not a link](/foo)\n`not code`\n1. not a list\n* not a list\n# not a heading\n[foo]: /url "not a reference"

\n" - it "CM292" $ - let s = "\\\\*emphasis*" - in s ~-> errFancy 2 (nonFlanking "*") - it "CM293" $ - "foo\\\nbar" - ==-> "

foo
\nbar

\n" - it "CM294" $ - "`` \\[\\` ``" - ==-> "

\\[\\`

\n" - it "CM295" $ - " \\[\\]" - ==-> "
\\[\\]\n
\n" - it "CM296" $ - "~~~\n\\[\\]\n~~~" - ==-> "
\\[\\]\n
\n" - it "CM297" $ - "" - ==-> "

http://example.com?find=*

\n" - it "CM298" $ - "" - ==-> "

<a href="/bar/)">

\n" - it "CM299" $ - let s = "[foo](/bar\\* \"ti\\*tle\")" - in s ~-> err 10 (utok '\\' <> euric <> euri) - it "CM300" $ - let s = "[foo]\n\n[foo]: /bar\\* \"ti\\*tle\"" - in s - ~~-> [ errFancy 1 (couldNotMatchRef "foo" []), - err 18 (utok '\\' <> euric <> euri) - ] - it "CM301" $ - "``` foo\\+bar\nfoo\n```" - ==-> "
foo\n
\n" - context "6.2 Entity and numeric character references" $ do - it "CM302" $ - "  & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸" - ==-> "

  & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸

\n" - it "CM303a" $ - "# Ӓ Ϡ" - ==-> "

# Ӓ Ϡ

\n" - it "CM303b" $ - "�" ~-> errFancy 0 (invalidNumChar 98765432) - it "CM303c" $ - "�" ~-> errFancy 0 (invalidNumChar 0) - it "CM304" $ - "" ആ ಫ" - ==-> "

" ആ ಫ

\n" - it "CM305a" $ - " " ==-> "

&nbsp

\n" - it "CM305b" $ - let s = "&x;" - in s ~-> errFancy 0 (unknownEntity "x") - it "CM305c" $ - let s = "&#;" - in s ~-> err 2 (utok ';' <> etok 'x' <> etok 'X' <> elabel "integer") - it "CM305d" $ - let s = "&#x;" - in s ~-> err 3 (utok ';' <> elabel "hexadecimal integer") - it "CM305e" $ - let s = "&ThisIsNotDefined;" - in s ~-> errFancy 0 (unknownEntity "ThisIsNotDefined") - it "CM305f" $ - "&hi?;" ==-> "

&hi?;

\n" - it "CM306" $ - "©" - ==-> "

&copy

\n" - it "CM307" $ - let s = "&MadeUpEntity;" - in s ~-> errFancy 0 (unknownEntity "MadeUpEntity") - it "CM308" $ - "" - ==-> "

<a href="\246\246.html">

\n" - it "CM309" $ - "[foo](/föö \"föö\")" - ##-> p_ (a_ [href_ "/f%26ouml%3b%26ouml%3b", title_ "f\246\246"] "foo") - it "CM310" $ - "[foo]\n\n[foo]: /föö \"föö\"" - ##-> p_ (a_ [href_ "/f%26ouml%3b%26ouml%3b", title_ "f\246\246"] "foo") - it "CM311" $ - "``` föö\nfoo\n```" - ==-> "
foo\n
\n" - it "CM312" $ - "`föö`" - ==-> "

f&ouml;&ouml;

\n" - it "CM313" $ - " föfö" - ==-> "
f&ouml;f&ouml;\n
\n" - context "6.3 Code spans" $ do - it "CM314" $ - "`foo`" ==-> "

foo

\n" - it "CM315" $ - "`` foo ` bar ``" - ==-> "

foo ` bar

\n" - it "CM316" $ - "` `` `" ==-> "

``

\n" - it "CM317" $ - "``\nfoo\n``" ==-> "

foo

\n" - it "CM318" $ - "`foo bar\n baz`" ==-> "

foo bar baz

\n" - it "CM319" $ - "`a  b`" ==-> "

a  b

\n" - it "CM320" $ - "`foo `` bar`" ==-> "

foo `` bar

\n" - it "CM321" $ - let s = "`foo\\`bar`\n" - in s ~-> err 10 (ueib <> etok '`' <> ecsc) - it "CM322" $ - let s = "*foo`*`\n" - in s ~-> err 7 (ueib <> etok '*' <> eic) - it "CM323" $ - let s = "[not a `link](/foo`)\n" - in s ~-> err 20 (ueib <> etok ']' <> eic) - it "CM324" $ - let s = "``\n" - in s ~-> err 14 (ueib <> etok '`' <> ecsc) - it "CM325" $ - "`" - ==-> "

<a href="">

\n" - it "CM326" $ - let s = "``\n" - in s ~-> err 23 (ueib <> etok '`' <> ecsc) - it "CM327" $ - "`" - ==-> "

<http://foo.bar.baz>

\n" - it "CM328" $ - let s = "```foo``\n" - in s ~-> err 8 (ueib <> etok '`' <> ecsc) - it "CM329" $ - let s = "`foo\n" - in s ~-> err 4 (ueib <> etok '`' <> ecsc) - it "CM330" $ - let s = "`foo``bar``\n" - in s ~-> err 11 (ueib <> etok '`' <> ecsc) - context "6.4 Emphasis and strong emphasis" $ do - it "CM331" $ - "*foo bar*" ==-> "

foo bar

\n" - it "CM332" $ - let s = "a * foo bar*\n" - in s ~-> errFancy 2 (nonFlanking "*") - it "CM333" $ - let s = "a*\"foo\"*\n" - in s ~-> errFancy 1 (nonFlanking "*") - it "CM334" $ - let s = "* a *\n" - in s ~-> errFancy 0 (nonFlanking "*") - it "CM335" $ - let s = "foo*bar*\n" - in s ~-> errFancy 3 (nonFlanking "*") - it "CM336" $ - let s = "5*6*78\n" - in s ~-> errFancy 1 (nonFlanking "*") - it "CM337" $ - "_foo bar_" ==-> "

foo bar

\n" - it "CM338" $ - let s = "_ foo bar_\n" - in s ~-> errFancy 0 (nonFlanking "_") - it "CM339" $ - let s = "a_\"foo\"_\n" - in s ~-> errFancy 1 (nonFlanking "_") - it "CM340" $ - let s = "foo_bar_\n" - in s ~-> errFancy 3 (nonFlanking "_") - it "CM341" $ - let s = "5_6_78\n" - in s ~-> errFancy 1 (nonFlanking "_") - it "CM342" $ - let s = "пристаням_стремятся_\n" - in s ~-> errFancy 9 (nonFlanking "_") - it "CM343" $ - let s = "aa_\"bb\"_cc\n" - in s ~-> errFancy 2 (nonFlanking "_") - it "CM344" $ - let s = "foo-_(bar)_\n" - in s ~-> errFancy 4 (nonFlanking "_") - it "CM345" $ - let s = "_foo*\n" - in s ~-> err 4 (utok '*' <> etok '_' <> eic) - it "CM346" $ - let s = "*foo bar *\n" - in s ~-> errFancy 9 (nonFlanking "*") - it "CM347" $ - let s = "*foo bar\n*\n" - in s ~-> err 8 (ueib <> etok '*' <> eic) - it "CM348" $ - let s = "*(*foo)\n" - in s ~-> err 7 (ueib <> etok '*' <> eic) - it "CM349" $ - "*(*foo*)*" - ==-> "

(foo)

\n" - it "CM350" $ - let s = "*foo*bar\n" - in s ~-> errFancy 4 (nonFlanking "*") - it "CM351" $ - let s = "_foo bar _\n" - in s ~-> errFancy 9 (nonFlanking "_") - it "CM352" $ - let s = "_(_foo)" - in s ~-> err 7 (ueib <> etok '_' <> eic) - it "CM353" $ - "_(_foo_)_" - ==-> "

(foo)

\n" - it "CM354" $ - let s = "_foo_bar\n" - in s ~-> errFancy 4 (nonFlanking "_") - it "CM355" $ - let s = "_пристаням_стремятся\n" - in s ~-> errFancy 10 (nonFlanking "_") - it "CM356" $ - let s = "_foo_bar_baz_\n" - in s ~-> errFancy 4 (nonFlanking "_") - it "CM357" $ - "_(bar\\)_.\n" ==-> "

(bar).

\n" - it "CM358" $ - "**foo bar**\n" ==-> "

foo bar

\n" - it "CM359" $ - let s = "** foo bar**\n" - in s ~-> errFancy 0 (nonFlanking "**") - it "CM360" $ - let s = "a**\"foo\"**\n" - in s ~-> errFancy 1 (nonFlanking "**") - it "CM361" $ - let s = "foo**bar**\n" - in s ~-> errFancy 3 (nonFlanking "**") - it "CM362" $ - "__foo bar__" ==-> "

foo bar

\n" - it "CM363" $ - let s = "__ foo bar__\n" - in s ~-> errFancy 0 (nonFlanking "__") - it "CM364" $ - let s = "__\nfoo bar__\n" - in s ~-> errFancy 0 (nonFlanking "__") - it "CM365" $ - let s = "a__\"foo\"__\n" - in s ~-> errFancy 1 (nonFlanking "__") - it "CM366" $ - let s = "foo__bar__\n" - in s ~-> errFancy 3 (nonFlanking "__") - it "CM367" $ - let s = "5__6__78\n" - in s ~-> errFancy 1 (nonFlanking "__") - it "CM368" $ - let s = "пристаням__стремятся__\n" - in s ~-> errFancy 9 (nonFlanking "__") - it "CM369" $ - "__foo, __bar__, baz__" - ==-> "

foo, bar, baz

\n" - it "CM370" $ - "foo-__\\(bar)__" ==-> "

foo-(bar)

\n" - it "CM371" $ - let s = "**foo bar **\n" - in s ~-> errFancy 10 (nonFlanking "**") - it "CM372" $ - let s = "**(**foo)\n" - in s ~-> err 9 (ueib <> etoks "**" <> eic) - it "CM373" $ - "*(**foo**)*" - ==-> "

(foo)

\n" - it "CM374" $ - "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**" - ==-> "

Gomphocarpus (Gomphocarpus physocarpus, syn.\nAsclepias physocarpa)

\n" - it "CM375" $ - "**foo \"*bar*\" foo**" - ==-> "

foo "bar" foo

\n" - it "CM376" $ - let s = "**foo**bar\n" - in s ~-> errFancy 5 (nonFlanking "**") - it "CM377" $ - let s = "__foo bar __\n" - in s ~-> errFancy 10 (nonFlanking "__") - it "CM378" $ - let s = "__(__foo)\n" - in s ~-> err 9 (ueib <> etoks "__" <> eic) - it "CM379" $ - "_(__foo__)_" - ==-> "

(foo)

\n" - it "CM380" $ - let s = "__foo__bar\n" - in s ~-> errFancy 5 (nonFlanking "__") - it "CM381" $ - let s = "__пристаням__стремятся\n" - in s ~-> errFancy 11 (nonFlanking "__") - it "CM382" $ - "__foo\\_\\_bar\\_\\_baz__" - ==-> "

foo__bar__baz

\n" - it "CM383" $ - "__(bar\\)__." - ==-> "

(bar).

\n" - it "CM384" $ - "*foo [bar](/url)*" - ==-> "

foo bar

\n" - it "CM385" $ - "*foo\nbar*" - ==-> "

foo\nbar

\n" - it "CM386" $ - "_foo __bar__ baz_" - ==-> "

foo bar baz

\n" - it "CM387" $ - "_foo _bar_ baz_" - ==-> "

foo bar baz

\n" - it "CM388" $ - let s = "__foo_ bar_" - in s ~-> err 5 (utoks "_ " <> etoks "__" <> eic) - it "CM389" $ - "*foo *bar**" - ==-> "

foo bar

\n" - it "CM390" $ - "*foo **bar** baz*" - ==-> "

foo bar baz

\n" - it "CM391" $ - let s = "*foo**bar**baz*\n" - in s ~-> errFancy 5 (nonFlanking "*") - it "CM392" $ - "***foo** bar*\n" ==-> "

foo bar

\n" - it "CM393" $ - "*foo **bar***\n" ==-> "

foo bar

\n" - it "CM394" $ - let s = "*foo**bar***\n" - in s ~-> errFancy 5 (nonFlanking "*") - it "CM395" $ - "*foo **bar *baz* bim** bop*\n" - ==-> "

foo bar baz bim bop

\n" - it "CM396" $ - "*foo [*bar*](/url)*\n" - ==-> "

foo bar

\n" - it "CM397" $ - let s = "** is not an empty emphasis\n" - in s ~-> errFancy 0 (nonFlanking "**") - it "CM398" $ - let s = "**** is not an empty strong emphasis\n" - in s ~-> errFancy 0 (nonFlanking "****") - it "CM399" $ - "**foo [bar](/url)**" - ==-> "

foo bar

\n" - it "CM400" $ - "**foo\nbar**" - ==-> "

foo\nbar

\n" - it "CM401" $ - "__foo _bar_ baz__" - ==-> "

foo bar baz

\n" - it "CM402" $ - "__foo __bar__ baz__" - ==-> "

foo bar baz

\n" - it "CM403" $ - "____foo__ bar__" - ==-> "

foo bar

\n" - it "CM404" $ - "**foo **bar****" - ==-> "

foo bar

\n" - it "CM405" $ - "**foo *bar* baz**" - ==-> "

foo bar baz

\n" - it "CM406" $ - let s = "**foo*bar*baz**\n" - in s ~-> err 5 (utoks "*b" <> etoks "**" <> eic) - it "CM407" $ - "***foo* bar**" - ==-> "

foo bar

\n" - it "CM408" $ - "**foo *bar***" - ==-> "

foo bar

\n" - it "CM409" $ - "**foo *bar **baz**\nbim* bop**" - ==-> "

foo bar baz\nbim bop

\n" - it "CM410" $ - "**foo [*bar*](/url)**" - ==-> "

foo bar

\n" - it "CM411" $ - let s = "__ is not an empty emphasis\n" - in s ~-> errFancy 0 (nonFlanking "__") - it "CM412" $ - let s = "____ is not an empty strong emphasis\n" - in s ~-> errFancy 0 (nonFlanking "____") - it "CM413" $ - let s = "foo ***\n" - in s ~-> errFancy 4 (nonFlanking "***") - it "CM414" $ - "foo *\\**" ==-> "

foo *

\n" - it "CM415" $ - "foo *\\_*\n" ==-> "

foo _

\n" - it "CM416" $ - let s = "foo *****\n" - in s ~-> errFancy 8 (nonFlanking "*") - it "CM417" $ - "foo **\\***" ==-> "

foo *

\n" - it "CM418" $ - "foo **\\_**\n" ==-> "

foo _

\n" - it "CM419" $ - let s = "**foo*\n" - in s ~-> err 5 (utok '*' <> etoks "**" <> eic) - it "CM420" $ - let s = "*foo**\n" - in s ~-> errFancy 5 (nonFlanking "*") - it "CM421" $ - let s = "***foo**\n" - in s ~-> err 8 (ueib <> etok '*' <> eic) - it "CM422" $ - let s = "****foo*\n" - in s ~-> err 7 (utok '*' <> etoks "**" <> eic) - it "CM423" $ - let s = "**foo***\n" - in s ~-> errFancy 7 (nonFlanking "*") - it "CM424" $ - let s = "*foo****\n" - in s ~-> errFancy 5 (nonFlanking "***") - it "CM425" $ - let s = "foo ___\n" - in s ~-> errFancy 4 (nonFlanking "___") - it "CM426" $ - "foo _\\__" ==-> "

foo _

\n" - it "CM427" $ - "foo _\\*_" ==-> "

foo *

\n" - it "CM428" $ - let s = "foo _____\n" - in s ~-> errFancy 8 (nonFlanking "_") - it "CM429" $ - "foo __\\___" ==-> "

foo _

\n" - it "CM430" $ - "foo __\\*__" ==-> "

foo *

\n" - it "CM431" $ - let s = "__foo_\n" - in s ~-> err 5 (utok '_' <> etoks "__" <> eic) - it "CM432" $ - let s = "_foo__\n" - in s ~-> errFancy 5 (nonFlanking "_") - it "CM433" $ - let s = "___foo__\n" - in s ~-> err 8 (ueib <> etok '_' <> eic) - it "CM434" $ - let s = "____foo_\n" - in s ~-> err 7 (utok '_' <> etoks "__" <> eic) - it "CM435" $ - let s = "__foo___\n" - in s ~-> errFancy 7 (nonFlanking "_") - it "CM436" $ - let s = "_foo____\n" - in s ~-> errFancy 5 (nonFlanking "___") - it "CM437" $ - "**foo**" ==-> "

foo

\n" - it "CM438" $ - "*_foo_*" ==-> "

foo

\n" - it "CM439" $ - "__foo__" ==-> "

foo

\n" - it "CM440" $ - "_*foo*_" ==-> "

foo

\n" - it "CM441" $ - "****foo****" ==-> "

foo

\n" - it "CM442" $ - "____foo____" ==-> "

foo

\n" - it "CM443" $ - "******foo******" - ==-> "

foo

\n" - it "CM444" $ - "***foo***" ==-> "

foo

\n" - it "CM445" $ - "_____foo_____" - ==-> "

foo

\n" - it "CM446" $ - let s = "*foo _bar* baz_\n" - in s ~-> err 9 (utok '*' <> etok '_' <> eic) - it "CM447" $ - let s = "*foo __bar *baz bim__ bam*\n" - in s ~-> err 19 (utok '_' <> etok '*' <> eic) - it "CM448" $ - let s = "**foo **bar baz**\n" - in s ~-> err 17 (ueib <> etoks "**" <> eic) - it "CM449" $ - let s = "*foo *bar baz*\n" - in s ~-> err 14 (ueib <> etok '*' <> eic) - it "CM450" $ - let s = "*[bar*](/url)\n" - in s ~-> err 5 (utok '*' <> etok ']' <> eic) - it "CM451" $ - let s = "_foo [bar_](/url)\n" - in s ~-> err 9 (utok '_' <> etok ']' <> eic) - it "CM452" $ - let s = "*\n" - in s ~-> errFancy 23 (nonFlanking "*") - it "CM453" $ - let s = "**" - in s ~-> errFancy 11 (nonFlanking "**") - it "CM454" $ - let s = "__\n" - in s ~-> errFancy 11 (nonFlanking "__") - it "CM455" $ - "*a `*`*" ==-> "

a *

\n" - it "CM456" $ - "_a `_`_" ==-> "

a _

\n" - it "CM457" $ - let s = "**a" - in s ~-> err 25 (ueib <> etoks "**" <> eic) - it "CM458" $ - let s = "__a" - in s ~-> err 25 (ueib <> etoks "__" <> eic) - context "6.5 Links" $ do - it "CM459" $ - "[link](/uri \"title\")" - ##-> p_ (a_ [href_ "/uri", title_ "title"] "link") - it "CM460" $ - "[link](/uri)" - ==-> "

link

\n" - it "CM461" $ - let s = "[link]()" - in s - ~-> err - 7 - (utok ')' <> etok '<' <> elabel "URI" <> ews) - it "CM462" $ - "[link](<>)" - ==-> "

link

\n" - it "CM463" $ - let s = "[link](/my uri)\n" - in s - ~-> err - 11 - (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) - it "CM464" $ - let s = "[link]()\n" - in s ~-> err 11 (utok ' ' <> euric <> etok '>') - it "CM465" $ - let s = "[link](foo\nbar)\n" - in s - ~-> err - 11 - (utok 'b' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) - it "CM466" $ - let s = "[link]()\n" - in s ~-> err 11 (utok '\n' <> euric <> etok '>') - it "CM467" $ - let s = "[link](\\(foo\\))" - in s - ~-> err - 7 - ( utok '\\' - <> etoks "//" - <> etok '#' - <> etok '/' - <> etok '<' - <> etok '?' - <> elabel "ASCII alpha character" - <> euri - <> elabel "path piece" - <> ews - ) - it "CM468" $ - "[link](foo(and(bar)))\n" - ==-> "

link))

\n" - it "CM469" $ - let s = "[link](foo\\(and\\(bar\\))" - in s ~-> err 10 (utok '\\' <> euric <> euri) - it "CM470" $ - "[link]()" - ==-> "

link

\n" - it "CM471" $ - let s = "[link](foo\\)\\:)" - in s ~-> err 10 (utok '\\' <> euric <> euri) - it "CM472" $ - "[link](#fragment)\n\n[link](http://example.com#fragment)\n\n[link](http://example.com?foo=3#frag)\n" - ==-> "

link

\n

link

\n

link

\n" - it "CM473" $ - let s = "[link](foo\\bar)" - in s ~-> err 10 (utok '\\' <> euric <> euri) - it "CM474" $ - "[link](foo%20bä)" - ==-> "

link

\n" - it "CM475" $ - let s = "[link](\"title\")" - in s - ~-> err - 7 - ( utok '"' - <> etoks "//" - <> etok '#' - <> etok '/' - <> etok '<' - <> etok '?' - <> elabel "ASCII alpha character" - <> euri - <> elabel "path piece" - <> ews - ) - it "CM476" $ - "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" - ##-> p_ - ( do - a_ [href_ "/url", title_ "title"] "link" - "\n" - a_ [href_ "/url", title_ "title"] "link" - "\n" - a_ [href_ "/url", title_ "title"] "link" - ) - it "CM477" $ - "[link](/url \"title \\\""\")\n" - ##-> p_ (a_ [href_ "/url", title_ "title \"\""] "link") - it "CM478" $ - let s = "[link](/url \"title\")" - in s ~-> err 11 (utok ' ' <> euric <> euri) - it "CM479" $ - let s = "[link](/url \"title \"and\" title\")\n" - in s ~-> err 20 (utok 'a' <> etok ')' <> ews) - it "CM480" $ - "[link](/url 'title \"and\" title')" - ##-> p_ (a_ [href_ "/url", title_ "title \"and\" title"] "link") - it "CM481" $ - "[link]( /uri\n \"title\" )" - ##-> p_ (a_ [href_ "/uri", title_ "title"] "link") - it "CM482" $ - let s = "[link] (/uri)\n" - in s ~-> errFancy 1 (couldNotMatchRef "link" []) - it "CM483" $ - let s = "[link [foo [bar]]](/uri)\n" - in s ~-> err 6 (utok '[' <> etok ']' <> eic) - it "CM484" $ - let s = "[link] bar](/uri)\n" - in s ~-> errFancy 1 (couldNotMatchRef "link" []) - it "CM485" $ - let s = "[link [bar](/uri)\n" - in s ~-> err 6 (utok '[' <> etok ']' <> eic) - it "CM486" $ - "[link \\[bar](/uri)\n" - ==-> "

link [bar

\n" - it "CM487" $ - "[link *foo **bar** `#`*](/uri)" - ==-> "

link foo bar #

\n" - it "CM488" $ - "[![moon](moon.jpg)](/uri)" - ==-> "

\"moon\"

\n" - it "CM489" $ - let s = "[foo [bar](/uri)](/uri)\n" - in s ~-> err 5 (utok '[' <> etok ']' <> eic) - it "CM490" $ - let s = "[foo *[bar [baz](/uri)](/uri)*](/uri)\n" - in s ~-> err 6 (utok '[' <> eic) - it "CM491" $ - let s = "![[[foo](uri1)](uri2)](uri3)" - in s ~-> err 3 (utok '[' <> eic) - it "CM492" $ - let s = "*[foo*](/uri)\n" - in s ~-> err 5 (utok '*' <> etok ']' <> eic) - it "CM493" $ - let s = "[foo *bar](baz*)\n" - in s ~-> err 9 (utok ']' <> etok '*' <> eic) - it "CM494" $ - let s = "*foo [bar* baz]\n" - in s ~-> err 9 (utok '*' <> etok ']' <> eic) - it "CM495" $ - "[foo " - ==-> "

foo <bar attr="">

\n" - it "CM496" $ - let s = "[foo`](/uri)`\n" - in s ~-> err 13 (ueib <> etok ']' <> eic) - it "CM497" $ - "[foo" - ==-> "

foo<http://example.com/?search=>

\n" - it "CM498" $ - "[foo][bar]\n\n[bar]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") - it "CM499" $ - let s = "[link [foo [bar]]][ref]\n\n[ref]: /uri" - in s ~-> err 6 (utok '[' <> etok ']' <> eic) - it "CM500" $ - "[link \\[bar][ref]\n\n[ref]: /uri" - ==-> "

link [bar

\n" - it "CM501" $ - "[link *foo **bar** `#`*][ref]\n\n[ref]: /uri" - ==-> "

link foo bar #

\n" - it "CM502" $ - "[![moon](moon.jpg)][ref]\n\n[ref]: /uri" - ==-> "

\"moon\"

\n" - it "CM503" $ - let s = "[foo [bar](/uri)][ref]\n\n[ref]: /uri" - in s ~-> err 5 (utok '[' <> etok ']' <> eic) - it "CM504" $ - let s = "[foo *bar [baz][ref]*][ref]\n\n[ref]: /uri" - in s ~-> err 10 (utok '[' <> etok '*' <> eic) - it "CM505" $ - let s = "*[foo*][ref]\n\n[ref]: /uri" - in s ~-> err 5 (utok '*' <> etok ']' <> eic) - it "CM506" $ - let s = "[foo *bar][ref]\n\n[ref]: /uri" - in s ~-> err 9 (utok ']' <> etok '*' <> eic) - it "CM507" $ - "[foo \n\n[ref]: /uri" - ==-> "

foo <bar attr="">

\n" - it "CM508" $ - let s = "[foo`][ref]`\n\n[ref]: /uri" - in s ~-> err 12 (ueib <> etok ']' <> eic) - it "CM509" $ - "[foo\n\n[ref]: /uri" - ==-> "

foo<http://example.com/?search=>

\n" - it "CM510" $ - "[foo][BaR]\n\n[bar]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") - it "CM511" $ - "[Толпой][Толпой] is a Russian word.\n\n[ТОЛПОЙ]: /url" - ==-> "

Толпой is a Russian word.

\n" - it "CM512" $ - "[Foo\n bar]: /url\n\n[Baz][Foo bar]" - ==-> "

Baz

\n" - it "CM513" $ - let s = "[foo] [bar]\n\n[bar]: /url \"title\"" - in s ~-> errFancy 1 (couldNotMatchRef "foo" []) - it "CM514" $ - let s = "[foo]\n[bar]\n\n[bar]: /url \"title\"" - in s ~-> errFancy 1 (couldNotMatchRef "foo" []) - it "CM515" $ - let s = "[foo]: /url1\n\n[foo]: /url2\n\n[bar][foo]" - in s ~-> errFancy 15 (duplicateRef "foo") - it "CM516" $ - "[bar][foo\\!]\n\n[foo!]: /url" - ==-> "

bar

\n" - it "CM517" $ - let s = "[foo][ref[]\n\n[ref[]: /uri" - in s - ~~-> [ err - 9 - ( utok '[' - <> etoks "&#" - <> etok '&' - <> etok ']' - <> elabel "escaped character" - ), - err 17 (utok '[' <> etok ']' <> eic) - ] - it "CM518" $ - let s = "[foo][ref[bar]]\n\n[ref[bar]]: /uri" - in s - ~~-> [ err - 9 - ( utok '[' - <> etoks "&#" - <> etok '&' - <> etok ']' - <> elabel "escaped character" - ), - err 21 (utok '[' <> etok ']' <> eic) - ] - it "CM519" $ - let s = "[[[foo]]]\n\n[[[foo]]]: /url" - in s - ~~-> [ err 1 (utok '[' <> eic), - err 12 (utok '[' <> eic) - ] - it "CM520" $ - "[foo][ref\\[]\n\n[ref\\[]: /uri" - ==-> "

foo

\n" - it "CM521" $ - "[bar\\\\]: /uri\n\n[bar\\\\]" - ==-> "

bar\\

\n" - it "CM522" $ - let s = "[]\n\n[]: /uri" - in s - ~~-> [ err 1 (utok ']' <> eic), - err 5 (utok ']' <> eic) - ] - it "CM523" $ - let s = "[\n ]\n\n[\n ]: /uri" - in s - ~~-> [ errFancy 1 (couldNotMatchRef "" []), - errFancy 7 (couldNotMatchRef "" []) - ] - it "CM524" $ - "[foo][]\n\n[foo]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") - it "CM525" $ - let s = "[*foo* bar][]\n\n[*foo* bar]: /url \"title\"" - in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) - it "CM526" $ - "[Foo][]\n\n[foo]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "Foo") - it "CM527" $ - let s = "[foo] \n[]\n\n[foo]: /url \"title\"" - in s ~-> err 8 (utok ']' <> eic) - it "CM528" $ - "[foo]\n\n[foo]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") - it "CM529" $ - let s = "[*foo* bar]\n\n[*foo* bar]: /url \"title\"" - in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) - it "CM530" $ - let s = "[[*foo* bar]]\n\n[*foo* bar]: /url \"title\"" - in s ~-> err 1 (utok '[' <> eic) - it "CM531" $ - let s = "[[bar [foo]\n\n[foo]: /url" - in s ~-> err 1 (utok '[' <> eic) - it "CM532" $ - "[Foo]\n\n[foo]: /url \"title\"" - ##-> p_ (a_ [href_ "/url", title_ "title"] "Foo") - it "CM533" $ - "[foo] bar\n\n[foo]: /url" - ==-> "

foo bar

\n" - it "CM534" $ - let s = "\\[foo]\n\n[foo]: /url \"title\"" - in s ~-> err 5 (utok ']' <> eeib <> eic) - it "CM535" $ - let s = "[foo*]: /url\n\n*[foo*]" - in s ~-> err 19 (utok '*' <> etok ']' <> eic) - it "CM536" $ - "[foo][bar]\n\n[foo]: /url1\n[bar]: /url2" - ==-> "

foo

\n" - it "CM537" $ - "[foo][]\n\n[foo]: /url1" - ==-> "

foo

\n" - it "CM538" $ - let s = "[foo]()\n\n[foo]: /url1" - in s ~-> err 6 (utok ')' <> etok '<' <> elabel "URI" <> ews) - it "CM539" $ - let s = "[foo](not a link)\n\n[foo]: /url1" - in s - ~-> err - 10 - (utok 'a' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) - it "CM540" $ - let s = "[foo][bar][baz]\n\n[baz]: /url" - in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) - it "CM541" $ - "[foo][bar][baz]\n\n[baz]: /url1\n[bar]: /url2" - ==-> "

foobaz

\n" - it "CM542" $ - let s = "[foo][bar][baz]\n\n[baz]: /url1\n[foo]: /url2" - in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) - context "6.6 Images" $ do - it "CM543" $ - "![foo](/url \"title\")" - ==-> "

\"foo\"

\n" - it "CM544" $ - "![foo *bar*](train.jpg \"train & tracks\")" - ==-> "

\"foo

\n" - it "CM545" $ - let s = "![foo ![bar](/url)](/url2)\n" - in s ~-> err 6 (utok '!' <> etok ']' <> eic) - it "CM546" $ - "![foo [bar](/url)](/url2)" - ==-> "

\"foo

\n" - it "CM547" $ - let s = "![foo *bar*][]\n\n[foo *bar*]: train.jpg \"train & tracks\"\n" - in s ~-> errFancy 2 (couldNotMatchRef "foo bar" ["foo *bar*"]) - it "CM548" $ - "![foo *bar*][foobar]\n\n[FOOBAR]: train.jpg \"train & tracks\"" - ==-> "

\"foo

\n" - it "CM549" $ - "![foo](train.jpg)" - ==-> "

\"foo\"

\n" - it "CM550" $ - "My ![foo bar](/path/to/train.jpg \"title\" )" - ==-> "

My \"foo

\n" - it "CM551" $ - "![foo]()" - ==-> "

\"foo\"

\n" - it "CM552" $ - "![](/url)" ==-> "

\n" - it "CM553" $ - "![foo][bar]\n\n[bar]: /url" - ==-> "

\"foo\"

\n" - it "CM554" $ - "![foo][bar]\n\n[BAR]: /url" - ==-> "

\"foo\"

\n" - it "CM555" $ - "![foo][]\n\n[foo]: /url \"title\"" - ==-> "

\"foo\"

\n" - it "CM556" $ - "![foo bar][]\n\n[foo bar]: /url \"title\"" - ==-> "

\"foo

\n" - it "CM557" $ - "![Foo][]\n\n[foo]: /url \"title\"" - ==-> "

\"Foo\"

\n" - it "CM558" $ - let s = "![foo] \n[]\n\n[foo]: /url \"title\"" - in s ~-> err 9 (utok ']' <> eic) - it "CM559" $ - "![foo]\n\n[foo]: /url \"title\"" - ==-> "

\"foo\"

\n" - it "CM560" $ - "![*foo* bar]\n\n[foo bar]: /url \"title\"\n" - ==-> "

\"foo

\n" - it "CM561" $ - let s = "![[foo]]\n\n[[foo]]: /url \"title\"" - in s - ~~-> [ errFancy 3 (couldNotMatchRef "foo" []), - err 11 (utok '[' <> eic) - ] - it "CM562" $ - "![Foo]\n\n[foo]: /url \"title\"" - ==-> "

\"Foo\"

\n" - it "CM563" $ - "!\\[foo\\]\n\n[foo]: /url \"title\"" - ==-> "

![foo]

\n" - it "CM564" $ - "\\![foo]\n\n[foo]: /url \"title\"" - ##-> p_ - ( do - "!" - a_ [href_ "/url", title_ "title"] "foo" - ) - context "6.7 Autolinks" $ do - it "CM565" $ - "" - ==-> "

http://foo.bar.baz

\n" - it "CM566" $ - "" - ==-> "

http://foo.bar.baz/test?q=hello&id=22&boolean

\n" - it "CM567" $ - "" - ==-> "

irc://foo.bar:2233/baz

\n" - it "CM568" $ - "" - ==-> "

FOO@BAR.BAZ

\n" - it "CM569" $ - "" - ==-> "

a+b+c:d

\n" - it "CM570" $ - "" - ==-> "

made-up-scheme://foo/%2cbar

\n" - it "CM571" $ - "" - ==-> "

http://..

\n" - it "CM572" $ - "" - ==-> "

localhost:5001/foo

\n" - it "CM573" $ - "\n" - ==-> "

<http://foo.bar/baz bim>

\n" - it "CM574" $ - "" - ==-> "

<http://example.com/[>

\n" - it "CM575" $ - "" - ==-> "

foo@bar.example.com

\n" - it "CM576" $ - "" - ==-> "

foo+special@Bar.baz-bar0.com

\n" - it "CM577" $ - "" - ==-> "

<foo+@bar.example.com>

\n" - it "CM578" $ - "<>" - ==-> "

<>

\n" - it "CM579" $ - "< http://foo.bar >" - ==-> "

< http://foo.bar >

\n" - it "CM580" $ - "" - ==-> "

m:abc

\n" - it "CM581" $ - "" - ==-> "

foo.bar.baz

\n" - it "CM582" $ - "http://example.com" - ==-> "

http://example.com

\n" - it "CM583" $ - "foo@bar.example.com" - ==-> "

foo@bar.example.com

\n" - context "6.8 Raw HTML" $ - -- NOTE We do not support raw HTML, see the readme. - return () - context "6.9 Hard line breaks" $ do - -- NOTE We currently do not support hard line breaks represented in - -- markup as two spaces before newline. - it "CM605" $ - "foo \nbaz" - ==-> "

foo\nbaz

\n" - it "CM606" $ - "foo\\\nbaz\n" - ==-> "

foo
\nbaz

\n" - it "CM607" $ - "foo \nbaz" - ==-> "

foo\nbaz

\n" - it "CM608" $ - "foo \n bar" - ==-> "

foo\nbar

\n" - it "CM609" $ - "foo\\\n bar" - ==-> "

foo
\nbar

\n" - it "CM610" $ - "*foo \nbar*" - ==-> "

foo\nbar

\n" - it "CM611" $ - "*foo\\\nbar*" - ==-> "

foo
\nbar

\n" - it "CM612" $ - "`code \nspan`" - ==-> "

code span

\n" - it "CM613" $ - "`code\\\nspan`" - ==-> "

code\\ span

\n" - it "CM614" $ - "" - ==-> "

<a href="foo\nbar">

\n" - it "CM615" $ - "" - ==-> "

<a href="foo
\nbar">

\n" - it "CM616" $ - "foo\\" - ==-> "

foo\\

\n" - it "CM617" $ - "foo " - ==-> "

foo

\n" - it "CM618" $ - "### foo\\" - ==-> "

foo\\

\n" - it "CM619" $ - "### foo " - ==-> "

foo

\n" - context "6.10 Soft line breaks" $ do - it "CM620" $ - "foo\nbaz" - ==-> "

foo\nbaz

\n" - it "CM621" $ - "foo \n baz" - ==-> "

foo\nbaz

\n" - context "6.11 Textual content" $ do - it "CM622" $ - "hello $.;'there" - ==-> "

hello $.;'there

\n" - it "CM623" $ - "Foo χρῆν" - ==-> "

Foo χρῆν

\n" - it "CM624" $ - "Multiple spaces" - ==-> "

Multiple spaces

\n" - -- NOTE I don't test these so extensively because they share - -- implementation with emphasis and strong emphasis which are thoroughly - -- tested already. - context "strikeout" $ do - it "works in simplest form" $ - "It's ~~bad~~ news." - ==-> "

It's bad news.

\n" - it "combines with emphasis" $ - "**It's ~~bad~~** news." - ==-> "

It's bad news.

\n" - it "interacts with subscript reasonably (1)" $ - "It's ~~~bad~~ news~." - ==-> "

It's bad news.

\n" - it "interacts with subscript reasonably (2)" $ - "It's ~~~bad~ news~~." - ==-> "

It's bad news.

\n" - context "subscript" $ do - it "works in simplest form" $ - "It's ~bad~ news." - ==-> "

It's bad news.

\n" - it "combines with emphasis" $ - "**It's ~bad~** news." - ==-> "

It's bad news.

\n" - context "superscript" $ do - it "works in simplest form" $ - "It's ^bad^ news." - ==-> "

It's bad news.

\n" - it "combines with emphasis" $ - "**It's ^bad^** news." - ==-> "

It's bad news.

\n" - it "a composite, complex example" $ - "***Something ~~~is not~~ going~ ^so well^** today*." - ==-> "

Something is not going so well today.

\n" - context "collapsed reference links (special cases)" $ - it "offsets after such links are still correct" $ - "[foo][] *foo\n\n[foo]: https://example.org" - ~-> err - 12 - (ueib <> etok '*' <> eic) - context "title parse errors" $ - it "parse error is OK in reference definitions" $ - let s = "[something]: something something" - in s - ~-> err - 23 - ( utoks "so" - <> etok '\'' - <> etok '\"' - <> etok '(' - <> elabel "white space" - <> elabel "newline" - ) - context "tables" $ do - it "recognizes single column tables" $ do - let o = "\n\n\n\n\n\n\n
Foo
foo
\n" - "|Foo\n---\nfoo" ==-> o - "Foo|\n---\nfoo" ==-> o - "| Foo |\n --- \n foo " ==-> o - "| Foo |\n| --- |\n| foo |" ==-> o - it "reports correct parse errors when parsing the header line" $ - ( let s = "Foo | Bar\na-- | ---" - in s ~-> err 10 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space") - ) - >> ( let s = "Foo | Bar\n-a- | ---" - in s ~-> err 11 (utok 'a' <> etok '-') - ) - >> ( let s = "Foo | Bar\n--a | ---" - in s ~-> err 12 (utok 'a' <> etok '-') - ) - >> ( let s = "Foo | Bar\n---a | ---" - in s ~-> err 13 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space") - ) - it "falls back to paragraph when header line is weird enough" $ - "Foo | Bar\nab- | ---" - ==-> "

Foo | Bar\nab- | ---

\n" - it "demands that number of columns in rows match number of columns in header" $ - ( let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar" - in s ~-> err 41 (ulabel "end of table block" <> etok '|' <> eic) - ) - >> ( let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar\n\nHere it goes." - in s ~-> err 41 (utok '\n' <> etok '|' <> eic) - ) - it "recognizes escaped pipes" $ - "Foo \\| | Bar\n--- | ---\nfoo | \\|" - ==-> "\n\n\n\n\n\n\n
Foo |Bar
foo|
\n" - it "escaped characters preserve backslashes for inline-level parser" $ - "Foo | Bar\n--- | ---\n\\*foo\\* | bar" - ==-> "\n\n\n\n\n\n\n
FooBar
*foo*bar
\n" - it "escaped pipes do not fool position tracking" $ - let s = "Foo | Bar\n--- | ---\n\\| *fo | bar" - in s ~-> err 26 (ueib <> etok '*' <> elabel "inline content") - it "pipes in code spans in headers do not fool the parser" $ - "`|Foo|` | `|Bar|`\n--- | ---\nfoo | bar" - ==-> "\n\n\n\n\n\n\n
|Foo||Bar|
foobar
\n" - it "pipes in code spans in cells do not fool the parser" $ - "Foo | Bar\n--- | ---\n`|foo|` | `|bar|`" - ==-> "\n\n\n\n\n\n\n
FooBar
|foo||bar|
\n" - it "multi-line code spans are disallowed in table headers" $ - "`Foo\nBar` | Bar\n--- | ---\nfoo | bar" - ==-> "

Foo Bar | Bar\n--- | ---\nfoo | bar

\n" - it "multi-line code spans are disallowed in table cells" $ - let s = "Foo | Bar\n--- | ---\n`foo\nbar` | bar" - in s - ~~-> [ err 24 (utok '\n' <> etok '`' <> ecsc), - err 35 (ueib <> etok '`' <> ecsc) - ] - it "parses tables with just header row" $ - "Foo | Bar\n--- | ---" - ==-> "\n\n\n\n\n\n
FooBar
\n" - it "recognizes end of table correctly" $ - "Foo | Bar\n--- | ---\nfoo | bar\n\nHere goes a paragraph." - ==-> "\n\n\n\n\n\n\n
FooBar
foobar
\n

Here goes a paragraph.

\n" - it "is capable of reporting a parse error per cell" $ - let s = "Foo | *Bar\n--- | ----\n_foo | bar_" - in s - ~~-> [ err 10 (ueib <> etok '*' <> eic), - err 26 (ueib <> etok '_' <> eic), - errFancy 32 (nonFlanking "_") - ] - it "tables have higher precedence than unordered lists" $ do - "+ foo | bar\n------|----\n" - ==-> "\n\n\n\n\n\n
+ foobar
\n" - "+ foo | bar\n -----|----\n" - ==-> "\n\n\n\n\n\n
+ foobar
\n" - it "tables have higher precedence than ordered lists" $ do - "1. foo | bar\n-------|----\n" - ==-> "\n\n\n\n\n\n
1. foobar
\n" - "1. foo | bar\n ------|----\n" - ==-> "\n\n\n\n\n\n
1. foobar
\n" - it "if table is indented inside unordered list, it's put there" $ - "+ foo | bar\n ----|----\n" - ==-> "
    \n
  • \n\n\n\n\n\n\n
    foobar
    \n
    • \n
\n" - it "if table is indented inside ordered list, it's put there" $ - "1. foo | bar\n ----|----\n" - ==-> "
    \n
  1. \n\n\n\n\n\n\n
    foobar
    \n
    2. \n
\n" - it "renders a comprehensive table correctly" $ - withFiles "data/table.md" "data/table.html" - context "multiple parse errors" $ do - it "they are reported in correct order" $ do - let s = "Foo `\n\nBar `.\n" - pe = ueib <> etok '`' <> ecsc - s - ~~-> [ err 5 pe, - err 13 pe - ] - it "invalid headers are skipped properly" $ do - let s = "#My header\n\nSomething goes __here __.\n" - s - ~~-> [ err 1 (utok 'M' <> etok '#' <> ews), - err 37 (ueib <> etoks "__" <> eic) - ] - describe "every block in a list gets its parse error propagated" $ do - context "with unordered list" $ - it "works" $ do - let s = "- *foo\n\n *bar\n- *baz\n\n *quux\n" - e = ueib <> etok '*' <> eic - s - ~~-> [ err 6 e, - err 14 e, - err 21 e, - err 30 e - ] - context "with ordered list" $ - it "works" $ do - let s = "1. *foo\n\n *bar\n2. *baz\n\n *quux\n" - e = ueib <> etok '*' <> eic - s - ~~-> [ err 7 e, - err 16 e, - err 24 e, - err 34 e - ] - it "too big start index of ordered list does not prevent validation of inner inlines" $ do - let s = "1234567890. *something\n1234567891. [\n" - s - ~~-> [ errFancy 0 (indexTooBig 1234567890), - err 22 (ueib <> etok '*' <> eic), - err 36 (ueib <> eic) - ] - it "non-consecutive indices in ordered list do not prevent further validation" $ do - let s = "1. *foo\n3. *bar\n4. *baz\n" - e = ueib <> etok '*' <> eic - s - ~~-> [ err 7 e, - errFancy 8 (indexNonCons 3 2), - err 15 e, - errFancy 16 (indexNonCons 4 3), - err 23 e - ] - context "given a complete, comprehensive document" $ - it "outputs expected the HTML fragment" $ - withFiles "data/comprehensive.md" "data/comprehensive.html" - describe "useExtension" $ - it "applies given extension" $ do - doc <- mkDoc "Here we go." - toText (MMark.useExtension (append_ext "..") doc) - `shouldBe` "

Here we go...

\n" - describe "useExtensions" $ - it "applies extensions in the right order" $ do - doc <- mkDoc "Here we go." - let exts = - [ append_ext "3", - append_ext "2", - append_ext "1" - ] - toText (MMark.useExtensions exts doc) - `shouldBe` "

Here we go.123

\n" - describe "runScanner and scanner" $ - it "extracts information from markdown document" $ do - doc <- mkDoc "Here we go, pals." - let n = MMark.runScanner doc (length_scan (const True)) - n `shouldBe` 17 - describe "combining of scanners" $ - it "combines scanners" $ do - doc <- mkDoc "Here we go, pals." - let scan = - (,,) - <$> length_scan (const True) - <*> length_scan isSpace - <*> length_scan isPunctuation - r = MMark.runScanner doc scan - r `shouldBe` (17, 3, 2) - describe "projectYaml" $ do - context "when document does not contain a YAML section" $ - it "returns Nothing" $ do - doc <- mkDoc "Here we go." - MMark.projectYaml doc `shouldBe` Nothing - context "when document contains a YAML section" $ do - context "when it is valid" $ do - let r = - object - [ "x" .= Number 100, - "y" .= Number 200 - ] - it "returns the YAML section (1)" $ do - doc <- mkDoc "---\nx: 100\ny: 200\n---\nHere we go." - MMark.projectYaml doc `shouldBe` Just r - it "returns the YAML section (2)" $ do - doc <- mkDoc "---\nx: 100\ny: 200\n---\n\n" - MMark.projectYaml doc `shouldBe` Just r - context "when it is invalid" $ do - let mappingErr = - fancy . ErrorCustom . YamlParseError $ - "mapping values are not allowed in this context" - it "signals correct parse error" $ - let s = "---\nx: 100\ny: x:\n---\nHere we go." - in s ~-> errFancy 15 mappingErr - it "does not choke and can report more parse errors" $ - let s = "---\nx: 100\ny: x:\n---\nHere we *go." - in s - ~~-> [ errFancy 15 mappingErr, - err 33 (ueib <> etok '*' <> eic) - ] - ----------------------------------------------------------------------------- --- Testing extensions - --- | Append given text to all 'Plain' blocks. -append_ext :: Text -> MMark.Extension -append_ext y = Ext.inlineTrans $ \case - Plain x -> Plain (x <> y) - other -> other - ----------------------------------------------------------------------------- --- Testing scanners - --- | Scan total number of characters satisfying a predicate in all 'Plain' --- inlines. -length_scan :: (Char -> Bool) -> L.Fold (Ext.Block (NonEmpty Inline)) Int -length_scan p = Ext.scanner 0 $ \n block -> - getSum $ Sum n <> foldMap (foldMap f) block - where - f (Plain txt) = (Sum . T.length) (T.filter p txt) - f _ = mempty - ----------------------------------------------------------------------------- --- For testing with documents loaded externally - --- | Load a complete markdown document from an external file and compare the --- final HTML rendering with the contents of another file. -withFiles :: - -- | Markdown document - FilePath -> - -- | HTML document containing the correct result - FilePath -> - Expectation -withFiles input output = do - i <- TIO.readFile input - o <- TIO.readFile output - i ==-> o - ----------------------------------------------------------------------------- --- Helpers - --- | Unexpected end of inline block. -ueib :: ET s -ueib = ulabel "end of inline block" - --- | Expecting end of inline block. -eeib :: ET s -eeib = elabel "end of inline block" - --- | Expecting end of URI. -euri :: ET s -euri = elabel "end of URI" - --- | Expecting inline content. -eic :: ET s -eic = elabel "inline content" - --- | Expecting white space. -ews :: ET s -ews = elabel "white space" - --- | Expecting code span content. -ecsc :: ET s -ecsc = elabel "code span content" - --- | Expecting common URI components. -euric :: ET Text -euric = - mconcat - [ etok '#', - etok '%', - etok '/', - etok ':', - etok '?', - etok '@', - elabel "sub-delimiter", - elabel "unreserved character" - ] - --- | The error component complaining that the given 'Text' is not in left- --- or right- flanking position. -nonFlanking :: Text -> EF MMarkErr -nonFlanking = fancy . ErrorCustom . NonFlankingDelimiterRun . NE.fromList . T.unpack +import Control.Monad ((>=>)) +import Data.Aeson +import Data.Char +import Data.List.NonEmpty qualified as NE +import Data.Monoid +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as TIO +import Lucid +import Test.Hspec +import Test.Hspec.Megaparsec +import Text.MMark (MMark, MMarkErr (..)) +import Text.MMark qualified as MMark +import Text.MMark.TestUtils +import Text.MMark.Trans (Bni, Inline (..), Trans) +import Text.MMark.Trans qualified as Trans +import Text.Megaparsec (ErrorFancy (..), errorBundlePretty) + +-- NOTE This test suite is mostly based on (sometimes altered) examples from +-- the CommonMark specification. We use the version 0.31.2 (2024-01-28), +-- which can be found online here: +-- +-- + +spec :: Spec +spec = parallel $ do + describe "parse and render" $ do + context "2.2 Tabs" $ do + it "CM1" $ + "\tfoo\tbaz\t\tbim" + ==-> "
foo\tbaz\t\tbim\n
\n" + it "CM2" $ + " \tfoo\tbaz\t\tbim" + ==-> "
foo\tbaz\t\tbim\n
\n" + it "CM3" $ + " a\ta\n ὐ\ta" + ==-> "
a\ta\nὐ\ta\n
\n" + it "CM4" $ + " - foo\n\n\tbar" + ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" + it "CM5" $ + "- foo\n\n\t\tbar" + ==-> "
    \n
  • \n

    foo

    \n
      bar\n
    \n
    • \n
\n" + it "CM6" $ + ">\t\tfoo" + ==-> "
\n
  foo\n
\n
\n" + it "CM7" $ + "-\t\tfoo" + ==-> "
    \n
  • \n
      foo\n
    \n
    • \n
\n" + it "CM8" $ + " foo\n\tbar" + ==-> "
foo\nbar\n
\n" + it "CM9" $ + " - foo\n - bar\n\t - baz" + ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \nbaz\n
        • \n
      \n
      • \n
    \n
    • \n
\n" + it "CM10" $ + "#\tFoo" ==-> "

Foo

\n" + it "CM11" $ + "*\t*\t*\t" ==-> "
\n" + context "2.4 Backslash escapes" $ do + it "CM12" $ + "\\!\\\"\\#\\$\\%\\&\\'\\(\\)\\*\\+\\,\\-\\.\\/\\:\\;\\<\\=\\>\\?\\@\\[\\\\\\]\\^\\_\\`\\{\\|\\}\\~\n" + ==-> "

!"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~

\n" + it "CM13" $ + "\\\t\\A\\a\\ \\3\\φ\\«" + ==-> "

\\\t\\A\\a\\ \\3\\φ\\«

\n" + it "CM14" $ + "\\*not emphasized\\*\n\\
not a tag\n\\[not a link\\](/foo)\n\\`not code\\`\n1\\. not a list\n\\* not a list\n\\# not a heading\n\\[foo\\]: /url \"not a reference\"\n\\ö not a character entity\n" + ==-> "

*not emphasized*\n<br/> not a tag\n[not a link](/foo)\n`not code`\n1. not a list\n* not a list\n# not a heading\n[foo]: /url "not a reference"\n&ouml; not a character entity

\n" + it "CM15" $ + "\\\\*emphasis*" ==-> "

\\emphasis

\n" + it "CM16" $ + "foo\\\nbar" + ==-> "

foo
\nbar

\n" + it "CM17" $ + "`` \\[\\` ``" + ==-> "

\\[\\`

\n" + it "CM18" $ + " \\[\\]" + ==-> "
\\[\\]\n
\n" + it "CM19" $ + "~~~\n\\[\\]\n~~~" + ==-> "
\\[\\]\n
\n" + it "CM20" $ + "" + ==-> "

https://example.com?find=*

\n" + it "CM21" $ + "" + ==-> "

<a href="/bar/)">

\n" + it "CM22" $ + let s = "[foo](/bar\\* \"ti\\*tle\")" + in s ~-> err 10 (utok '\\' <> euric <> euri) + it "CM23" $ + let s = "[foo]\n\n[foo]: /bar\\* \"ti\\*tle\"" + in s + ~~-> [ errFancy 1 (couldNotMatchRef "foo" []), + err 18 (utok '\\' <> euric <> euri) + ] + it "CM24" $ + "``` foo\\+bar\nfoo\n```" + ==-> "
foo\n
\n" + context "2.5 Entity and numeric character references" $ do + it "CM25" $ + "  & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸" + ==-> "

  & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸

\n" + it "CM26a" $ + "# Ӓ Ϡ" + ==-> "

# Ӓ Ϡ

\n" + it "CM26b" $ + "�" ~-> errFancy 0 (invalidNumChar 98765432) + it "CM26c" $ + "�" ~-> errFancy 0 (invalidNumChar 0) + it "CM27" $ + "" ആ ಫ" + ==-> "

" ആ ಫ

\n" + it "CM28a" $ + " " ==-> "

&nbsp

\n" + it "CM28b" $ + let s = "&x;" + in s ~-> errFancy 0 (unknownEntity "x") + it "CM28c" $ + let s = "&#;" + in s ~-> err 2 (utok ';' <> etok 'x' <> etok 'X' <> elabel "integer") + it "CM28d" $ + let s = "&#x;" + in s ~-> err 3 (utok ';' <> elabel "hexadecimal integer") + it "CM28e" $ + let s = "&ThisIsNotDefined;" + in s ~-> errFancy 0 (unknownEntity "ThisIsNotDefined") + it "CM28f" $ + "&hi?;" ==-> "

&hi?;

\n" + it "CM29" $ + "©" + ==-> "

&copy

\n" + it "CM30" $ + let s = "&MadeUpEntity;" + in s ~-> errFancy 0 (unknownEntity "MadeUpEntity") + it "CM31" $ + "" + ==-> "

<a href="\246\246.html">

\n" + it "CM32" $ + "[foo](/föö \"föö\")" + ##-> p_ (a_ [href_ "/f%26ouml%3b%26ouml%3b", title_ "f\246\246"] "foo") + it "CM33" $ + "[foo]\n\n[foo]: /föö \"föö\"" + ##-> p_ (a_ [href_ "/f%26ouml%3b%26ouml%3b", title_ "f\246\246"] "foo") + it "CM34" $ + "``` föö\nfoo\n```" + ==-> "
foo\n
\n" + it "CM35" $ + "`föö`" + ==-> "

f&ouml;&ouml;

\n" + it "CM36" $ + " föfö" + ==-> "
f&ouml;f&ouml;\n
\n" + it "CM37" $ + "*foo*\n*foo*\n" + ==-> "

*foo*\nfoo

\n" + it "CM38" $ + "* foo\n\n* foo\n" + ==-> "

* foo

\n
    \n
  • \nfoo\n
    • \n
\n" + it "CM39" $ + "foo bar\n" ==-> "

foo\n\nbar

\n" + it "CM40" $ + " foo\n" ==-> "

\tfoo

\n" + it "CM41" $ + let s = "[a](url "tit")\n" + in s ~-> err 8 (utok '&' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) + context "3.1 Precedence" + $ it "CM42" + $ let s = "- `one\n- two`" + in s + ~~-> [ err 6 (ueib <> etok '`' <> ecsc), + err 13 (ueib <> etok '`' <> ecsc) + ] + context "4.1 Thematic breaks" $ do + it "CM43" $ + "***\n---\n___" ==-> "
\n
\n
\n" + it "CM44" $ + "+++" ==-> "

+++

\n" + it "CM45" $ + "===" ==-> "

===

\n" + it "CM46" $ + let s = "--\n**\n__\n" + in s ~-> errFancy 3 (nonFlanking "**") + it "CM47" $ + " ***\n ***\n ***" ==-> "
\n
\n
\n" + it "CM48" $ + " ***" ==-> "
***\n
\n" + it "CM49" $ + let s = "Foo\n ***\n" + in s ~-> errFancy 8 (nonFlanking "***") + it "CM50" $ + "_____________________________________" + ==-> "
\n" + it "CM51" $ + " - - -" ==-> "
\n" + it "CM52" $ + " ** * ** * ** * **" ==-> "
\n" + it "CM53" $ + "- - - -" ==-> "
\n" + it "CM54" $ + "- - - - " ==-> "
\n" + it "CM55" $ + let s = "_ _ _ _ a\n\na------\n\n---a---\n" + in s ~-> errFancy 0 (nonFlanking "_") + it "CM56" $ + " *-*" ==-> "

-

\n" + it "CM57" $ + "- foo\n***\n- bar" + ==-> "
    \n
  • \nfoo\n
    • \n
\n
\n
    \n
  • \nbar\n
    • \n
\n" + it "CM58" $ + "Foo\n***\nbar" + ==-> "

Foo

\n
\n

bar

\n" + it "CM59" $ + "Foo\n---\nbar" + ==-> "

Foo

\n
\n

bar

\n" + it "CM60" $ + "* Foo\n* * *\n* Bar" + ==-> "
    \n
  • \nFoo\n
    • \n
  • \n
      \n
    • \n
        \n
      • \n\n
        • \n
      \n
      • \n
    \n
    • \n
  • \nBar\n
    • \n
\n" + it "CM61" $ + "- Foo\n- * * *" + ==-> "
    \n
  • \nFoo\n
    • \n
  • \n
    \n
    • \n
\n" + context "4.2 ATX headings" $ do + it "CM62" $ + "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo" + ==-> "

foo

\n

foo

\n

foo

\n

foo

\n
foo
\n
foo
\n" + it "CM63" $ + let s = "####### foo" + in s ~-> err 6 (utok '#' <> ews) + it "CM64" $ + let s = "#5 bolt\n\n#hashtag" + in s + ~~-> [ err 1 (utok '5' <> etok '#' <> ews), + err 10 (utok 'h' <> etok '#' <> ews) + ] + it "CM65" $ + "\\## foo" ==-> "

## foo

\n" + it "CM66" $ + "# foo *bar* \\*baz\\*" ==-> "

foo bar *baz*

\n" + it "CM67" $ + "# foo " + ==-> "

foo

\n" + it "CM68" $ + " ### foo\n ## foo\n # foo" + ==-> "

foo

\n

foo

\n

foo

\n" + it "CM69" $ + " # foo" ==-> "
# foo\n
\n" + it "CM70" $ + "foo\n # bar" ==-> "

foo\n# bar

\n" + it "CM71" $ + "## foo ##\n ### bar ###" + ==-> "

foo

\n

bar

\n" + it "CM72" $ + "# foo ##################################\n##### foo ##" + ==-> "

foo

\n
foo
\n" + it "CM73" $ + "### foo ### " ==-> "

foo

\n" + it "CM74" $ + "### foo ### b" ==-> "

foo ### b

\n" + it "CM75" $ + "# foo#" ==-> "

foo#

\n" + it "CM76" $ + "### foo \\###\n## foo #\\##\n# foo \\#" + ==-> "

foo ###

\n

foo ###

\n

foo #

\n" + it "CM77" $ + "****\n## foo\n****" + ==-> "
\n

foo

\n
\n" + it "CM78" $ + "Foo bar\n# baz\nBar foo" + ==-> "

Foo bar

\n

baz

\n

Bar foo

\n" + it "CM79" $ + let s = "## \n#\n### ###" + in s + ~~-> [ err 3 (utok '\n' <> elabel "heading character" <> ews), + err 5 (utok '\n' <> etok '#' <> ews) + ] + context "4.3 Setext headings" $ do + -- NOTE we do not support them, the tests have been adjusted + -- accordingly. + it "CM80" $ + "Foo *bar*\n=========\n\nFoo *bar*\n---------" + ==-> "

Foo bar\n=========

\n

Foo bar

\n
\n" + it "CM81" $ + "Foo *bar\nbaz*\n====" + ==-> "

Foo bar\nbaz\n====

\n" + it "CM82" $ + " Foo *bar\nbaz*\t\n====\n" + ==-> "

Foo bar\nbaz\n====

\n" + it "CM83" $ + "Foo\n-------------------------\n\nFoo\n=" + ==-> "

Foo

\n
\n

Foo\n=

\n" + it "CM84" $ + " Foo\n---\n\n Foo\n-----\n\n Foo\n ===" + ==-> "

Foo

\n
\n

Foo

\n
\n

Foo\n===

\n" + it "CM85" $ + " Foo\n ---\n\n Foo\n---" + ==-> "
Foo\n---\n\nFoo\n
\n
\n" + it "CM86" $ + "Foo\n ---- " + ==-> "

Foo

\n
\n" + it "CM87" $ + "Foo\n ---" + ==-> "

Foo\n---

\n" + it "CM88" $ + "Foo\n= =\n\nFoo\n--- -" + ==-> "

Foo\n= =

\n

Foo

\n
\n" + it "CM89" $ + "Foo \n-----" + ==-> "

Foo

\n
\n" + it "CM90" $ + "Foo\\\n----" + ==-> "

Foo\\

\n
\n" + it "CM91" $ + let s = "`Foo\n----\n`\n\n\n" + in s + ~~-> [ err 4 (ueib <> etok '`' <> ecsc), + err 11 (ueib <> etok '`' <> ecsc) + ] + it "CM92" $ + "> Foo\n---" + ==-> "
\n

Foo

\n
\n
\n" + it "CM93" $ + "> foo\nbar\n===" + ==-> "
\n

foo\nbar\n===

\n
\n" + it "CM94" $ + "- Foo\n---" + ==-> "
    \n
  • \nFoo\n
    • \n
\n
\n" + it "CM95" $ + "Foo\nBar\n---" + ==-> "

Foo\nBar

\n
\n" + it "CM96" $ + "---\nFoo\n---\nBar\n---\nBaz" + ==-> "

Bar

\n
\n

Baz

\n" + it "CM97" $ + "\n====" + ==-> "

====

\n" + it "CM98" $ + "---\n---" + ==-> "" -- thinks that it's got a YAML block + it "CM99" $ + "- foo\n-----" + ==-> "
    \n
  • \nfoo\n
    • \n
\n
\n" + it "CM100" $ + " foo\n---" + ==-> "
foo\n
\n
\n" + it "CM101" $ + "> foo\n-----" + ==-> "
\n

foo

\n
\n
\n" + it "CM102" $ + "\\> foo\n------" + ==-> "

> foo

\n
\n" + it "CM103" $ + "Foo\n\nbar\n---\nbaz" + ==-> "

Foo

\n

bar

\n
\n

baz

\n" + it "CM104" $ + "Foo\nbar\n\n---\n\nbaz" + ==-> "

Foo\nbar

\n
\n

baz

\n" + it "CM105" $ + "Foo\nbar\n* * *\nbaz" + ==-> "

Foo\nbar

\n
\n

baz

\n" + it "CM106" $ + "Foo\nbar\n\\---\nbaz" + ==-> "

Foo\nbar\n---\nbaz

\n" + context "4.4 Indented code blocks" $ do + it "CM107" $ + " a simple\n indented code block" + ==-> "
a simple\n  indented code block\n
\n" + it "CM108" $ + " - foo\n\n bar" + ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" + it "CM109" $ + "1. foo\n\n - bar" + ==-> "
    \n
  1. \n

    foo

    \n
      \n
    • \nbar\n
      • \n
    \n
    2. \n
\n" + it "CM110" $ + " \n *hi*\n\n - one" + ==-> "
<a/>\n*hi*\n\n- one\n
\n" + it "CM111" $ + " chunk1\n\n chunk2\n \n \n \n chunk3" + ==-> "
chunk1\n\nchunk2\n\n\n\nchunk3\n
\n" + it "CM112" $ + " chunk1\n \n chunk2" + ==-> "
chunk1\n  \n  chunk2\n
\n" + it "CM113" $ + "Foo\n bar\n" + ==-> "

Foo\nbar

\n" + it "CM114" $ + " foo\nbar" + ==-> "
foo\n
\n

bar

\n" + it "CM115" $ + "# Heading\n foo\nHeading\n------\n foo\n----\n" + ==-> "

Heading

\n
foo\n
\n

Heading

\n
\n
foo\n
\n
\n" + it "CM116" $ + " foo\n bar" + ==-> "
    foo\nbar\n
\n" + it "CM117" $ + "\n \n foo\n \n" + ==-> "
foo\n
\n" + it "CM118" $ + " foo " + ==-> "
foo  \n
\n" + context "4.5 Fenced code blocks" $ do + it "CM119" $ + "```\n<\n >\n```" + ==-> "
<\n >\n
\n" + it "CM120" $ + "~~~\n<\n >\n~~~" + ==-> "
<\n >\n
\n" + it "CM121" $ + "``\nfoo\n``\n" + ==-> "

foo

\n" + it "CM122" $ + "```\naaa\n~~~\n```" + ==-> "
aaa\n~~~\n
\n" + it "CM123" $ + "~~~\naaa\n```\n~~~" + ==-> "
aaa\n```\n
\n" + it "CM124" $ + "````\naaa\n```\n``````" + ==-> "
aaa\n```\n
\n" + it "CM125" $ + "~~~~\naaa\n~~~\n~~~~" + ==-> "
aaa\n~~~\n
\n" + it "CM126" $ + let s = "```" + in s ~-> err 3 (ueib <> etok '`' <> ecsc) + it "CM127" $ + let s = "`````\n\n```\naaa\n" + in s + ~-> err + 15 + (ueof <> elabel "closing code fence" <> elabel "code block content") + -- NOTE CommonMark closes the code fence implicitly when the block + -- quote containing it ends, while MMark requires an explicit closing + -- fence, see CM126, CM127, CM137, and CM139. The block quote ends at the + -- blank line, which is where we report the missing fence. + it "CM128" $ + let s = "> ```\n> aaa\n\nbbb\n" + in s ~-> err 12 (ebqm <> eccf <> ecbc) + it "CM129" $ + "```\n\n \n```" + ==-> "
\n  \n
\n" + it "CM130" $ + "```\n```" + ==-> "
\n" + it "CM131" $ + " ```\n aaa\naaa\n```" + ==-> "
aaa\naaa\n
\n" + it "CM132" $ + " ```\naaa\n aaa\naaa\n ```" + ==-> "
aaa\naaa\naaa\n
\n" + it "CM133" $ + " ```\n aaa\n aaa\n aaa\n ```" + ==-> "
aaa\n aaa\naaa\n
\n" + it "CM134" $ + " ```\n aaa\n ```" + ==-> "
```\naaa\n```\n
\n" + it "CM135" $ + "```\naaa\n ```" + ==-> "
aaa\n
\n" + it "CM136" $ + " ```\naaa\n ```" + ==-> "
aaa\n
\n" + it "CM137" $ + let s = "```\naaa\n ```\n" + in s + ~-> err + 16 + (ueof <> elabel "closing code fence" <> elabel "code block content") + it "CM138" $ + "``` ```\naaa" + ==-> "

\naaa

\n" + it "CM139" $ + let s = "~~~~~~\naaa\n~~~ ~~\n" + in s + ~-> err + 18 + (ueof <> elabel "closing code fence" <> elabel "code block content") + it "CM140" $ + "foo\n```\nbar\n```\nbaz" + ==-> "

foo

\n
bar\n
\n

baz

\n" + it "CM141" $ + "foo\n---\n~~~\nbar\n~~~\n# baz" + ==-> "

foo

\n
\n
bar\n
\n

baz

\n" + it "CM142" $ + "```ruby\ndef foo(x)\n return 3\nend\n```" + ==-> "
def foo(x)\n  return 3\nend\n
\n" + it "CM143" $ + "~~~~ ruby startline=3 $%@#$\ndef foo(x)\n return 3\nend\n~~~~~~~" + ==-> "
def foo(x)\n  return 3\nend\n
\n" + it "CM144" $ + "````;\n````" + ==-> "
\n" + it "CM145" $ + "``` aa ```\nfoo" + ==-> "

aa\nfoo

\n" + it "CM146" $ + "~~~ aa ``` ~~~\nfoo\n~~~\n" + ==-> "
foo\n
\n" + it "CM147" $ + "```\n``` aaa\n```" + ==-> "
``` aaa\n
\n" + context "4.6 HTML blocks" $ + -- NOTE We do not support HTML blocks, see the readme. + return () + context "4.7 Link reference definitions" $ do + it "CM192" $ + "[foo]: /url \"title\"\n\n[foo]" ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") + it "CM193" $ + " [foo]: \n /url \n 'the title' \n\n[foo]" + ##-> p_ (a_ [href_ "/url", title_ "the title"] "foo") + it "CM194" $ + let s = "[Foo bar\\]]:my_(url) 'title (with parens)'\n\n[Foo bar\\]]" + in s + ~~-> [ err 19 (utoks ") " <> euric <> elabel "newline" <> ews), + errFancy 45 (couldNotMatchRef "Foo bar]" []) + ] + it "CM195" $ + "[Foo bar]:\n\n'title'\n\n[Foo bar]" + ##-> p_ (a_ [href_ "my%20url", title_ "title"] "Foo bar") + it "CM196" $ + "[foo]: /url '\ntitle\nline1\nline2\n'\n\n[foo]" + ##-> p_ (a_ [href_ "/url", title_ "\ntitle\nline1\nline2\n"] "foo") + it "CM197" $ + "[foo]: /url 'title\n\nwith blank line'\n\n[foo]" + ##-> p_ (a_ [href_ "/url", title_ "title\n\nwith blank line"] "foo") + it "CM198" $ + "[foo]:\n/url\n\n[foo]" + ==-> "

foo

\n" + it "CM199" $ + let s = "[foo]:\n\n[foo]" + in s + ~~-> [ err 7 (utok '\n' <> etok '<' <> elabel "URI" <> ews), + errFancy 9 (couldNotMatchRef "foo" []) + ] + it "CM200" $ + "[foo]: <>\n\n[foo]\n" ==-> "

foo

\n" + it "CM201" $ + "[foo]: (baz)\n\n[foo]\n" + ~~-> [ err 12 (utoks "(b" <> elabel "newline" <> ews), + errFancy 20 (couldNotMatchRef "foo" []) + ] + it "CM202" $ + let s = "[foo]: /url\\bar\\*baz \"foo\\\"bar\\baz\"\n\n[foo]\n" + in s ~-> err 11 (utok '\\' <> euric <> euri) + it "CM203" $ + "[foo]\n\n[foo]: url" + ==-> "

foo

\n" + it "CM204" $ + let s = "[foo]\n\n[foo]: first\n[foo]: second\n" + in s ~-> errFancy 21 (duplicateRef "foo") + it "CM205" $ + "[FOO]: /url\n\n[Foo]" + ==-> "

Foo

\n" + it "CM206" $ + "[ΑΓΩ]: /%CF%86%CE%BF%CF%85\n\n[αγω]" + ==-> "

αγω

\n" + it "CM207" $ + "[foo]: /url" + ==-> "" + it "CM208" $ + "[\nfoo\n]: /url\nbar" + ==-> "

bar

\n" + it "CM209" $ + let s = "[foo]: /url \"title\" ok" + in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) + it "CM210" $ + let s = "[foo]: /url\n\"title\" ok\n" + in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) + it "CM211" $ + " [foo]: /url \"title\"" + ==-> "
[foo]: /url "title"\n
\n" + it "CM212" $ + "```\n[foo]: /url\n```" + ==-> "
[foo]: /url\n
\n" + it "CM213" $ + let s = "Foo\n[bar]: /baz\n\n[bar]\n" + in s + ~~-> [ errFancy 5 (couldNotMatchRef "bar" []), + errFancy 18 (couldNotMatchRef "bar" []) + ] + it "CM214" $ + "# [Foo]\n[foo]: /url\n> bar" + ==-> "

Foo

\n
\n

bar

\n
\n" + it "CM215" $ + "[foo]: /url\nbar\n===\n[foo]\n" + ==-> "

bar\n===\nfoo

\n" + it "CM216" $ + "[foo]: /url\n===\n[foo]\n" + ==-> "

===\nfoo

\n" + it "CM217" $ + "[foo]: /foo-url \"foo\"\n[bar]: /bar-url\n \"bar\"\n[baz]: /baz-url\n\n[foo],\n[bar],\n[baz]" + ##-> p_ + ( do + a_ [href_ "/foo-url", title_ "foo"] "foo" + ",\n" + a_ [href_ "/bar-url", title_ "bar"] "bar" + ",\n" + a_ [href_ "/baz-url"] "baz" + ) + it "CM218" $ + "[foo]\n\n> [foo]: /url" + ==-> "

foo

\n
\n
\n" + context "4.8 Paragraphs" $ do + it "CM219" $ + "aaa\n\nbbb" + ==-> "

aaa

\n

bbb

\n" + it "CM220" $ + "aaa\nbbb\n\nccc\nddd" + ==-> "

aaa\nbbb

\n

ccc\nddd

\n" + it "CM221" $ + "aaa\n\n\nbbb" + ==-> "

aaa

\n

bbb

\n" + it "CM222" $ + " aaa\n bbb" + ==-> "

aaa\nbbb

\n" + it "CM223" $ + "aaa\n bbb\n ccc" + ==-> "

aaa\nbbb\nccc

\n" + it "CM224" $ + " aaa\nbbb" ==-> "

aaa\nbbb

\n" + it "CM225" $ + " aaa\nbbb" + ==-> "
aaa\n
\n

bbb

\n" + it "CM226" $ + "aaa \nbbb " + ==-> "

aaa\nbbb

\n" + context "4.9 Blank lines" + $ it "CM227" + $ " \n\naaa\n \n\n# aaa\n\n " + ==-> "

aaa

\n

aaa

\n" + context "5.1 Block quotes" $ do + it "CM228" $ + "> # Foo\n> bar\n> baz" + ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" + it "CM229" $ + "># Foo\n>bar\n> baz" + ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" + it "CM230" $ + " > # Foo\n > bar\n > baz" + ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" + it "CM231" $ + " > # Foo\n > bar\n > baz" + ==-> "
> # Foo\n> bar\n> baz\n
\n" + it "CM232" $ + "> # Foo\n> bar\nbaz" + ==-> "
\n

Foo

\n

bar\nbaz

\n
\n" + it "CM233" $ + "> bar\nbaz\n> foo" + ==-> "
\n

bar\nbaz\nfoo

\n
\n" + it "CM234" $ + "> foo\n---" + ==-> "
\n

foo

\n
\n
\n" + it "CM235" $ + "> - foo\n- bar" + ==-> "
\n
    \n
  • \nfoo\n
    • \n
\n
\n
    \n
  • \nbar\n
    • \n
\n" + it "CM236" $ + "> foo\n bar" + ==-> "
\n
foo\n
\n
\n
bar\n
\n" + -- NOTE Unlike CommonMark, MMark demands that code fences be closed + -- explicitly, see CM126, CM127, CM137, and CM139. The block quote ends + -- at the second line, so the fence it opens is never closed, just like + -- in CM128. + it "CM237" $ + let s = "> ```\nfoo\n```" + in s ~-> err 6 (ebqm <> eccf <> ecbc) + it "CM238" $ + "> foo\n - bar" + ==-> "
\n

foo\n- bar

\n
\n" + it "CM239" $ + ">" + ==-> "
\n
\n" + it "CM240" $ + ">\n> \n> " + ==-> "
\n
\n" + it "CM241" $ + ">\n> foo\n> " + ==-> "
\n

foo

\n
\n" + it "CM242" $ + "> foo\n\n> bar" + ==-> "
\n

foo

\n
\n
\n

bar

\n
\n" + it "CM243" $ + "> foo\n> bar" + ==-> "
\n

foo\nbar

\n
\n" + it "CM244" $ + "> foo\n>\n> bar" + ==-> "
\n

foo

\n

bar

\n
\n" + it "CM245" $ + "foo\n> bar" + ==-> "

foo

\n
\n

bar

\n
\n" + it "CM246" $ + "> aaa\n***\n> bbb" + ==-> "
\n

aaa

\n
\n
\n
\n

bbb

\n
\n" + it "CM247" $ + "> bar\nbaz" + ==-> "
\n

bar\nbaz

\n
\n" + it "CM248" $ + "> bar\n\nbaz" + ==-> "
\n

bar

\n
\n

baz

\n" + it "CM249" $ + "> bar\n>\nbaz" + ==-> "
\n

bar

\n
\n

baz

\n" + it "CM250" $ + "> > > foo\nbar" + ==-> "
\n
\n
\n

foo\nbar

\n
\n
\n
\n" + it "CM251" $ + ">>> foo\n> bar\n>>baz" + ==-> "
\n
\n
\n

foo\nbar\nbaz

\n
\n
\n
\n" + it "CM252" $ + "> code\n\n> not code" + ==-> "
\n
code\n
\n
\n
\n

not code

\n
\n" + context "5.2 List items" $ do + it "CM253" $ + "A paragraph\nwith two lines.\n\n indented code\n\n> A block quote." + ==-> "

A paragraph\nwith two lines.

\n
indented code\n
\n
\n

A block quote.

\n
\n" + it "CM254" $ + "1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." + ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" + it "CM255" $ + "- one\n\n two" + ==-> "
    \n
  • \none\n
    • \n
\n

two

\n" + it "CM256" $ + "- one\n\n two" + ==-> "
    \n
  • \n

    one

    \n

    two

    \n
    • \n
\n" + it "CM257" $ + " - one\n\n two" + ==-> "
    \n
  • \none\n
    • \n
\n
 two\n
\n" + it "CM258" $ + " - one\n\n two" + ==-> "
    \n
  • \n

    one

    \n

    two

    \n
    • \n
\n" + it "CM259" $ + " > > 1. one\n>>\n>> two" + ==-> "
\n
\n
    \n
  1. \n

    one

    \n

    two

    \n
    2. \n
\n
\n
\n" + it "CM260" $ + ">>- one\n>>\n > > two" + ==-> "
\n
\n
    \n
  • \none\n
    • \n
\n

two

\n
\n
\n" + it "CM261" $ + "-one\n\n2.two" + ==-> "

-one

\n

2.two

\n" + it "CM262" $ + "- foo\n\n\n bar" + ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" + it "CM263" $ + "1. foo\n\n ```\n bar\n ```\n\n baz\n\n > bam" + ==-> "
    \n
  1. \n

    foo

    \n
    bar\n
    \n

    baz

    \n
    \n

    bam

    \n
    \n
    2. \n
\n" + it "CM264" $ + "- Foo\n\n bar\n\n\n baz" + ==-> "
    \n
  • \n

    Foo

    \n
    bar\n\n\nbaz\n
    \n
    • \n
\n" + it "CM265" $ + "123456789. ok" + ==-> "
    \n
  1. \nok\n
    2. \n
\n" + it "CM266" $ + let s = "1234567890. not ok\n" + in s ~-> errFancy 0 (indexTooBig 1234567890) + it "CM267" $ + "0. ok" + ==-> "
    \n
  1. \nok\n
    2. \n
\n" + it "CM268" $ + "003. ok" + ==-> "
    \n
  1. \nok\n
    2. \n
\n" + it "CM269" $ + "-1. not ok" + ==-> "

-1. not ok

\n" + it "CM270" $ + "- foo\n\n bar" + ==-> "
    \n
  • \n

    foo

    \n
    bar\n
    \n
    • \n
\n" + it "CM271" $ + " 10. foo\n\n bar" + ==-> "
    \n
  1. \n

    foo

    \n
    bar\n
    \n
    2. \n
\n" + it "CM272" $ + " indented code\n\nparagraph\n\n more code" + ==-> "
indented code\n
\n

paragraph

\n
more code\n
\n" + it "CM273" $ + "1. indented code\n\n paragraph\n\n more code" + ==-> "
    \n
  1. \n
    indented code\n
    \n

    paragraph

    \n
    more code\n
    \n
    2. \n
\n" + it "CM274" $ + "1. indented code\n\n paragraph\n\n more code" + ==-> "
    \n
  1. \n
     indented code\n
    \n

    paragraph

    \n
    more code\n
    \n
    2. \n
\n" + it "CM275" $ + " foo\n\nbar" + ==-> "

foo

\n

bar

\n" + it "CM276" $ + "- foo\n\n bar" + ==-> "
    \n
  • \nfoo\n
    • \n
\n

bar

\n" + it "CM277" $ + "- foo\n\n bar" + ==-> "
    \n
  • \n

    foo

    \n

    bar

    \n
    • \n
\n" + it "CM278" $ + "-\n foo\n-\n ```\n bar\n ```\n-\n baz" + ==-> "
    \n
  • \n

    foo

    \n
    • \n
  • \n
    bar\n
    \n
    • \n
  • \n
    baz\n
    \n
    • \n
\n" + it "CM279" $ + "- \n foo" + ==-> "
    \n
  • \nfoo\n
    • \n
\n" + it "CM280a" $ + "-\n\n foo" + ==-> "
    \n
  • \n\n
    • \n
\n

foo

\n" + it "CM280b" $ + "1.\n\n foo" + ==-> "
    \n
  1. \n\n
    2. \n
\n

foo

\n" + it "CM281" $ + "- foo\n-\n- bar" + ==-> "
    \n
  • \nfoo\n
    • \n
  • \n\n
    • \n
  • \nbar\n
    • \n
\n" + it "CM282" $ + "- foo\n- \n- bar" + ==-> "
    \n
  • \nfoo\n
    • \n
  • \n\n
    • \n
  • \nbar\n
    • \n
\n" + it "CM283" $ + "1. foo\n2.\n3. bar" + ==-> "
    \n
  1. \nfoo\n
    2. \n
  2. \n\n
    3. \n
  3. \nbar\n
    4. \n
\n" + it "CM284" $ + "*" + ==-> "
    \n
  • \n\n
    • \n
\n" + it "CM285" $ + "foo\n*\n\nfoo\n1." + ==-> "

foo

\n
    \n
  • \n\n
    • \n
\n

foo

\n
    \n
  1. \n\n
    2. \n
\n" + it "CM286" $ + " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." + ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" + it "CM287" $ + " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." + ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" + it "CM288" $ + " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." + ==-> "
    \n
  1. \n

    A paragraph\nwith two lines.

    \n
    indented code\n
    \n
    \n

    A block quote.

    \n
    \n
    2. \n
\n" + it "CM289" $ + " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." + ==-> "
1.  A paragraph\n    with two lines.\n\n        indented code\n\n    > A block quote.\n
\n" + it "CM290" $ + " 1. A paragraph\nwith two lines.\n\n indented code\n\n > A block quote." + ==-> "
    \n
  1. \nA paragraph\n
    2. \n
\n

with two lines.

\n
      indented code\n\n  > A block quote.\n
\n" + it "CM291" $ + " 1. A paragraph\n with two lines." + ==-> "
    \n
  1. \nA paragraph\n
    2. \n
\n
with two lines.\n
\n" + it "CM292" $ + "> 1. > Blockquote\ncontinued here." + ==-> "
\n
    \n
  1. \n
    \n

    Blockquote\ncontinued here.

    \n
    \n
    2. \n
\n
\n" + it "CM293" $ + "> 1. > Blockquote\n> continued here." + ==-> "
\n
    \n
  1. \n
    \n

    Blockquote\ncontinued here.

    \n
    \n
    2. \n
\n
\n" + it "CM294" $ + "- foo\n - bar\n - baz\n - boo" + ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \nbaz\n
          \n
        • \nboo\n
          • \n
        \n
        • \n
      \n
      • \n
    \n
    • \n
\n" + it "CM295" $ + "- foo\n - bar\n - baz\n - boo" + ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
  • \nbaz\n
    • \n
  • \nboo\n
    • \n
\n" + it "CM296" $ + "10) foo\n - bar" + ==-> "
    \n
  1. \nfoo\n
      \n
    • \nbar\n
      • \n
    \n
    2. \n
\n" + it "CM297" $ + "10) foo\n - bar" + ==-> "
    \n
  1. \nfoo\n
    2. \n
\n
    \n
  • \nbar\n
    • \n
\n" + it "CM298" $ + "- - foo" + ==-> "
    \n
  • \n
      \n
    • \nfoo\n
      • \n
    \n
    • \n
\n" + it "CM299" $ + "1. - 2. foo" + ==-> "
    \n
  1. \n
      \n
    • \n
        \n
      1. \nfoo\n
        2. \n
      \n
      • \n
    \n
    2. \n
\n" + it "CM300" $ + "- # Foo\n- Bar\n ---\n baz" + ==-> "
    \n
  • \n

    Foo

    \n
    • \n
  • \n

    Bar

    \n
    \n

    baz

    \n
    • \n
\n" + context "5.3 Lists" $ do + it "CM301" $ + "- foo\n- bar\n+ baz" + ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
\n
    \n
  • \nbaz\n
    • \n
\n" + it "CM302" $ + "1. foo\n2. bar\n3) baz" + ==-> "
    \n
  1. \nfoo\n
    2. \n
  2. \nbar\n
    3. \n
\n
    \n
  1. \nbaz\n
    2. \n
\n" + it "CM303" $ + "Foo\n- bar\n- baz" + ==-> "

Foo

\n
    \n
  • \nbar\n
    • \n
  • \nbaz\n
    • \n
\n" + it "CM304" $ + "The number of windows in my house is\n14. The number of doors is 6." + ==-> "

The number of windows in my house is

\n
    \n
  1. \nThe number of doors is 6.\n
    2. \n
\n" + it "CM305" $ + "The number of windows in my house is\n1. The number of doors is 6." + ==-> "

The number of windows in my house is

\n
    \n
  1. \nThe number of doors is 6.\n
    2. \n
\n" + it "CM306" $ + "- foo\n\n- bar\n\n\n- baz" + ==-> "
    \n
  • \n

    foo

    \n
    • \n
  • \n

    bar

    \n
    • \n
  • \n

    baz

    \n
    • \n
\n" + it "CM307" $ + "- foo\n - bar\n - baz\n\n\n bim" + ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
        \n
      • \n

        baz

        \n

        bim

        \n
        • \n
      \n
      • \n
    \n
    • \n
\n" + it "CM308" $ + "- foo\n- bar\n\n\n\n- baz\n- bim" + ==-> "
    \n
  • \nfoo\n
    • \n
  • \nbar\n
    • \n
\n

<!-- -->

\n
    \n
  • \nbaz\n
    • \n
  • \nbim\n
    • \n
\n" + it "CM309" $ + "- foo\n\n notcode\n\n- foo\n\n\n\n code" + ==-> "
    \n
  • \n

    foo

    \n

    notcode

    \n
    • \n
  • \n

    foo

    \n
    • \n
\n

<!-- -->

\n
code\n
\n" + it "CM310" $ + "- a\n - b\n - c\n - d\n - e\n - f\n- g" + ==-> "
    \n
  • \na\n
    • \n
  • \nb\n
    • \n
  • \nc\n
    • \n
  • \nd\n
    • \n
  • \ne\n
    • \n
  • \nf\n
    • \n
  • \ng\n
    • \n
\n" + it "CM311" $ + "1. a\n\n 2. b\n\n 3. c\n" + ==-> "
    \n
  1. \n

    a

    \n
    2. \n
  2. \n

    b

    \n
    3. \n
  3. \n

    c

    \n
    4. \n
\n" + it "CM312" $ + "- a\n - b\n - c\n - d\n - e\n" + ==-> "
    \n
  • \na\n
    • \n
  • \nb\n
    • \n
  • \nc\n
    • \n
  • \nd\n
    • \n
  • \ne\n
    • \n
\n" + it "CM313" $ + "1. a\n\n 2. b\n\n 3. c" + ==-> "
    \n
  1. \n

    a

    \n
    2. \n
  2. \n

    b

    \n
    3. \n
  3. \n

    c

    \n
    4. \n
\n" + it "CM314" $ + "- a\n- b\n\n- c" + ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n
    • \n
  • \n

    c

    \n
    • \n
\n" + it "CM315" $ + "* a\n*\n\n* c" + ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    \n
    • \n
  • \n

    c

    \n
    • \n
\n" + it "CM316" $ + "- a\n- b\n\n c\n- d" + ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n

    c

    \n
    • \n
  • \n

    d

    \n
    • \n
\n" + it "CM317" $ + "- a\n- b\n\n [ref]: /url\n- d" + ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n

    b

    \n
    • \n
  • \n

    d

    \n
    • \n
\n" + it "CM318" $ + "- a\n- ```\n b\n\n\n ```\n- c" + ==-> "
    \n
  • \n

    a

    \n
    • \n
  • \n
    b\n\n\n
    \n
    • \n
  • \n

    c

    \n
    • \n
\n" + it "CM319" $ + "- a\n - b\n\n c\n- d" + ==-> "
    \n
  • \na\n
      \n
    • \n

      b

      \n

      c

      \n
      • \n
    \n
    • \n
  • \nd\n
    • \n
\n" + it "CM320" $ + "* a\n > b\n >\n* c" + ==-> "
    \n
  • \n

    a

    \n
    \n

    b

    \n
    \n
    • \n
  • \n

    c

    \n
    • \n
\n" + it "CM321" $ + "- a\n > b\n ```\n c\n ```\n- d" + ==-> "
    \n
  • \n

    a

    \n
    \n

    b

    \n
    \n
    c\n
    \n
    • \n
  • \n

    d

    \n
    • \n
\n" + it "CM322" $ + "- a" + ==-> "
    \n
  • \na\n
    • \n
\n" + it "CM323" $ + "- a\n - b" + ==-> "
    \n
  • \na\n
      \n
    • \nb\n
      • \n
    \n
    • \n
\n" + it "CM324" $ + "1. ```\n foo\n ```\n\n bar" + ==-> "
    \n
  1. \n
    foo\n
    \n

    bar

    \n
    2. \n
\n" + it "CM325" $ + "* foo\n * bar\n\n baz" + ==-> "
    \n
  • \nfoo\n
      \n
    • \nbar\n
      • \n
    \nbaz\n
    • \n
\n" + it "CM326" $ + "- a\n - b\n - c\n\n- d\n - e\n - f" + ==-> "
    \n
  • \na\n
      \n
    • \nb\n
      • \n
    • \nc\n
      • \n
    \n
    • \n
  • \nd\n
      \n
    • \ne\n
      • \n
    • \nf\n
      • \n
    \n
    • \n
\n" + context "6 Inlines" + $ it "CM327" + $ let s = "`hi`lo`\n" + in s ~-> err 7 (ueib <> etok '`' <> ecsc) + context "6.1 Code spans" $ do + it "CM328" $ + "`foo`" ==-> "

foo

\n" + it "CM329" $ + "`` foo ` bar ``" + ==-> "

foo ` bar

\n" + it "CM330" $ + "` `` `" ==-> "

``

\n" + it "CM331" $ + "` `` `\n" ==-> "

``

\n" + it "CM332" $ + "` a`\n" ==-> "

a

\n" + it "CM333" $ + "` b `" ==-> "

 b 

\n" + it "CM334" $ + "`\160`\n` `\n" ==-> "

\160\n

\n" + it "CM335" $ + "``\nfoo\nbar \nbaz\n``\n" ==-> "

foo bar baz

\n" + it "CM336" $ + "``\nfoo \n``" ==-> "

foo

\n" + it "CM337" $ + "`foo bar \nbaz`" ==-> "

foo bar baz

\n" + it "CM338" $ + let s = "`foo\\`bar`\n" + in s ~-> err 10 (ueib <> etok '`' <> ecsc) + it "CM339" $ + "``foo`bar``\n" ==-> "

foo`bar

\n" + it "CM340" $ + "` foo `` bar `" ==-> "

foo `` bar

\n" + it "CM341" $ + let s = "*foo`*`\n" + in s ~-> err 7 (ueib <> etok '*' <> eic) + it "CM342" $ + let s = "[not a `link](/foo`)\n" + in s ~-> err 20 (ueib <> etok ']' <> eic) + it "CM343" $ + let s = "``\n" + in s ~-> err 14 (ueib <> etok '`' <> ecsc) + it "CM344" $ + "`" + ==-> "

<a href="">

\n" + it "CM345" $ + let s = "``\n" + in s ~-> err 24 (ueib <> etok '`' <> ecsc) + it "CM346" $ + "`" + ==-> "

<https://foo.bar.baz>

\n" + it "CM347" $ + let s = "```foo``\n" + in s ~-> err 8 (ueib <> etok '`' <> ecsc) + it "CM348" $ + let s = "`foo\n" + in s ~-> err 4 (ueib <> etok '`' <> ecsc) + it "CM349" $ + let s = "`foo``bar``\n" + in s ~-> err 11 (ueib <> etok '`' <> ecsc) + context "6.2 Emphasis and strong emphasis" $ do + it "CM350" $ + "*foo bar*" ==-> "

foo bar

\n" + it "CM351" $ + let s = "a * foo bar*\n" + in s ~-> errFancy 2 (nonFlanking "*") + it "CM352" $ + let s = "a*\"foo\"*\n" + in s ~-> errFancy 1 (unmatchedClosing "*") + it "CM353" $ + let s = "* a *\n" + in s ~-> errFancy 0 (nonFlanking "*") + -- Symbols count as punctuation, so the closing delimiter run of each + -- of these leans left and opens emphasis instead of closing it, and + -- is then left unclosed. CommonMark renders them literally. + it "CM354" $ do + "*$*alpha.\n" ~-> err 9 (ueib <> etok '*' <> eic) + "*£*bravo.\n" ~-> err 9 (ueib <> etok '*' <> eic) + "*€*charlie.\n" ~-> err 11 (ueib <> etok '*' <> eic) + it "CM355" $ + "foo*bar*\n" ==-> "

foobar

\n" + it "CM356" $ + "5*6*78\n" ==-> "

5678

\n" + it "CM357" $ + "_foo bar_" ==-> "

foo bar

\n" + it "CM358" $ + let s = "_ foo bar_\n" + in s ~-> errFancy 0 (nonFlanking "_") + it "CM359" $ + let s = "a_\"foo\"_\n" + in s ~-> errFancy 1 (unmatchedClosing "_") + it "CM360" $ + let s = "foo_bar_\n" + in s ~-> errFancy 7 (unmatchedClosing "_") + it "CM361" $ + "5_6_78\n" ==-> "

5_6_78

\n" + it "CM362" $ + let s = "пристаням_стремятся_\n" + in s ~-> errFancy 19 (unmatchedClosing "_") + it "CM363" $ + let s = "aa_\"bb\"_cc\n" + in s ~-> errFancy 2 (unmatchedClosing "_") + it "CM364" $ + "foo-_(bar)_\n" ==-> "

foo-(bar)

\n" + it "CM365" $ + let s = "_foo*\n" + in s ~-> err 4 (utok '*' <> etok '_' <> eic) + it "CM366" $ + let s = "*foo bar *\n" + in s ~-> errFancy 9 (nonFlanking "*") + it "CM367" $ + let s = "*foo bar\n*\n" + in s ~-> err 8 (ueib <> etok '*' <> eic) + it "CM368" $ + let s = "*(*foo)\n" + in s ~-> err 7 (ueib <> etok '*' <> eic) + it "CM369" $ + "*(*foo*)*" + ==-> "

(foo)

\n" + it "CM370" $ + "*foo*bar\n" ==-> "

foobar

\n" + it "CM371" $ + let s = "_foo bar _\n" + in s ~-> errFancy 9 (nonFlanking "_") + it "CM372" $ + let s = "_(_foo)" + in s ~-> err 7 (ueib <> etok '_' <> eic) + it "CM373" $ + "_(_foo_)_" + ==-> "

(foo)

\n" + it "CM374" $ + let s = "_foo_bar\n" + in s ~-> err 8 (ueib <> etok '_' <> eic) + it "CM375" $ + let s = "_пристаням_стремятся\n" + in s ~-> err 20 (ueib <> etok '_' <> eic) + it "CM376" $ + "_foo_bar_baz_\n" ==-> "

foo_bar_baz

\n" + it "CM377" $ + "_(bar)_.\n" ==-> "

(bar).

\n" + it "CM378" $ + "**foo bar**\n" ==-> "

foo bar

\n" + it "CM379" $ + let s = "** foo bar**\n" + in s ~-> errFancy 0 (nonFlanking "**") + it "CM380" $ + let s = "a**\"foo\"**\n" + in s ~-> errFancy 1 (unmatchedClosing "**") + it "CM381" $ + "foo**bar**\n" ==-> "

foobar

\n" + it "CM382" $ + "__foo bar__" ==-> "

foo bar

\n" + it "CM383" $ + let s = "__ foo bar__\n" + in s ~-> errFancy 0 (nonFlanking "__") + it "CM384" $ + let s = "__\nfoo bar__\n" + in s ~-> errFancy 0 (nonFlanking "__") + it "CM385" $ + let s = "a__\"foo\"__\n" + in s ~-> errFancy 1 (unmatchedClosing "__") + it "CM386" $ + let s = "foo__bar__\n" + in s ~-> errFancy 8 (unmatchedClosing "__") + it "CM387" $ + "5__6__78\n" ==-> "

5__6__78

\n" + it "CM388" $ + let s = "пристаням__стремятся__\n" + in s ~-> errFancy 20 (unmatchedClosing "__") + it "CM389" $ + "__foo, __bar__, baz__" + ==-> "

foo, bar, baz

\n" + it "CM390" $ + "foo-__(bar)__" ==-> "

foo-(bar)

\n" + it "CM391" $ + let s = "**foo bar **\n" + in s ~-> errFancy 10 (nonFlanking "**") + it "CM392" $ + let s = "**(**foo)\n" + in s ~-> err 9 (ueib <> etoks "**" <> eic) + it "CM393" $ + "*(**foo**)*" + ==-> "

(foo)

\n" + it "CM394" $ + "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**" + ==-> "

Gomphocarpus (Gomphocarpus physocarpus, syn.\nAsclepias physocarpa)

\n" + it "CM395" $ + "**foo \"*bar*\" foo**" + ==-> "

foo "bar" foo

\n" + it "CM396" $ + "**foo**bar\n" ==-> "

foobar

\n" + it "CM397" $ + let s = "__foo bar __\n" + in s ~-> errFancy 10 (nonFlanking "__") + it "CM398" $ + let s = "__(__foo)\n" + in s ~-> err 9 (ueib <> etoks "__" <> eic) + it "CM399" $ + "_(__foo__)_" + ==-> "

(foo)

\n" + it "CM400" $ + let s = "__foo__bar\n" + in s ~-> err 10 (ueib <> etoks "__" <> eic) + it "CM401" $ + let s = "__пристаням__стремятся\n" + in s ~-> err 22 (ueib <> etoks "__" <> eic) + it "CM402" $ + "__foo__bar__baz__" + ==-> "

foo__bar__baz

\n" + it "CM403" $ + "__(bar)__." + ==-> "

(bar).

\n" + it "CM404" $ + "*foo [bar](/url)*" + ==-> "

foo bar

\n" + it "CM405" $ + "*foo\nbar*" + ==-> "

foo\nbar

\n" + it "CM406" $ + "_foo __bar__ baz_" + ==-> "

foo bar baz

\n" + it "CM407" $ + "_foo _bar_ baz_" + ==-> "

foo bar baz

\n" + it "CM408" $ + let s = "__foo_ bar_" + in s ~-> err 5 (utoks "_ " <> etoks "__" <> eic) + it "CM409" $ + "*foo *bar**" + ==-> "

foo bar

\n" + it "CM410" $ + "*foo **bar** baz*" + ==-> "

foo bar baz

\n" + it "CM411" $ + "*foo**bar**baz*\n" + ==-> "

foobarbaz

\n" + it "CM412" $ + let s = "*foo**bar*\n" + in s ~-> err 9 (utok '*' <> etoks "**" <> eic) + it "CM413" $ + "***foo** bar*\n" ==-> "

foo bar

\n" + it "CM414" $ + "*foo **bar***\n" ==-> "

foo bar

\n" + it "CM415" $ + "*foo**bar***\n" ==-> "

foobar

\n" + it "CM416" $ + "foo***bar***baz\n" + ==-> "

foobarbaz

\n" + it "CM417" $ + let s = "foo******bar*********baz\n" + in s ~-> err 24 (ueib <> etoks "**" <> etok '*' <> eic) + it "CM418" $ + "*foo **bar *baz* bim** bop*\n" + ==-> "

foo bar baz bim bop

\n" + it "CM419" $ + "*foo [*bar*](/url)*\n" + ==-> "

foo bar

\n" + it "CM420" $ + let s = "** is not an empty emphasis\n" + in s ~-> errFancy 0 (nonFlanking "**") + it "CM421" $ + let s = "**** is not an empty strong emphasis\n" + in s ~-> errFancy 0 (nonFlanking "****") + it "CM422" $ + "**foo [bar](/url)**" + ==-> "

foo bar

\n" + it "CM423" $ + "**foo\nbar**" + ==-> "

foo\nbar

\n" + it "CM424" $ + "__foo _bar_ baz__" + ==-> "

foo bar baz

\n" + it "CM425" $ + "__foo __bar__ baz__" + ==-> "

foo bar baz

\n" + it "CM426" $ + "____foo__ bar__" + ==-> "

foo bar

\n" + it "CM427" $ + "**foo **bar****" + ==-> "

foo bar

\n" + it "CM428" $ + "**foo *bar* baz**" + ==-> "

foo bar baz

\n" + it "CM429" $ + "**foo*bar*baz**\n" + ==-> "

foobarbaz

\n" + it "CM430" $ + "***foo* bar**" + ==-> "

foo bar

\n" + it "CM431" $ + "**foo *bar***" + ==-> "

foo bar

\n" + it "CM432" $ + "**foo *bar **baz**\nbim* bop**" + ==-> "

foo bar baz\nbim bop

\n" + it "CM433" $ + "**foo [*bar*](/url)**" + ==-> "

foo bar

\n" + it "CM434" $ + let s = "__ is not an empty emphasis\n" + in s ~-> errFancy 0 (nonFlanking "__") + it "CM435" $ + let s = "____ is not an empty strong emphasis\n" + in s ~-> errFancy 0 (nonFlanking "____") + it "CM436" $ + let s = "foo ***\n" + in s ~-> errFancy 4 (nonFlanking "***") + it "CM437" $ + "foo *\\**" ==-> "

foo *

\n" + it "CM438" $ + "foo *\\_*\n" ==-> "

foo _

\n" + it "CM439" $ + let s = "foo *****\n" + in s ~-> errFancy 4 (nonFlanking "*****") + it "CM440" $ + "foo **\\***" ==-> "

foo *

\n" + it "CM441" $ + "foo **\\_**\n" ==-> "

foo _

\n" + it "CM442" $ + let s = "**foo*\n" + in s ~-> err 5 (utok '*' <> etoks "**" <> eic) + it "CM443" $ + let s = "*foo**\n" + in s ~-> errFancy 5 (unmatchedClosing "*") + it "CM444" $ + let s = "***foo**\n" + in s ~-> err 8 (ueib <> etok '*' <> eic) + it "CM445" $ + let s = "****foo*\n" + in s ~-> err 7 (utok '*' <> etoks "**" <> eic) + it "CM446" $ + let s = "**foo***\n" + in s ~-> errFancy 7 (unmatchedClosing "*") + it "CM447" $ + let s = "*foo****\n" + in s ~-> errFancy 5 (unmatchedClosing "***") + it "CM448" $ + let s = "foo ___\n" + in s ~-> errFancy 4 (nonFlanking "___") + it "CM449" $ + "foo _\\__" ==-> "

foo _

\n" + it "CM450" $ + "foo _\\*_" ==-> "

foo *

\n" + it "CM451" $ + let s = "foo _____\n" + in s ~-> errFancy 4 (nonFlanking "_____") + it "CM452" $ + "foo __\\___" ==-> "

foo _

\n" + it "CM453" $ + "foo __\\*__" ==-> "

foo *

\n" + it "CM454" $ + let s = "__foo_\n" + in s ~-> err 5 (utok '_' <> etoks "__" <> eic) + it "CM455" $ + let s = "_foo__\n" + in s ~-> errFancy 5 (unmatchedClosing "_") + it "CM456" $ + let s = "___foo__\n" + in s ~-> err 8 (ueib <> etok '_' <> eic) + it "CM457" $ + let s = "____foo_\n" + in s ~-> err 7 (utok '_' <> etoks "__" <> eic) + it "CM458" $ + let s = "__foo___\n" + in s ~-> errFancy 7 (unmatchedClosing "_") + it "CM459" $ + let s = "_foo____\n" + in s ~-> errFancy 5 (unmatchedClosing "___") + it "CM460" $ + "**foo**" ==-> "

foo

\n" + it "CM461" $ + "*_foo_*" ==-> "

foo

\n" + it "CM462" $ + "__foo__" ==-> "

foo

\n" + it "CM463" $ + "_*foo*_" ==-> "

foo

\n" + it "CM464" $ + "****foo****" ==-> "

foo

\n" + it "CM465" $ + "____foo____" ==-> "

foo

\n" + it "CM466" $ + "******foo******" + ==-> "

foo

\n" + it "CM467" $ + "***foo***" ==-> "

foo

\n" + it "CM468" $ + "_____foo_____" + ==-> "

foo

\n" + it "CM469" $ + let s = "*foo _bar* baz_\n" + in s ~-> err 9 (utok '*' <> etok '_' <> eic) + it "CM470" $ + let s = "*foo __bar *baz bim__ bam*\n" + in s ~-> err 19 (utok '_' <> etok '*' <> eic) + it "CM471" $ + let s = "**foo **bar baz**\n" + in s ~-> err 17 (ueib <> etoks "**" <> eic) + it "CM472" $ + let s = "*foo *bar baz*\n" + in s ~-> err 14 (ueib <> etok '*' <> eic) + it "CM473" $ + let s = "*[bar*](/url)\n" + in s ~-> err 5 (utok '*' <> etok ']' <> eic) + it "CM474" $ + let s = "_foo [bar_](/url)\n" + in s ~-> err 9 (utok '_' <> etok ']' <> eic) + it "CM475" $ + "*\n" + ==-> "

<img src="foo" title=""/>

\n" + it "CM476" $ + "**" + ==-> "

<a href="">

\n" + it "CM477" $ + "__\n" + ==-> "

<a href="">

\n" + it "CM478" $ + "*a `*`*" ==-> "

a *

\n" + it "CM479" $ + "_a `_`_" ==-> "

a _

\n" + it "CM480" $ + let s = "**a" + in s ~-> err 26 (ueib <> etoks "**" <> eic) + it "CM481" $ + let s = "__a" + in s ~-> err 26 (ueib <> etoks "__" <> eic) + context "6.3 Links" $ do + it "CM482" $ + "[link](/uri \"title\")" + ##-> p_ (a_ [href_ "/uri", title_ "title"] "link") + it "CM483" $ + "[link](/uri)" + ==-> "

link

\n" + it "CM484" $ + let s = "[](./target.md)\n" + in s ~-> err 1 (utok ']' <> eic) + it "CM485" $ + let s = "[link]()" + in s + ~-> err + 7 + (utok ')' <> etok '<' <> elabel "URI" <> ews) + it "CM486" $ + "[link](<>)" + ==-> "

link

\n" + it "CM487" $ + let s = "[]()\n" + in s ~-> err 1 (utok ']' <> eic) + it "CM488" $ + let s = "[link](/my uri)\n" + in s + ~-> err + 11 + (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) + it "CM489" $ + let s = "[link]()\n" + in s ~-> err 11 (utok ' ' <> euric <> etok '>') + it "CM490" $ + let s = "[link](foo\nbar)\n" + in s + ~-> err + 11 + (utok 'b' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) + it "CM491" $ + let s = "[link]()\n" + in s ~-> err 11 (utok '\n' <> euric <> etok '>') + it "CM492" $ + "[a]()\n" ==-> "

a

\n" + it "CM493" $ + let s = "[link]()\n" + in s ~-> err 11 (utok '\\' <> etok '>' <> euric) + it "CM494" $ + let s = "[a](\n[a](c)\n" + in s ~-> err 8 (utok '\n' <> etok '>' <> euric) + it "CM495" $ + let s = "[link](\\(foo\\))" + in s + ~-> err + 7 + ( utok '\\' + <> etoks "//" + <> etok '#' + <> etok '/' + <> etok '<' + <> etok '?' + <> elabel "ASCII alpha character" + <> euri + <> elabel "path piece" + <> ews + ) + it "CM496" $ + "[link](foo(and(bar)))\n" + ==-> "

link))

\n" + it "CM497" $ + "[link](foo(and(bar))\n" + ==-> "

link)

\n" + it "CM498" $ + let s = "[link](foo\\(and\\(bar\\))" + in s ~-> err 10 (utok '\\' <> euric <> euri) + it "CM499" $ + "[link]()" + ==-> "

link

\n" + it "CM500" $ + let s = "[link](foo\\)\\:)" + in s ~-> err 10 (utok '\\' <> euric <> euri) + it "CM501" $ + "[link](#fragment)\n\n[link](https://example.com#fragment)\n\n[link](https://example.com?foo=3#frag)\n" + ==-> "

link

\n

link

\n

link

\n" + it "CM502" $ + let s = "[link](foo\\bar)" + in s ~-> err 10 (utok '\\' <> euric <> euri) + it "CM503" $ + "[link](foo%20bä)" + ==-> "

link

\n" + it "CM504" $ + let s = "[link](\"title\")" + in s + ~-> err + 7 + ( utok '"' + <> etoks "//" + <> etok '#' + <> etok '/' + <> etok '<' + <> etok '?' + <> elabel "ASCII alpha character" + <> euri + <> elabel "path piece" + <> ews + ) + it "CM505" $ + "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" + ##-> p_ + ( do + a_ [href_ "/url", title_ "title"] "link" + "\n" + a_ [href_ "/url", title_ "title"] "link" + "\n" + a_ [href_ "/url", title_ "title"] "link" + ) + it "CM506" $ + "[link](/url \"title \\\""\")\n" + ##-> p_ (a_ [href_ "/url", title_ "title \"\""] "link") + it "CM507" $ + let s = "[link](/url \"title\")" + in s ~-> err 11 (utok ' ' <> euric <> euri) + it "CM508" $ + let s = "[link](/url \"title \"and\" title\")\n" + in s ~-> err 20 (utok 'a' <> etok ')' <> ews) + it "CM509" $ + "[link](/url 'title \"and\" title')" + ##-> p_ (a_ [href_ "/url", title_ "title \"and\" title"] "link") + it "CM510" $ + "[link]( /uri\n \"title\" )" + ##-> p_ (a_ [href_ "/uri", title_ "title"] "link") + it "CM511" $ + let s = "[link] (/uri)\n" + in s ~-> errFancy 1 (couldNotMatchRef "link" []) + it "CM512" $ + let s = "[link [foo [bar]]](/uri)\n" + in s ~-> err 6 (utok '[' <> etok ']' <> eic) + it "CM513" $ + let s = "[link] bar](/uri)\n" + in s ~-> errFancy 1 (couldNotMatchRef "link" []) + it "CM514" $ + let s = "[link [bar](/uri)\n" + in s ~-> err 6 (utok '[' <> etok ']' <> eic) + it "CM515" $ + "[link \\[bar](/uri)\n" + ==-> "

link [bar

\n" + it "CM516" $ + "[link *foo **bar** `#`*](/uri)" + ==-> "

link foo bar #

\n" + it "CM517" $ + "[![moon](moon.jpg)](/uri)" + ==-> "

\"moon\"

\n" + it "CM518" $ + let s = "[foo [bar](/uri)](/uri)\n" + in s ~-> err 5 (utok '[' <> etok ']' <> eic) + it "CM519" $ + let s = "[foo *[bar [baz](/uri)](/uri)*](/uri)\n" + in s ~-> err 6 (utok '[' <> eic) + it "CM520" $ + let s = "![[[foo](uri1)](uri2)](uri3)" + in s ~-> err 3 (utok '[' <> eic) + it "CM521" $ + let s = "*[foo*](/uri)\n" + in s ~-> err 5 (utok '*' <> etok ']' <> eic) + it "CM522" $ + let s = "[foo *bar](baz*)\n" + in s ~-> err 9 (utok ']' <> etok '*' <> eic) + it "CM523" $ + let s = "*foo [bar* baz]\n" + in s ~-> err 9 (utok '*' <> etok ']' <> eic) + it "CM524" $ + "[foo " + ==-> "

foo <bar attr="">

\n" + it "CM525" $ + let s = "[foo`](/uri)`\n" + in s ~-> err 13 (ueib <> etok ']' <> eic) + it "CM526" $ + "[foo" + ==-> "

foo<https://example.com/?search=>

\n" + it "CM527" $ + "[foo][bar]\n\n[bar]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") + it "CM528" $ + let s = "[link [foo [bar]]][ref]\n\n[ref]: /uri" + in s ~-> err 6 (utok '[' <> etok ']' <> eic) + it "CM529" $ + "[link \\[bar][ref]\n\n[ref]: /uri" + ==-> "

link [bar

\n" + it "CM530" $ + "[link *foo **bar** `#`*][ref]\n\n[ref]: /uri" + ==-> "

link foo bar #

\n" + it "CM531" $ + "[![moon](moon.jpg)][ref]\n\n[ref]: /uri" + ==-> "

\"moon\"

\n" + it "CM532" $ + let s = "[foo [bar](/uri)][ref]\n\n[ref]: /uri" + in s ~-> err 5 (utok '[' <> etok ']' <> eic) + it "CM533" $ + let s = "[foo *bar [baz][ref]*][ref]\n\n[ref]: /uri" + in s ~-> err 10 (utok '[' <> etok '*' <> eic) + it "CM534" $ + let s = "*[foo*][ref]\n\n[ref]: /uri" + in s ~-> err 5 (utok '*' <> etok ']' <> eic) + it "CM535" $ + let s = "[foo *bar][ref]*\n\n[ref]: /uri" + in s ~-> err 9 (utok ']' <> etok '*' <> eic) + it "CM536" $ + "[foo \n\n[ref]: /uri" + ==-> "

foo <bar attr="">

\n" + it "CM537" $ + let s = "[foo`][ref]`\n\n[ref]: /uri" + in s ~-> err 12 (ueib <> etok ']' <> eic) + it "CM538" $ + "[foo\n\n[ref]: /uri" + ==-> "

foo<https://example.com/?search=>

\n" + it "CM539" $ + "[foo][BaR]\n\n[bar]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") + -- Dropped in CommonMark 0.31.2, but reference labels are still + -- matched case-insensitively, including outside of ASCII. + it "matches non-ASCII reference labels case-insensitively" $ + "[Толпой][Толпой] is a Russian word.\n\n[ТОЛПОЙ]: /url" + ==-> "

Толпой is a Russian word.

\n" + it "CM540" $ + "[\7838]\n\n[SS]: /url\n" ==-> "

\7838

\n" + it "CM541" $ + "[Foo\n bar]: /url\n\n[Baz][Foo bar]" + ==-> "

Baz

\n" + it "CM542" $ + let s = "[foo] [bar]\n\n[bar]: /url \"title\"" + in s ~-> errFancy 1 (couldNotMatchRef "foo" []) + it "CM543" $ + let s = "[foo]\n[bar]\n\n[bar]: /url \"title\"" + in s ~-> errFancy 1 (couldNotMatchRef "foo" []) + it "CM544" $ + let s = "[foo]: /url1\n\n[foo]: /url2\n\n[bar][foo]" + in s ~-> errFancy 15 (duplicateRef "foo") + it "CM545" $ + "[bar][foo\\!]\n\n[foo!]: /url" + ==-> "

bar

\n" + it "CM546" $ + let s = "[foo][ref[]\n\n[ref[]: /uri" + in s + ~~-> [ err + 9 + ( utok '[' + <> etoks "&#" + <> etok '&' + <> etok ']' + <> elabel "escaped character" + ), + err 17 (utok '[' <> etok ']' <> eic) + ] + it "CM547" $ + let s = "[foo][ref[bar]]\n\n[ref[bar]]: /uri" + in s + ~~-> [ err + 9 + ( utok '[' + <> etoks "&#" + <> etok '&' + <> etok ']' + <> elabel "escaped character" + ), + err 21 (utok '[' <> etok ']' <> eic) + ] + it "CM548" $ + let s = "[[[foo]]]\n\n[[[foo]]]: /url" + in s + ~~-> [ err 1 (utok '[' <> eic), + err 12 (utok '[' <> eic) + ] + it "CM549" $ + "[foo][ref\\[]\n\n[ref\\[]: /uri" + ==-> "

foo

\n" + it "CM550" $ + "[bar\\\\]: /uri\n\n[bar\\\\]" + ==-> "

bar\\

\n" + it "CM551" $ + let s = "[]\n\n[]: /uri" + in s + ~~-> [ err 1 (utok ']' <> eic), + err 5 (utok ']' <> eic) + ] + it "CM552" $ + let s = "[\n ]\n\n[\n ]: /uri" + in s + ~~-> [ errFancy 1 (couldNotMatchRef "" []), + errFancy 7 (couldNotMatchRef "" []) + ] + it "CM553" $ + "[foo][]\n\n[foo]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") + it "CM554" $ + let s = "[*foo* bar][]\n\n[*foo* bar]: /url \"title\"" + in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) + it "CM555" $ + "[Foo][]\n\n[foo]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "Foo") + it "CM556" $ + let s = "[foo] \n[]\n\n[foo]: /url \"title\"" + in s ~-> err 8 (utok ']' <> eic) + it "CM557" $ + "[foo]\n\n[foo]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") + it "CM558" $ + let s = "[*foo* bar]\n\n[*foo* bar]: /url \"title\"" + in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) + it "CM559" $ + let s = "[[*foo* bar]]\n\n[*foo* bar]: /url \"title\"" + in s ~-> err 1 (utok '[' <> eic) + it "CM560" $ + let s = "[[bar [foo]\n\n[foo]: /url" + in s ~-> err 1 (utok '[' <> eic) + it "CM561" $ + "[Foo]\n\n[foo]: /url \"title\"" + ##-> p_ (a_ [href_ "/url", title_ "title"] "Foo") + it "CM562" $ + "[foo] bar\n\n[foo]: /url" + ==-> "

foo bar

\n" + it "CM563" $ + let s = "\\[foo]\n\n[foo]: /url \"title\"" + in s ~-> err 5 (utok ']' <> eeib <> eic) + it "CM564" $ + let s = "[foo*]: /url\n\n*[foo*]" + in s ~-> err 19 (utok '*' <> etok ']' <> eic) + it "CM565" $ + "[foo][bar]\n\n[foo]: /url1\n[bar]: /url2" + ==-> "

foo

\n" + it "CM566" $ + "[foo][]\n\n[foo]: /url1" + ==-> "

foo

\n" + it "CM567" $ + let s = "[foo]()\n\n[foo]: /url1" + in s ~-> err 6 (utok ')' <> etok '<' <> elabel "URI" <> ews) + it "CM568" $ + let s = "[foo](not a link)\n\n[foo]: /url1" + in s + ~-> err + 10 + (utok 'a' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) + it "CM569" $ + let s = "[foo][bar][baz]\n\n[baz]: /url" + in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) + it "CM570" $ + "[foo][bar][baz]\n\n[baz]: /url1\n[bar]: /url2" + ==-> "

foobaz

\n" + it "CM571" $ + let s = "[foo][bar][baz]\n\n[baz]: /url1\n[foo]: /url2" + in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) + context "6.4 Images" $ do + it "CM572" $ + "![foo](/url \"title\")" + ==-> "

\"foo\"

\n" + it "CM573" $ + "![foo *bar*](train.jpg \"train & tracks\")" + ==-> "

\"foo

\n" + it "CM574" $ + let s = "![foo ![bar](/url)](/url2)\n" + in s ~-> err 6 (utok '!' <> etok ']' <> eic) + it "CM575" $ + "![foo [bar](/url)](/url2)" + ==-> "

\"foo

\n" + it "CM576" $ + let s = "![foo *bar*][]\n\n[foo *bar*]: train.jpg \"train & tracks\"\n" + in s ~-> errFancy 2 (couldNotMatchRef "foo bar" ["foo *bar*"]) + it "CM577" $ + "![foo *bar*][foobar]\n\n[FOOBAR]: train.jpg \"train & tracks\"" + ==-> "

\"foo

\n" + it "CM578" $ + "![foo](train.jpg)" + ==-> "

\"foo\"

\n" + it "CM579" $ + "My ![foo bar](/path/to/train.jpg \"title\" )" + ==-> "

My \"foo

\n" + it "CM580" $ + "![foo]()" + ==-> "

\"foo\"

\n" + it "CM581" $ + "![](/url)" ==-> "

\n" + it "CM582" $ + "![foo][bar]\n\n[bar]: /url" + ==-> "

\"foo\"

\n" + it "CM583" $ + "![foo][bar]\n\n[BAR]: /url" + ==-> "

\"foo\"

\n" + it "CM584" $ + "![foo][]\n\n[foo]: /url \"title\"" + ==-> "

\"foo\"

\n" + it "CM585" $ + "![foo bar][]\n\n[foo bar]: /url \"title\"" + ==-> "

\"foo

\n" + it "CM586" $ + "![Foo][]\n\n[foo]: /url \"title\"" + ==-> "

\"Foo\"

\n" + it "CM587" $ + let s = "![foo] \n[]\n\n[foo]: /url \"title\"" + in s ~-> err 9 (utok ']' <> eic) + it "CM588" $ + "![foo]\n\n[foo]: /url \"title\"" + ==-> "

\"foo\"

\n" + it "CM589" $ + "![*foo* bar]\n\n[foo bar]: /url \"title\"\n" + ==-> "

\"foo

\n" + it "CM590" $ + let s = "![[foo]]\n\n[[foo]]: /url \"title\"" + in s + ~~-> [ errFancy 3 (couldNotMatchRef "foo" []), + err 11 (utok '[' <> eic) + ] + it "CM591" $ + "![Foo]\n\n[foo]: /url \"title\"" + ==-> "

\"Foo\"

\n" + it "CM592" $ + "!\\[foo\\]\n\n[foo]: /url \"title\"" + ==-> "

![foo]

\n" + it "CM593" $ + "\\![foo]\n\n[foo]: /url \"title\"" + ##-> p_ + ( do + "!" + a_ [href_ "/url", title_ "title"] "foo" + ) + context "6.5 Autolinks" $ do + it "CM594" $ + "" + ==-> "

http://foo.bar.baz

\n" + it "CM595" $ + "" + ==-> "

https://foo.bar.baz/test?q=hello&id=22&boolean

\n" + it "CM596" $ + "" + ==-> "

irc://foo.bar:2233/baz

\n" + it "CM597" $ + "" + ==-> "

FOO@BAR.BAZ

\n" + it "CM598" $ + "" + ==-> "

a+b+c:d

\n" + it "CM599" $ + "" + ==-> "

made-up-scheme://foo/%2cbar

\n" + it "CM600" $ + "" + ==-> "

https://..

\n" + it "CM601" $ + "" + ==-> "

localhost:5001/foo

\n" + it "CM602" $ + "\n" + ==-> "

<https://foo.bar/baz bim>

\n" + it "CM603" $ + "" + ==-> "

<https://example.com/[>

\n" + it "CM604" $ + "" + ==-> "

foo@bar.example.com

\n" + it "CM605" $ + "" + ==-> "

foo+special@Bar.baz-bar0.com

\n" + it "CM606" $ + "" + ==-> "

<foo+@bar.example.com>

\n" + it "CM607" $ + "<>" + ==-> "

<>

\n" + it "CM608" $ + "< https://foo.bar >" + ==-> "

< https://foo.bar >

\n" + it "CM609" $ + "" + ==-> "

m:abc

\n" + it "CM610" $ + "" + ==-> "

foo.bar.baz

\n" + it "CM611" $ + "https://example.com" + ==-> "

https://example.com

\n" + it "CM612" $ + "foo@bar.example.com" + ==-> "

foo@bar.example.com

\n" + context "6.6 Raw HTML" $ + -- NOTE We do not support raw HTML, see the readme. + return () + context "6.7 Hard line breaks" $ do + -- NOTE We currently do not support hard line breaks represented in + -- markup as two spaces before newline. + it "CM633" $ + "foo \nbaz" + ==-> "

foo\nbaz

\n" + it "CM634" $ + "foo\\\nbaz\n" + ==-> "

foo
\nbaz

\n" + it "CM635" $ + "foo \nbaz" + ==-> "

foo\nbaz

\n" + it "CM636" $ + "foo \n bar" + ==-> "

foo\nbar

\n" + it "CM637" $ + "foo\\\n bar" + ==-> "

foo
\nbar

\n" + it "CM638" $ + "*foo \nbar*" + ==-> "

foo\nbar

\n" + it "CM639" $ + "*foo\\\nbar*" + ==-> "

foo
\nbar

\n" + it "CM640" $ + "`code \nspan`" + ==-> "

code span

\n" + it "CM641" $ + "`code\\\nspan`" + ==-> "

code\\ span

\n" + it "CM642" $ + "" + ==-> "

<a href="foo\nbar">

\n" + it "CM643" $ + "" + ==-> "

<a href="foo
\nbar">

\n" + it "CM644" $ + "foo\\" + ==-> "

foo\\

\n" + it "CM645" $ + "foo " + ==-> "

foo

\n" + it "CM646" $ + "### foo\\" + ==-> "

foo\\

\n" + it "CM647" $ + "### foo " + ==-> "

foo

\n" + context "6.8 Soft line breaks" $ do + it "CM648" $ + "foo\nbaz" + ==-> "

foo\nbaz

\n" + it "CM649" $ + "foo \n baz" + ==-> "

foo\nbaz

\n" + context "6.9 Textual content" $ do + it "CM650" $ + "hello $.;'there" + ==-> "

hello $.;'there

\n" + it "CM651" $ + "Foo χρῆν" + ==-> "

Foo χρῆν

\n" + it "CM652" $ + "Multiple spaces" + ==-> "

Multiple spaces

\n" + context "strikeout" $ do + it "works in simplest form" $ + "It's ~~bad~~ news." + ==-> "

It's bad news.

\n" + it "combines with emphasis" $ + "**It's ~~bad~~** news." + ==-> "

It's bad news.

\n" + it "interacts with subscript reasonably (1)" $ + "It's ~~~bad~~ news~." + ==-> "

It's bad news.

\n" + it "interacts with subscript reasonably (2)" $ + "It's ~~~bad~ news~~." + ==-> "

It's bad news.

\n" + it "nests a subscript the way strong emphasis nests emphasis" $ do + "~~foo~bar~baz~~" + ==-> "

foobarbaz

\n" + "**foo*bar*baz**" + ==-> "

foobarbaz

\n" + it "does not lend a subscript one of its closing tildes" $ do + "~~foo~bar~~" ~-> err 10 (utok '~' <> etoks "~~" <> eic) + "**foo*bar**" ~-> err 10 (utok '*' <> etoks "**" <> eic) + context "subscript" $ do + it "works in simplest form" $ + "It's ~bad~ news." + ==-> "

It's bad news.

\n" + it "combines with emphasis" $ + "**It's ~bad~** news." + ==-> "

It's bad news.

\n" + it "works inside a word" $ + "H~2~O is not O~2~." ==-> "

H2O is not O2.

\n" + context "superscript" $ do + it "works in simplest form" $ + "It's ^bad^ news." + ==-> "

It's bad news.

\n" + it "combines with emphasis" $ + "**It's ^bad^** news." + ==-> "

It's bad news.

\n" + it "works inside a word" $ + "x^2^ + y^2^ = z^2^" + ==-> "

x2 + y2 = z2

\n" + context "delimiter runs inside words" $ do + it "an underscore inside a word is literal" $ + "snake_case and __dunder__ and to_string()" + ==-> "

snake_case and dunder and to_string()

\n" + it "an underscore inside a word does not close a frame" $ + "*a_b_c*" ==-> "

a_b_c

\n" + it "an asterisk inside a word opens and closes a frame" $ + "un*frigging*believable" + ==-> "

unfriggingbelievable

\n" + it "an ambiguous run closes the frame it is inside of" $ + "**foo**bar" ==-> "

foobar

\n" + it "an ambiguous run that closes nothing opens a frame" $ + "*foo**bar**baz*" + ==-> "

foobarbaz

\n" + it "a run that closes nothing at all is an error" $ + let s = "foo*bar\n" + in s ~-> err 7 (ueib <> etok '*' <> eic) + it "a closing run without an opening one is an error" $ + let s = "foo and bar*\n" + in s ~-> errFancy 11 (unmatchedClosing "*") + it "a composite, complex example" $ + "***Something ~~~is not~~ going~ ^so well^** today*." + ==-> "

Something is not going so well today.

\n" + context "code spans (special cases)" $ do + it "preserves white space verbatim" $ do + "`col1 col2`" ==-> "

col1 col2

\n" + "`a\tb`" ==-> "

a\tb

\n" + "` `" ==-> "

\n" + it "strips one space from each end only when both are there" $ do + "` both `" ==-> "

both

\n" + "` a`" ==-> "

a

\n" + "`a `" ==-> "

a

\n" + -- The indentation of a continuation line belongs to the block that + -- contains the paragraph, not to the code span, so it goes away with + -- the line ending that precedes it. + it "drops the indentation of a continuation line" $ do + "`foo\nbar`" ==-> "

foo bar

\n" + "`foo\n bar`" ==-> "

foo bar

\n" + it "drops the block quote markers of a continuation line" $ do + "> `foo\n> bar`" + ==-> "
\n

foo bar

\n
\n" + "> `foo\n> bar`" + ==-> "
\n

foo bar

\n
\n" + it "keeps white space inside a block quote" $ + "> `a b`" + ==-> "
\n

a b

\n
\n" + context "collapsed reference links (special cases)" + $ it "offsets after such links are still correct" + $ "[foo][] *foo\n\n[foo]: https://example.org" + ~-> err + 12 + (ueib <> etok '*' <> eic) + context "title parse errors" + $ it "parse error is OK in reference definitions" + $ let s = "[something]: something something" + in s + ~-> err + 23 + ( utoks "so" + <> etok '\'' + <> etok '\"' + <> etok '(' + <> elabel "white space" + <> elabel "newline" + ) + context "tables" $ do + it "recognizes single column tables" $ do + let o = "\n\n\n\n\n\n\n
Foo
foo
\n" + "|Foo\n---\nfoo" ==-> o + "Foo|\n---\nfoo" ==-> o + "| Foo |\n --- \n foo " ==-> o + "| Foo |\n| --- |\n| foo |" ==-> o + it "reports correct parse errors when parsing the header line" $ + ( let s = "Foo | Bar\na-- | ---" + in s ~-> err 10 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space") + ) + >> ( let s = "Foo | Bar\n-a- | ---" + in s ~-> err 11 (utok 'a' <> etok '-') + ) + >> ( let s = "Foo | Bar\n--a | ---" + in s ~-> err 12 (utok 'a' <> etok '-') + ) + >> ( let s = "Foo | Bar\n---a | ---" + in s ~-> err 13 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space") + ) + it "falls back to paragraph when header line is weird enough" $ + "Foo | Bar\nab- | ---" + ==-> "

Foo | Bar\nab- | ---

\n" + it "demands that number of columns in rows match number of columns in header" $ + ( let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar" + in s ~-> err 41 (ulabel "end of table block" <> etok '|' <> eic) + ) + >> ( let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar\n\nHere it goes." + in s ~-> err 41 (utok '\n' <> etok '|' <> eic) + ) + it "recognizes escaped pipes" $ + "Foo \\| | Bar\n--- | ---\nfoo | \\|" + ==-> "\n\n\n\n\n\n\n
Foo |Bar
foo|
\n" + it "escaped characters preserve backslashes for inline-level parser" $ + "Foo | Bar\n--- | ---\n\\*foo\\* | bar" + ==-> "\n\n\n\n\n\n\n
FooBar
*foo*bar
\n" + it "escaped pipes do not fool position tracking" $ + let s = "Foo | Bar\n--- | ---\n\\| *fo | bar" + in s ~-> err 26 (ueib <> etok '*' <> elabel "inline content") + it "pipes in code spans in headers do not fool the parser" $ + "`|Foo|` | `|Bar|`\n--- | ---\nfoo | bar" + ==-> "\n\n\n\n\n\n\n
|Foo||Bar|
foobar
\n" + it "pipes in code spans in cells do not fool the parser" $ + "Foo | Bar\n--- | ---\n`|foo|` | `|bar|`" + ==-> "\n\n\n\n\n\n\n
FooBar
|foo||bar|
\n" + it "multi-line code spans are disallowed in table headers" $ + "`Foo\nBar` | Bar\n--- | ---\nfoo | bar" + ==-> "

Foo Bar | Bar\n--- | ---\nfoo | bar

\n" + it "multi-line code spans are disallowed in table cells" $ + let s = "Foo | Bar\n--- | ---\n`foo\nbar` | bar" + in s + ~~-> [ err 24 (utok '\n' <> etok '`' <> ecsc), + err 35 (ueib <> etok '`' <> ecsc) + ] + it "parses tables with just header row" $ + "Foo | Bar\n--- | ---" + ==-> "\n\n\n\n\n\n
FooBar
\n" + it "recognizes end of table correctly" $ + "Foo | Bar\n--- | ---\nfoo | bar\n\nHere goes a paragraph." + ==-> "\n\n\n\n\n\n\n
FooBar
foobar
\n

Here goes a paragraph.

\n" + it "is capable of reporting a parse error per cell" $ + let s = "Foo | *Bar\n--- | ----\n_foo | bar_" + in s + ~~-> [ err 10 (ueib <> etok '*' <> eic), + err 26 (ueib <> etok '_' <> eic), + errFancy 32 (unmatchedClosing "_") + ] + it "tables have higher precedence than unordered lists" $ do + "+ foo | bar\n------|----\n" + ==-> "\n\n\n\n\n\n
+ foobar
\n" + "+ foo | bar\n -----|----\n" + ==-> "\n\n\n\n\n\n
+ foobar
\n" + it "tables have higher precedence than ordered lists" $ do + "1. foo | bar\n-------|----\n" + ==-> "\n\n\n\n\n\n
1. foobar
\n" + "1. foo | bar\n ------|----\n" + ==-> "\n\n\n\n\n\n
1. foobar
\n" + it "block quotes have higher precedence than tables" $ + "> foo | bar\n> -----|----\n> baz | quux" + ==-> "
\n\n\n\n\n\n\n\n
foobar
bazquux
\n
\n" + it "if table is indented inside unordered list, it's put there" $ + "+ foo | bar\n ----|----\n" + ==-> "
    \n
  • \n\n\n\n\n\n\n
    foobar
    \n
    • \n
\n" + it "if table is indented inside ordered list, it's put there" $ + "1. foo | bar\n ----|----\n" + ==-> "
    \n
  1. \n\n\n\n\n\n\n
    foobar
    \n
    2. \n
\n" + it "renders a comprehensive table correctly" $ + withFiles "data/table.md" "data/table.html" + context "parse errors at block level" $ do + it "reports a heading that has no content" $ + "#" ~-> err 1 (ueib <> etok '#' <> ews) + it "reports a heading with too many hash signs" $ + "####### foo" ~-> err 6 (utok '#' <> ews) + it "a YAML block does not shift the offsets that follow it" $ do + "---\nfoo: bar\n---\n\n*baz" + ~-> err 22 (ueib <> etok '*' <> eic) + "---\nfoo: bar\n---\n\n> *baz" + ~-> err 24 (ueib <> etok '*' <> eic) + context "parse errors in block quotes" $ do + -- NOTE The block quote markers are replaced by spaces in the text that + -- is handed over to the inline-level parser, so offsets inside a block + -- quote must come out exactly as they would without it. + it "reports an error in a one-line block quote" $ do + "> *foo" ~-> err 6 (ueib <> etok '*' <> eic) + " > *foo" ~-> err 8 (ueib <> etok '*' <> eic) + it "block quote markers do not shift offsets" $ do + "> foo\n> *bar" ~-> err 12 (ueib <> etok '*' <> eic) + "> > foo\n> > *bar" ~-> err 16 (ueib <> etok '*' <> eic) + ">foo\n> *bar" ~-> err 13 (ueib <> etok '*' <> eic) + ">\t*foo" ~-> err 6 (ueib <> etok '*' <> eic) + it "offsets are correct on lazy continuation lines" $ do + "> foo\n*bar" ~-> err 10 (ueib <> etok '*' <> eic) + "> *foo\n bar" ~-> err 12 (ueib <> etok '*' <> eic) + ">>> foo\n> *bar" ~-> err 14 (ueib <> etok '*' <> eic) + "> 1. > *foo\n> continued *bar" + ~-> err 28 (ueib <> etok '*' <> eic) + it "offsets are correct in inlines that span several lines" $ do + "> `foo\n> bar" ~-> err 12 (ueib <> etok '`' <> ecsc) + "> foo\n*bar `baz" ~-> err 15 (ueib <> etok '`' <> ecsc) + it "offsets after a block quote are not affected by it" $ + "> quote\n\n*after" ~-> err 15 (ueib <> etok '*' <> eic) + it "reports an error in a heading in a block quote" $ do + "> # *foo" ~-> err 8 (ueib <> etok '*' <> eic) + ">#Header" ~-> err 2 (utok 'H' <> etok '#' <> ews) + it "reports an error in a table cell in a block quote" $ + "> foo | bar\n> -----|----\n> *baz | quux" + ~-> err 31 (ueib <> etok '*' <> eic) + it "reports an error in a title in a block quote" $ + "> ![img](/url \"title\n" + ~-> err + 20 + ( ueib + <> etok '\"' + <> etok '&' + <> etoks "&#" + <> elabel "escaped character" + <> elabel "unescaped character" + ) + it "reports reference definition errors in a block quote" $ do + "> [foo]\n\n[bar]: /url" + ~-> errFancy 3 (couldNotMatchRef "foo" []) + "> [foo]: /url\n> [foo]: /bar" + ~-> errFancy 17 (duplicateRef "foo") + it "reports entity errors in a block quote" $ do + "> &nosuchentity;" ~-> errFancy 2 (unknownEntity "nosuchentity") + "> �" ~-> errFancy 2 (invalidNumChar 0) + it "reports every error in a block quote" $ do + let e = ueib <> etok '*' <> eic + "> *foo\n>\n> *bar" ~~-> [err 6 e, err 15 e] + "> *foo\n> ***\n> *bar" ~~-> [err 6 e, err 19 e] + "> *foo\n\n> *bar" ~~-> [err 6 e, err 14 e] + it "reports errors in lists inside a block quote" $ do + let e = ueib <> etok '*' <> eic + "> - *foo\n> - *bar" ~~-> [err 8 e, err 17 e] + "> 1. *foo\n> 3. *bar" + ~~-> [ err 9 e, + errFancy 12 (indexNonCons 3 2), + err 19 e + ] + it "reports errors in a block quote inside a list" $ + "- *foo\n\n > *bar" + ~~-> [ err 6 (ueib <> etok '*' <> eic), + err 16 (ueib <> etok '*' <> eic) + ] + it "reports errors around a block quote in correct order" $ do + let e = ueib <> etok '*' <> eic + "*foo\n\n> *bar\n\n*baz" ~~-> [err 4 e, err 12 e, err 18 e] + -- A block quote may interrupt a paragraph and be interrupted by a + -- heading, without either losing its parse error. + "*foo\n> *bar" ~~-> [err 4 e, err 11 e] + "> *foo\n# *bar" ~~-> [err 6 e, err 13 e] + -- NOTE Unlike in CommonMark, the end of a block quote does not close + -- a code fence that was opened inside of it, see CM128 and CM237. + describe "code fences that the end of a block quote leaves unclosed" $ do + it "reports the line that lacks the block quote marker" $ do + "> ```\n> foo\n" ~-> err 12 (ebqm <> eccf <> ecbc) + "> foo\n\n> ```\n> bar\n\nbaz" ~-> err 19 (ebqm <> eccf <> ecbc) + it "reports the marker of the innermost block quote" $ + "> > ```\n> > foo\n> ```" ~-> err 18 (ebqm <> eccf <> ecbc) + it "works for a block quote inside a list" $ + "- > ```\n > foo\n\nbar" ~-> err 16 (ebqm <> eccf <> ecbc) + it "names the missing fence when the last line has no line ending" $ do + "```\nfoo" ~-> err 7 (ueof <> eccf <> ecbc) + "> ```\n> foo" ~-> err 11 (ueof <> eccf <> ecbc) + context "multiple parse errors" $ do + it "they are reported in correct order" $ do + let s = "Foo `\n\nBar `.\n" + pe = ueib <> etok '`' <> ecsc + s + ~~-> [ err 5 pe, + err 13 pe + ] + it "invalid headers are skipped properly" $ do + let s = "#My header\n\nSomething goes __here __.\n" + s + ~~-> [ err 1 (utok 'M' <> etok '#' <> ews), + err 37 (ueib <> etoks "__" <> eic) + ] + describe "every block in a list gets its parse error propagated" $ do + context "with unordered list" $ + it "works" $ do + let s = "- *foo\n\n *bar\n- *baz\n\n *quux\n" + e = ueib <> etok '*' <> eic + s + ~~-> [ err 6 e, + err 14 e, + err 21 e, + err 30 e + ] + context "with ordered list" $ + it "works" $ do + let s = "1. *foo\n\n *bar\n2. *baz\n\n *quux\n" + e = ueib <> etok '*' <> eic + s + ~~-> [ err 7 e, + err 16 e, + err 24 e, + err 34 e + ] + it "too big start index of ordered list does not prevent validation of inner inlines" $ do + let s = "1234567890. *something\n1234567891. [\n" + s + ~~-> [ errFancy 0 (indexTooBig 1234567890), + err 22 (ueib <> etok '*' <> eic), + err 36 (ueib <> eic) + ] + it "non-consecutive indices in ordered list do not prevent further validation" $ do + let s = "1. *foo\n3. *bar\n4. *baz\n" + e = ueib <> etok '*' <> eic + s + ~~-> [ err 7 e, + errFancy 8 (indexNonCons 3 2), + err 15 e, + errFancy 16 (indexNonCons 4 3), + err 23 e + ] + context "given a complete, comprehensive document" + $ it "outputs expected the HTML fragment" + $ withFiles "data/comprehensive.md" "data/comprehensive.html" + describe "runTrans" $ + it "applies the given transformation" $ do + doc <- mkDoc "Here we go." + renderTrans (append_ext "..") doc + `shouldBe` Right "

Here we go...

\n" + describe "runTrans, several times" $ + it "applies transformations in the order they are sequenced" $ do + doc <- mkDoc "Here we go." + let f = append_ext "1" >=> append_ext "2" >=> append_ext "3" + renderTrans f doc `shouldBe` Right "

Here we go.123

\n" + describe "runScanner and scanner" $ + it "extracts information from markdown document" $ do + doc <- mkDoc "Here we go, pals." + let n = MMark.runScanner (length_scan (const True)) doc + n `shouldBe` 17 + describe "combining of scanners" $ + it "combines scanners" $ do + doc <- mkDoc "Here we go, pals." + let scan = + (,,) + <$> length_scan (const True) + <*> length_scan isSpace + <*> length_scan isPunctuation + r = MMark.runScanner scan doc + r `shouldBe` (17, 3, 2) + describe "projectYaml" $ do + context "when document does not contain a YAML section" $ + it "returns Nothing" $ do + doc <- mkDoc "Here we go." + MMark.projectYaml doc `shouldBe` Nothing + context "when document contains a YAML section" $ do + context "when it is valid" $ do + let r = + object + [ "x" .= Number 100, + "y" .= Number 200 + ] + it "returns the YAML section (1)" $ do + doc <- mkDoc "---\nx: 100\ny: 200\n---\nHere we go." + MMark.projectYaml doc `shouldBe` Just r + it "returns the YAML section (2)" $ do + doc <- mkDoc "---\nx: 100\ny: 200\n---\n\n" + MMark.projectYaml doc `shouldBe` Just r + context "when it is invalid" $ do + let mappingErr = + fancy . ErrorCustom . YamlParseError $ + "mapping values are not allowed in this context" + it "signals correct parse error" $ + let s = "---\nx: 100\ny: x:\n---\nHere we go." + in s ~-> errFancy 15 mappingErr + it "does not choke and can report more parse errors" $ + let s = "---\nx: 100\ny: x:\n---\nHere we *go." + in s + ~~-> [ errFancy 15 mappingErr, + err 33 (ueib <> etok '*' <> eic) + ] + +---------------------------------------------------------------------------- +-- Testing extensions + +-- | Append given text to all 'Plain' inlines. +append_ext :: Text -> Bni -> Trans Bni +append_ext y = Trans.bottomUpInlines $ \case + Plain ann x -> return (Plain ann (x <> y)) + other -> return other + +-- | Apply a transformation and render the result. +renderTrans :: (Bni -> Trans Bni) -> MMark -> Either String Text +renderTrans f doc = case MMark.runTrans f doc of + Left errs -> Left (errorBundlePretty errs) + Right doc' -> Right (toText doc') + +---------------------------------------------------------------------------- +-- Testing scanners + +-- | Scan total number of characters satisfying a predicate in all 'Plain' +-- inlines. +length_scan :: (Char -> Bool) -> L.Fold Bni Int +length_scan p = MMark.scanner 0 $ \n block -> + getSum $ Sum n <> foldMap (foldMap f) block + where + f (Plain _ txt) = (Sum . T.length) (T.filter p txt) + f _ = mempty + +---------------------------------------------------------------------------- +-- For testing with documents loaded externally + +-- | Load a complete markdown document from an external file and compare the +-- final HTML rendering with the contents of another file. +withFiles :: + -- | Markdown document + FilePath -> + -- | HTML document containing the correct result + FilePath -> + Expectation +withFiles input output = do + i <- TIO.readFile input + o <- TIO.readFile output + i ==-> o + +---------------------------------------------------------------------------- +-- Helpers + +-- | Unexpected end of inline block. +ueib :: ET s +ueib = ulabel "end of inline block" + +-- | Expecting end of inline block. +eeib :: ET s +eeib = elabel "end of inline block" + +-- | Expecting end of URI. +euri :: ET s +euri = elabel "end of URI" + +-- | Expecting inline content. +eic :: ET s +eic = elabel "inline content" + +-- | Expecting white space. +ews :: ET s +ews = elabel "white space" + +-- | Expecting code span content. +ecsc :: ET s +ecsc = elabel "code span content" + +-- | Expecting a block quote marker. +ebqm :: ET s +ebqm = elabel "block quote marker" + +-- | Expecting a closing code fence. +eccf :: ET s +eccf = elabel "closing code fence" + +-- | Expecting code block content. +ecbc :: ET s +ecbc = elabel "code block content" + +-- | Expecting common URI components. +euric :: ET Text +euric = + mconcat + [ etok '#', + etok '%', + etok '/', + etok ':', + etok '?', + etok '@', + elabel "sub-delimiter", + elabel "unreserved character" + ] + +-- | The error component complaining that the given 'Text' is not in left- +-- or right- flanking position. +nonFlanking :: Text -> EF MMarkErr +nonFlanking = fancy . ErrorCustom . NonFlankingDelimiterRun . NE.fromList . T.unpack + +unmatchedClosing :: Text -> EF MMarkErr +unmatchedClosing = + fancy . ErrorCustom . UnmatchedClosingDelimiterRun . NE.fromList . T.unpack -- | The error component complaining that the given starting index of an -- ordered list is too big.