mmark 0.0.7.2 → 0.0.7.3
raw patch · 18 files changed
+3394/−3290 lines, 18 filesdep ~aesondep ~basedep ~hashable
Dependency ranges changed: aeson, base, hashable, modern-uri, yaml
Files
- CHANGELOG.md +6/−0
- README.md +1/−1
- Text/MMark.hs +33/−34
- Text/MMark/Extension.hs +49/−45
- Text/MMark/Parser.hs +432/−397
- Text/MMark/Parser/Internal.hs +117/−120
- Text/MMark/Parser/Internal/Type.hs +108/−113
- Text/MMark/Render.hs +45/−53
- Text/MMark/Trans.hs +14/−16
- Text/MMark/Type.hs +103/−106
- Text/MMark/Util.hs +33/−33
- bench/memory/Main.hs +7/−6
- bench/speed/Main.hs +21/−19
- data/comprehensive.html +2/−2
- mmark.cabal +143/−118
- tests/Text/MMark/ExtensionSpec.hs +23/−25
- tests/Text/MMark/TestUtils.hs +70/−70
- tests/Text/MMarkSpec.hs +2187/−2132
CHANGELOG.md view
@@ -1,3 +1,9 @@+## MMark 0.0.7.3++* The test suite passes with `modern-uri-0.3.4` and later.++* Dropped support for GHC 8.6.x and older. Added support for GHC 9.0.1.+ ## MMark 0.0.7.2 * Uses Megaparsec 8.0.0.
README.md view
@@ -4,7 +4,7 @@ [](https://hackage.haskell.org/package/mmark) [](http://stackage.org/nightly/package/mmark) [](http://stackage.org/lts/package/mmark)-[](https://travis-ci.org/mmark-md/mmark)+ * [Quick start: MMark vs GitHub-flavored markdown](#quick-start-mmark-vs-github-flavored-markdown) * [MMark and Common Mark](#mmark-and-common-mark)
Text/MMark.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RecordWildCards #-}+ -- | -- Module : Text.MMark -- Copyright : © 2017–present Mark Karpov@@ -110,37 +112,33 @@ -- and encouraged. To write an extension of your own import the -- "Text.MMark.Extension" module, which has some documentation focusing on -- extension writing.--{-# LANGUAGE CPP #-}-{-# LANGUAGE RecordWildCards #-}- module Text.MMark ( -- * Parsing- MMark- , MMarkErr (..)- , parse+ MMark,+ MMarkErr (..),+ parse,+ -- * Extensions- , Extension- , useExtension- , useExtensions+ Extension,+ useExtension,+ useExtensions,+ -- * Scanning- , runScanner- , runScannerM- , projectYaml+ runScanner,+ runScannerM,+ projectYaml,+ -- * Rendering- , render )+ render,+ ) where +import qualified Control.Foldl as L import Data.Aeson import Text.MMark.Parser (MMarkErr (..), parse) import Text.MMark.Render (render) import Text.MMark.Type-import qualified Control.Foldl as L -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup ((<>))-#endif- ---------------------------------------------------------------------------- -- Extensions @@ -148,10 +146,9 @@ -- 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 }+ mmark {mmarkExtension = ext <> mmarkExtension mmark} -- | Apply several 'Extension's to an 'MMark' document. --@@ -162,7 +159,6 @@ -- 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) @@ -174,11 +170,13 @@ -- -- Take a look at the "Text.MMark.Extension" module if you want to create -- scanners of your own.--runScanner- :: MMark -- ^ Document to scan- -> L.Fold Bni a -- ^ 'L.Fold' to use- -> a -- ^ Result of scanning+runScanner ::+ -- | Document to scan+ MMark ->+ -- | 'L.Fold' to use+ L.Fold Bni a ->+ -- | Result of scanning+ a runScanner MMark {..} f = L.fold f mmarkBlocks -- | Like 'runScanner', but allows to run scanners with monadic context.@@ -187,15 +185,16 @@ -- use 'L.generalize' and 'L.simplify'. -- -- @since 0.0.2.0--runScannerM- :: Monad m- => MMark -- ^ Document to scan- -> L.FoldM m Bni a -- ^ 'L.FoldM' to use- -> m a -- ^ Result of scanning+runScannerM ::+ Monad m =>+ -- | Document to scan+ MMark ->+ -- | 'L.FoldM' to use+ L.FoldM m Bni a ->+ -- | Result of scanning+ m a runScannerM MMark {..} f = L.foldM f mmarkBlocks -- | Extract contents of an optional YAML block that may have been parsed.- projectYaml :: MMark -> Maybe Value projectYaml = mmarkYaml
Text/MMark/Extension.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}+ -- | -- Module : Text.MMark.Extension -- Copyright : © 2017–present Mark Karpov@@ -71,38 +73,40 @@ -- 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.--{-# LANGUAGE RankNTypes #-}- module Text.MMark.Extension ( -- * Extension construction- Extension+ Extension,+ -- ** Block-level manipulation- , Bni- , Block (..)- , CellAlign (..)- , blockTrans- , blockRender- , Ois- , getOis+ Bni,+ Block (..),+ CellAlign (..),+ blockTrans,+ blockRender,+ Ois,+ getOis,+ -- ** Inline-level manipulation- , Inline (..)- , inlineTrans- , inlineRender+ Inline (..),+ inlineTrans,+ inlineRender,+ -- * Scanner construction- , scanner- , scannerM+ scanner,+ scannerM,+ -- * Utils- , asPlainText- , headerId- , headerFragment )+ asPlainText,+ headerId,+ headerFragment,+ ) where +import qualified Control.Foldl as L import Data.Monoid hiding ((<>)) import Lucid import Text.MMark.Type import Text.MMark.Util-import qualified Control.Foldl as L -- | Create an extension that performs a transformation on 'Block's of -- markdown document. Since a block may contain other blocks we choose to@@ -110,9 +114,8 @@ -- 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 }+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@@ -127,44 +130,45 @@ -- > (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 }+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 }+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 }+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- :: a -- ^ Initial state- -> (a -> Bni -> a) -- ^ Folding function- -> L.Fold Bni a -- ^ Resulting 'L.Fold'+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- => m a -- ^ Initial state- -> (a -> Bni -> m a) -- ^ Folding function- -> L.FoldM m Bni a -- ^ Resulting 'L.FoldM'+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
Text/MMark/Parser.hs view
@@ -1,3 +1,13 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+ -- | -- Module : Text.MMark.Parser -- Copyright : © 2017–present Mark Karpov@@ -8,82 +18,75 @@ -- Portability : portable -- -- MMark markdown parser.--{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}- module Text.MMark.Parser- ( MMarkErr (..)- , parse )+ ( MMarkErr (..),+ parse,+ ) where import Control.Applicative (Alternative, liftA2) import Control.Monad+import qualified Control.Monad.Combinators.NonEmpty as NE+import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor (..)) import Data.Bool (bool)+import qualified Data.Char as Char+import qualified Data.DList as DList import Data.HTML.Entities (htmlEntityMap)+import qualified Data.HashMap.Strict as HM import Data.List.NonEmpty (NonEmpty (..), (<|))-import Data.Maybe (isNothing, fromJust, catMaybes, isJust)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (catMaybes, fromJust, isJust, isNothing) import Data.Monoid (Any (..)) import Data.Ratio ((%))+import qualified Data.Set as E import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import Lens.Micro ((^.))+import qualified Text.Email.Validate as Email import Text.MMark.Parser.Internal import Text.MMark.Type import Text.MMark.Util-import Text.Megaparsec hiding (parse, State (..))+import Text.Megaparsec hiding (State (..), parse) import Text.Megaparsec.Char hiding (eol)+import qualified Text.Megaparsec.Char.Lexer as L import Text.URI (URI)+import qualified Text.URI as URI import Text.URI.Lens (uriPath)-import qualified Control.Monad.Combinators.NonEmpty as NE-import qualified Data.Aeson as Aeson-import qualified Data.Char as Char-import qualified Data.DList as DList-import qualified Data.HashMap.Strict as HM-import qualified Data.List.NonEmpty as NE-import qualified Data.Set as E-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Text.Email.Validate as Email-import qualified Text.Megaparsec.Char.Lexer as L-import qualified Text.URI as URI -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup (..))-#endif- #if !defined(ghcjs_HOST_OS)-import qualified Data.Yaml as Yaml+import qualified Data.Yaml as Yaml #endif ---------------------------------------------------------------------------- -- Auxiliary data types -- | Frame that describes where we are in parsing inlines.- data InlineFrame- = EmphasisFrame -- ^ Emphasis with asterisk @*@- | EmphasisFrame_ -- ^ Emphasis with underscore @_@- | StrongFrame -- ^ Strong emphasis with asterisk @**@- | StrongFrame_ -- ^ Strong emphasis with underscore @__@- | StrikeoutFrame -- ^ Strikeout- | SubscriptFrame -- ^ Subscript- | SuperscriptFrame -- ^ Superscript+ = -- | 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- = SingleFrame InlineFrame -- ^ One frame to be closed- | DoubleFrame InlineFrame InlineFrame -- ^ Two frames to be closed+ = -- | One frame to be closed+ SingleFrame InlineFrame+ | -- | Two frames to be closed+ DoubleFrame InlineFrame InlineFrame deriving (Eq, Ord, Show) ----------------------------------------------------------------------------@@ -91,44 +94,49 @@ -- | Parse a markdown document in the form of a strict 'Text' value and -- either report parse errors or return an 'MMark' document.--parse- :: FilePath- -- ^ File name (only to be used in error messages), may be empty- -> Text- -- ^ Input to parse- -> Either (ParseErrorBundle Text MMarkErr) MMark- -- ^ Parse errors or parsed document+parse ::+ -- | File name (only to be used in error messages), may be empty+ FilePath ->+ -- | Input to parse+ Text ->+ -- | Parse errors or parsed document+ Either (ParseErrorBundle Text MMarkErr) MMark parse file input = case runBParser pMMark file input of Left bundle -> Left bundle Right ((myaml, rawBlocks), defs) -> let parsed = doInline <$> rawBlocks- doInline = fmap- $ first (replaceEof "end of inline block")- . runIParser defs pInlinesTop+ doInline =+ fmap $+ first (replaceEof "end of inline block")+ . runIParser defs pInlinesTop e2p = either DList.singleton (const DList.empty)- in case NE.nonEmpty . DList.toList $ foldMap (foldMap e2p) parsed of- Nothing -> Right MMark- { mmarkYaml = myaml- , mmarkBlocks = fmap fromRight <$> parsed- , mmarkExtension = mempty }- Just errs -> Left ParseErrorBundle- { bundleErrors = errs- , bundlePosState = PosState- { pstateInput = input- , pstateOffset = 0- , pstateSourcePos = initialPos file- , pstateTabWidth = mkPos 4- , pstateLinePrefix = ""- }- }+ in case NE.nonEmpty . DList.toList $ foldMap (foldMap e2p) parsed of+ Nothing ->+ Right+ MMark+ { mmarkYaml = myaml,+ mmarkBlocks = fmap fromRight <$> parsed,+ mmarkExtension = mempty+ }+ Just errs ->+ Left+ ParseErrorBundle+ { bundleErrors = errs,+ bundlePosState =+ PosState+ { pstateInput = input,+ pstateOffset = 0,+ pstateSourcePos = initialPos file,+ pstateTabWidth = mkPos 4,+ pstateLinePrefix = ""+ }+ } ---------------------------------------------------------------------------- -- Block parser -- | Parse an MMark document on block level.- pMMark :: BParser (Maybe Aeson.Value, [Block Isp]) pMMark = do meyaml <- optional pYamlBlock@@ -145,7 +153,6 @@ -- | Parse a YAML block. On success return the actual parsed 'Aeson.Value' in -- 'Right', otherwise return 'SourcePos' of parse error and 'String' -- describing the error as generated by the @yaml@ package in 'Left'.- pYamlBlock :: BParser (Either (Int, String) Aeson.Value) pYamlBlock = do string "---" *> sc' *> eol@@ -155,54 +162,54 @@ e <- atEnd if e || T.stripEnd l == "---" then return acc- else go (acc . (l:))+ else go (acc . (l :)) doffset <- getOffset ls <- go id <*> ([] <$ sc) return $ decodeYaml ls doffset -- | Parse several (possibly zero) blocks in a row.- pBlocks :: BParser [Block Isp] pBlocks = catMaybes <$> many pBlock -- | Parse a single block of markdown document.- pBlock :: BParser (Maybe (Block Isp)) pBlock = do sc rlevel <- refLevel alevel <- L.indentLevel- done <- atEnd- if done || alevel < rlevel then empty else- case compare alevel (ilevel rlevel) of- LT -> choice- [ Just <$> pThematicBreak- , Just <$> pAtxHeading- , Just <$> pFencedCodeBlock- , Just <$> pTable- , Just <$> pUnorderedList- , Just <$> pOrderedList- , Just <$> pBlockquote- , pReferenceDef- , Just <$> pParagraph ]- _ ->- Just <$> pIndentedCodeBlock+ done <- atEnd+ if done || alevel < rlevel+ then empty+ else case compare alevel (ilevel rlevel) of+ LT ->+ choice+ [ Just <$> pThematicBreak,+ Just <$> pAtxHeading,+ Just <$> pFencedCodeBlock,+ Just <$> pTable,+ Just <$> pUnorderedList,+ Just <$> pOrderedList,+ Just <$> pBlockquote,+ pReferenceDef,+ Just <$> pParagraph+ ]+ _ ->+ Just <$> pIndentedCodeBlock -- | Parse a thematic break.- pThematicBreak :: BParser (Block Isp) pThematicBreak = do l' <- lookAhead nonEmptyLine let l = T.filter (not . isSpace) l'- if T.length l >= 3 &&- (T.all (== '*') l ||- T.all (== '-') l ||- T.all (== '_') l)+ if T.length l >= 3+ && ( T.all (== '*') l+ || T.all (== '-') l+ || T.all (== '_') l+ ) then ThematicBreak <$ nonEmptyLine <* sc else empty -- | Parse an ATX heading.- pAtxHeading :: BParser (Block Isp) pAtxHeading = do (void . lookAhead . try) hashIntro@@ -210,8 +217,9 @@ hlevel <- length <$> hashIntro sc1' ispOffset <- getOffset- r <- someTill (satisfy notNewline <?> "heading character") . try $- optional (sc1' *> some (char '#') *> sc') *> (eof <|> eol)+ r <-+ someTill (satisfy notNewline <?> "heading character") . try $+ optional (sc1' *> some (char '#') *> sc') *> (eof <|> eol) let toBlock = case hlevel of 1 -> Heading1 2 -> Heading2@@ -226,7 +234,6 @@ Heading1 (IspError err) <$ takeWhileP Nothing notNewline <* sc -- | Parse a fenced code block.- pFencedCodeBlock :: BParser (Block Isp) pFencedCodeBlock = do alevel <- L.indentLevel@@ -236,28 +243,30 @@ CodeBlock infoString (assembleCodeBlock alevel ls) <$ sc -- | Parse the opening fence of a fenced code block.- pOpeningFence :: BParser (Char, Int, Maybe Text) pOpeningFence = p '`' <|> p '~' where p ch = try $ do void $ count 3 (char ch)- n <- (+ 3) . length <$> many (char ch)- ml <- optional- (T.strip <$> someEscapedWith notNewline <?> "info string")+ n <- (+ 3) . length <$> many (char ch)+ ml <-+ optional+ (T.strip <$> someEscapedWith notNewline <?> "info string") guard (maybe True (not . T.any (== '`')) ml)- (ch, n,- case ml of- Nothing -> Nothing- Just l ->- if T.null l- then Nothing- else Just l) <$ eol+ ( ch,+ n,+ case ml of+ Nothing -> Nothing+ Just l ->+ if T.null l+ then Nothing+ else Just l+ )+ <$ eol -- | 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 = try . label "closing code fence" $ do clevel <- ilevel <$> refLevel void $ L.indentGuard sc' LT clevel void $ count n (char ch)@@ -266,19 +275,19 @@ eof <|> eol -- | Parse an indented code block.- pIndentedCodeBlock :: BParser (Block Isp) pIndentedCodeBlock = do alevel <- L.indentLevel clevel <- ilevel <$> refLevel let go ls = do- indented <- lookAhead $- (>= clevel) <$> (sc *> L.indentLevel)+ indented <-+ lookAhead $+ (>= clevel) <$> (sc *> L.indentLevel) if indented then do- l <- option "" nonEmptyLine+ l <- option "" nonEmptyLine continue <- eol'- let ls' = ls . (l:)+ let ls' = ls . (l :) if continue then go ls' else return ls'@@ -287,24 +296,23 @@ -- that preceding space is not yet consumed when we get to -- interpreting input as an indented code block, so we need to restore -- the space this way.- f x = T.replicate (unPos alevel - 1) " " <> x- g [] = []- g (x:xs) = f x : xs+ f x = T.replicate (unPos alevel - 1) " " <> x+ g [] = []+ g (x : xs) = f x : xs ls <- g . ($ []) <$> go id CodeBlock Nothing (assembleCodeBlock clevel ls) <$ sc -- | Parse an unorederd list.- pUnorderedList :: BParser (Block Isp) pUnorderedList = do (bullet, bulletPos, minLevel, indLevel) <- pListBullet Nothing- x <- innerBlocks bulletPos minLevel indLevel+ x <- innerBlocks bulletPos minLevel indLevel xs <- many $ do (_, bulletPos', minLevel', indLevel') <- pListBullet (Just (bullet, bulletPos)) innerBlocks bulletPos' minLevel' indLevel'- return (UnorderedList (normalizeListItems (x:|xs)))+ return (UnorderedList (normalizeListItems (x :| xs))) where innerBlocks bulletPos minLevel indLevel = do p <- getSourcePos@@ -321,14 +329,13 @@ -- * 'SourcePos' at which the bullet was located -- * the closest column position where content could start -- * the indentation level after the bullet--pListBullet- :: Maybe (Char, SourcePos)- -- ^ Bullet 'Char' and start position of the first bullet in a list- -> BParser (Char, SourcePos, Pos, Pos)+pListBullet ::+ -- | 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+ pos <- getSourcePos+ l <- (<> mkPos 2) <$> L.indentLevel bullet <- case mbullet of Nothing -> char '-' <|> char '+' <|> char '*'@@ -336,17 +343,16 @@ guard (sourceColumn pos >= sourceColumn bulletPos) char bullet eof <|> sc1- l' <- L.indentLevel+ l' <- L.indentLevel return (bullet, pos, l, l') -- | Parse an ordered list.- pOrderedList :: BParser (Block Isp) pOrderedList = do startOffset <- getOffset (startIx, del, startPos, minLevel, indLevel) <- pListIndex Nothing- x <- innerBlocks startPos minLevel indLevel+ x <- innerBlocks startPos minLevel indLevel xs <- manyIndexed (startIx + 1) $ \expectedIx -> do startOffset' <- getOffset (actualIx, _, startPos', minLevel', indLevel') <-@@ -354,16 +360,18 @@ let f blocks = if actualIx == expectedIx then blocks- else prependErr- startOffset'- (ListIndexOutOfOrder actualIx expectedIx)- blocks+ else+ prependErr+ startOffset'+ (ListIndexOutOfOrder actualIx expectedIx)+ blocks f <$> innerBlocks startPos' minLevel' indLevel' return . OrderedList startIx . normalizeListItems $- (if startIx <= 999999999- then x- else prependErr startOffset (ListStartIndexTooBig startIx) x)- :| xs+ ( if startIx <= 999999999+ then x+ else prependErr startOffset (ListStartIndexTooBig startIx) x+ )+ :| xs where innerBlocks indexPos minLevel indLevel = do p <- getSourcePos@@ -381,26 +389,24 @@ -- * 'SourcePos' at which the index was located -- * the closest column position where content could start -- * the indentation level after the index--pListIndex- :: Maybe (Char, SourcePos)- -- ^ Delimiter 'Char' and start position of the first index in a list- -> BParser (Word, Char, SourcePos, Pos, Pos)+pListIndex ::+ -- | 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- i <- L.decimal+ 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+ l <- (<> pos1) <$> L.indentLevel eof <|> sc1- l' <- L.indentLevel+ l' <- L.indentLevel return (i, del, pos, l, l') -- | Parse a block quote.- pBlockquote :: BParser (Block Isp) pBlockquote = do minLevel <- try $ do@@ -421,23 +427,23 @@ else return (Blockquote []) -- | 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' uri <- pUri- hadSpN <- optional $- (sc1' *> option False (True <$ eol)) <|> (True <$ (sc' <* eol))+ hadSpN <-+ optional $+ (sc1' *> option False (True <$ eol)) <|> (True <$ (sc' <* eol)) sc' mtitle <- if isJust hadSpN then optional pTitle <* sc' else return Nothing case (hadSpN, mtitle) of- (Just True, Nothing) -> return ()- _ -> hidden eof <|> eol+ (Just True, Nothing) -> return ()+ _ -> hidden eof <|> eol conflict <- registerReference dlabel (uri, mtitle) when conflict $ customFailure' o (DuplicateReferenceDefinition dlabel)@@ -447,7 +453,6 @@ Just (Naked (IspError err)) <$ takeWhileP Nothing notNewline <* sc -- | Parse a pipe table.- pTable :: BParser (Block Isp) pTable = do (n, headerRow) <- try $ do@@ -473,10 +478,12 @@ where cell = do o <- getOffset- txt <- fmap (T.stripEnd . T.pack) . foldMany' . choice $- [ (++) . T.unpack <$> hidden (string "\\|")- , (++) . T.unpack <$> pCodeSpanB- , (:) <$> label "inline content" (satisfy cellChar) ]+ txt <-+ fmap (T.stripEnd . T.pack) . foldMany' . choice $+ [ (++) . T.unpack <$> hidden (string "\\|"),+ (++) . T.unpack <$> pCodeSpanB,+ (:) <$> label "inline content" (satisfy cellChar)+ ] return (IspSpan o txt) cellChar x = x /= '|' && notNewline x rowWrapper p = do@@ -496,29 +503,29 @@ return $ case (l, r) of (False, False) -> CellAlignDefault- (True, False) -> CellAlignLeft- (False, True) -> CellAlignRight- (True, True) -> CellAlignCenter+ (True, False) -> CellAlignLeft+ (False, True) -> CellAlignRight+ (True, True) -> CellAlignCenter isHeaderLike txt =- T.length (T.filter isHeaderConstituent txt) % T.length txt >- 8 % 10+ T.length (T.filter isHeaderConstituent txt) % T.length txt+ > 8 % 10 isHeaderConstituent x = isSpace x || x == '|' || x == '-' || x == ':' endOfTable = lookAhead (option True (isBlank <$> nonEmptyLine)) recover err =- Naked (IspError (replaceEof "end of table block" err)) <$- manyTill+ Naked (IspError (replaceEof "end of table block" err))+ <$ manyTill (optional nonEmptyLine)- (endOfTable >>= guard) <* sc+ (endOfTable >>= guard)+ <* sc -- | Parse a paragraph or naked text (is some cases).- pParagraph :: BParser (Block Isp) pParagraph = do startOffset <- getOffset allowNaked <- isNakedAllowed- rlevel <- refLevel+ rlevel <- refLevel let go ls = do l <- lookAhead (option "" nonEmptyLine) broken <- succeeds . lookAhead . try $ do@@ -526,54 +533,57 @@ alevel <- L.indentLevel guard (alevel < ilevel rlevel) unless (alevel < rlevel) . choice $- [ void (char '>')- , void pThematicBreak- , void pAtxHeading- , void pOpeningFence- , void (pListBullet Nothing)- , void (pListIndex Nothing) ]+ [ void (char '>'),+ void pThematicBreak,+ void pAtxHeading,+ void pOpeningFence,+ void (pListBullet Nothing),+ void (pListIndex Nothing)+ ] if isBlank l then return (ls, Paragraph)- else if broken- then return (ls, Naked)- else do- void nonEmptyLine- continue <- eol'- let ls' = ls . (l:)- if continue- then go ls'- else return (ls', Naked)- l <- nonEmptyLine+ else+ if broken+ then return (ls, Naked)+ else do+ void nonEmptyLine+ continue <- eol'+ let ls' = ls . (l :)+ if continue+ then go ls'+ else return (ls', Naked)+ l <- nonEmptyLine continue <- eol' (ls, toBlock) <- if continue then go id else return (id, Naked) (if allowNaked then toBlock else Paragraph)- (IspSpan startOffset (assembleParagraph (l:ls []))) <$ sc+ (IspSpan startOffset (assembleParagraph (l : ls [])))+ <$ sc ---------------------------------------------------------------------------- -- Auxiliary block-level parsers -- | 'match' a code span, this is a specialised and adjusted version of -- 'pCodeSpan'.- pCodeSpanB :: BParser Text pCodeSpanB = fmap fst . match . hidden $ do n <- try (length <$> some (char '`')) let finalizer = try $ do void $ count n (char '`') notFollowedBy (char '`')- skipManyTill (label "code span content" $- takeWhile1P Nothing (== '`') <|>- takeWhile1P Nothing (\x -> x /= '`' && notNewline x))+ skipManyTill+ ( label "code span content" $+ takeWhile1P Nothing (== '`')+ <|> takeWhile1P Nothing (\x -> x /= '`' && notNewline x)+ ) finalizer ---------------------------------------------------------------------------- -- Inline parser -- | The top level inline parser.- pInlinesTop :: IParser (NonEmpty Inline) pInlinesTop = do inlines <- pInlines@@ -581,10 +591,9 @@ return inlines -- | Parse inlines using settings from given 'InlineConfig'.- pInlines :: IParser (NonEmpty Inline) pInlines = do- done <- atEnd+ done <- atEnd allowsEmpty <- isEmptyAllowed if done then@@ -604,9 +613,10 @@ gotImage <- (succeeds . void . lookAhead . string) "![" allowsImages <- isImagesAllowed if gotImage- then if allowsImages- then pImage- else unexpEic (Tokens . NE.fromList $ "![")+ then+ if allowsImages+ then pImage+ else unexpEic (Tokens . NE.fromList $ "![") else pPlain '<' -> do allowsLinks <- isLinksAllowed@@ -623,22 +633,23 @@ -- | Parse a code span. -- -- See also: 'pCodeSpanB'.- pCodeSpan :: IParser Inline pCodeSpan = do n <- try (length <$> some (char '`')) let finalizer = try $ do void $ count n (char '`') notFollowedBy (char '`')- r <- CodeSpan . collapseWhiteSpace . T.concat <$>- manyTill (label "code span content" $- takeWhile1P Nothing (== '`') <|>- takeWhile1P Nothing (/= '`'))- finalizer+ r <-+ CodeSpan . collapseWhiteSpace . T.concat+ <$> manyTill+ ( label "code span content" $+ takeWhile1P Nothing (== '`')+ <|> takeWhile1P Nothing (/= '`')+ )+ finalizer r <$ lastChar OtherChar -- | Parse a link.- pLink :: IParser Inline pLink = do void (char '[')@@ -649,10 +660,9 @@ Link txt dest mtitle <$ lastChar OtherChar -- | Parse an image.- pImage :: IParser Inline pImage = do- (pos, alt) <- emptyAlt <|> nonEmptyAlt+ (pos, alt) <- emptyAlt <|> nonEmptyAlt (src, mtitle) <- pLocation pos alt Image alt src mtitle <$ lastChar OtherChar where@@ -668,7 +678,6 @@ return (o, alt) -- | Parse an autolink.- pAutolink :: IParser Inline pAutolink = between (char '<') (char '>') $ do notFollowedBy (char '>')@@ -676,35 +685,37 @@ let (txt, uri) = case isEmailUri uri' of Nothing ->- ( (nes . Plain . URI.render) uri'- , uri' )+ ( (nes . Plain . URI.render) uri',+ uri'+ ) Just email ->- ( nes (Plain email)- , URI.makeAbsolute mailtoScheme uri' )+ ( nes (Plain email),+ URI.makeAbsolute mailtoScheme uri'+ ) Link 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 $+ 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 -- | Parse a hard line break.- pHardLineBreak :: IParser Inline pHardLineBreak = do void (char '\\')@@ -715,16 +726,17 @@ return LineBreak -- | Parse plain text.- pPlain :: IParser Inline pPlain = fmap (Plain . bakeText) . foldSome $ do ch <- lookAhead (anySingle <?> "inline content") let newline' =- (('\n':) . dropWhile isSpace) <$ eol <* sc' <* lastChar SpaceChar+ (('\n' :) . dropWhile isSpace) <$ eol <* sc' <* lastChar SpaceChar case ch of- '\\' -> (:) <$>- ((escapedChar <* lastChar OtherChar) <|>- try (char '\\' <* notFollowedBy eol <* lastChar OtherChar))+ '\\' ->+ (:)+ <$> ( (escapedChar <* lastChar OtherChar)+ <|> try (char '\\' <* notFollowedBy eol <* lastChar OtherChar)+ ) '\n' -> newline' '\r' ->@@ -735,31 +747,39 @@ '<' -> do notFollowedBy pAutolink (:) <$> char '<' <* lastChar PunctChar- '&' -> choice- [ (:) <$> numRef- , (++) . reverse <$> entityRef- , (:) <$> char '&' ] <* lastChar PunctChar+ '&' ->+ choice+ [ (:) <$> numRef,+ (++) . reverse <$> entityRef,+ (:) <$> char '&'+ ]+ <* lastChar PunctChar _ ->- (:) <$>- if Char.isSpace ch+ (:)+ <$> if Char.isSpace ch then char ch <* lastChar SpaceChar- else if isSpecialChar ch- then failure- (Just . Tokens . nes $ ch)- (E.singleton . Label . NE.fromList $ "inline content")- else if Char.isPunctuation ch- then char ch <* lastChar PunctChar- else char ch <* lastChar OtherChar+ else+ if isSpecialChar ch+ then+ failure+ (Just . Tokens . nes $ ch)+ (E.singleton . Label . NE.fromList $ "inline content")+ else+ if Char.isPunctuation ch+ then char ch <* lastChar PunctChar+ else char ch <* lastChar OtherChar ---------------------------------------------------------------------------- -- Auxiliary inline-level parsers -- | Parse an inline and reference-style link\/image location.--pLocation- :: Int -- ^ Offset where the content inlines start- -> NonEmpty Inline -- ^ The inner content inlines- -> IParser (URI, Maybe Text) -- ^ URI and optionally title+pLocation ::+ -- | Offset where the content inlines start+ Int ->+ -- | The inner content inlines+ NonEmpty Inline ->+ -- | URI and optionally title+ IParser (URI, Maybe Text) pLocation innerOffset inner = do mr <- optional (inplace <|> withRef) case mr of@@ -771,11 +791,12 @@ inplace = do void (char '(') sc'- dest <- pUri+ dest <- pUri hadSpace <- option False (True <$ sc1)- mtitle <- if hadSpace- then optional pTitle <* sc'- else return Nothing+ mtitle <-+ if hadSpace+ then optional pTitle <* sc'+ else return Nothing void (char ')') return (dest, mtitle) withRef =@@ -795,13 +816,12 @@ mkLabel = T.unwords . T.words . asPlainText -- | Parse a URI.- pUri :: (Ord e, Show e, MonadParsec e Text m) => m URI pUri = between (char '<') (char '>') URI.parser <|> naked where naked = do let f x = not (isSpaceN x || x == ')')- l = "end of URI"+ l = "end of URI" (s, s') <- T.span f <$> getInput when (T.null s) . void $ (satisfy f <?> "URI") -- this will now fail@@ -811,19 +831,20 @@ return r -- | Parse a title of a link or an image.- pTitle :: MonadParsec MMarkErr Text m => m Text-pTitle = choice- [ p '\"' '\"'- , p '\'' '\''- , p '(' ')' ]+pTitle =+ choice+ [ p '\"' '\"',+ p '\'' '\'',+ p '(' ')'+ ] where- p start end = between (char start) (char end) $- let f x = x /= end- in manyEscapedWith f "unescaped character"+ p start end =+ between (char start) (char end) $+ let f x = x /= end+ in manyEscapedWith f "unescaped character" -- | Parse label of a reference link.- pRefLabel :: MonadParsec MMarkErr Text m => m (Int, Text) pRefLabel = do try $ do@@ -837,25 +858,27 @@ return (o, dlabel) -- | Parse an opening markup sequence corresponding to given 'InlineState'.- pLfdr :: IParser InlineState 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) ]+ 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))@@ -865,13 +888,13 @@ return st -- | Parse a closing markup sequence corresponding to given 'InlineFrame'.- pRfdr :: InlineFrame -> IParser InlineFrame pRfdr frame = try $ do let dels = inlineFrameDel frame expectingInlineContent = region $ \case- TrivialError pos us es -> TrivialError pos us $- E.insert (Label $ NE.fromList "inline content") es+ TrivialError pos us es ->+ TrivialError pos us $+ E.insert (Label $ NE.fromList "inline content") es other -> other o <- getOffset (void . expectingInlineContent . string) dels@@ -883,18 +906,18 @@ return frame -- | Get 'CharType' of the next char in the input stream.--getNextChar- :: CharType -- ^ What we should consider frame constituent characters- -> IParser CharType+getNextChar ::+ -- | What we should consider frame constituent characters+ CharType ->+ IParser CharType getNextChar frameType = lookAhead (option SpaceChar (charType <$> anySingle)) where charType ch | isFrameConstituent ch = frameType- | Char.isSpace ch = SpaceChar- | ch == '\\' = OtherChar+ | Char.isSpace ch = SpaceChar+ | ch == '\\' = OtherChar | Char.isPunctuation ch = PunctChar- | otherwise = OtherChar+ | otherwise = OtherChar ---------------------------------------------------------------------------- -- Parsing helpers@@ -910,7 +933,7 @@ go g = optional f >>= \case Nothing -> pure g- Just h -> go (h . g)+ Just h -> go (h . g) foldMany' :: MonadPlus m => m ([a] -> [a]) -> m [a] foldMany' f = ($ []) <$> go id@@ -918,7 +941,7 @@ go g = optional f >>= \case Nothing -> pure g- Just h -> go (g . h)+ Just h -> go (g . h) foldSome :: MonadPlus m => m (a -> a) -> m (a -> a) foldSome f = liftA2 (flip (.)) f (foldMany f)@@ -927,56 +950,65 @@ foldSome' f = liftA2 ($) f (foldMany' f) sepByCount :: MonadPlus m => Int -> m a -> m sep -> m [a]-sepByCount 0 _ _ = pure []+sepByCount 0 _ _ = pure [] sepByCount n p sep = liftA2 (:) p (count (n - 1) (sep *> p)) nonEmptyLine :: BParser Text nonEmptyLine = takeWhile1P Nothing notNewline -manyEscapedWith :: MonadParsec MMarkErr Text m- => (Char -> Bool)- -> String- -> m Text-manyEscapedWith f l = fmap T.pack . foldMany' . choice $- [ (:) <$> escapedChar- , (:) <$> numRef- , (++) . reverse <$> entityRef- , (:) <$> satisfy f <?> l ]+manyEscapedWith ::+ MonadParsec MMarkErr Text m =>+ (Char -> Bool) ->+ String ->+ m Text+manyEscapedWith f l =+ fmap T.pack . foldMany' . choice $+ [ (:) <$> escapedChar,+ (:) <$> numRef,+ (++) . reverse <$> entityRef,+ (:) <$> satisfy f <?> l+ ] -someEscapedWith :: MonadParsec MMarkErr Text m- => (Char -> Bool)- -> m Text-someEscapedWith f = fmap T.pack . foldSome' . choice $- [ (:) <$> escapedChar- , (:) <$> numRef- , (++) . reverse <$> entityRef- , (:) <$> satisfy f ]+someEscapedWith ::+ MonadParsec MMarkErr Text m =>+ (Char -> Bool) ->+ m Text+someEscapedWith f =+ fmap T.pack . foldSome' . choice $+ [ (:) <$> escapedChar,+ (:) <$> numRef,+ (++) . reverse <$> entityRef,+ (:) <$> satisfy f+ ] escapedChar :: MonadParsec e Text m => m Char-escapedChar = label "escaped character" $- try (char '\\' *> satisfy isAsciiPunctuation)+escapedChar =+ label "escaped character" $+ try (char '\\' *> satisfy isAsciiPunctuation) -- | Parse an HTML5 entity reference.- entityRef :: MonadParsec MMarkErr Text m => m String entityRef = do- o <- getOffset+ o <- getOffset let f (TrivialError _ us es) = TrivialError o us es- f (FancyError _ xs) = FancyError o xs- name <- try . region f $ between (char '&') (char ';')- (takeWhile1P Nothing Char.isAlphaNum <?> "HTML5 entity name")+ f (FancyError _ xs) = FancyError o xs+ name <-+ try . region f $+ between+ (char '&')+ (char ';')+ (takeWhile1P Nothing Char.isAlphaNum <?> "HTML5 entity name") case HM.lookup name htmlEntityMap of Nothing -> customFailure' o (UnknownHtmlEntityName name) Just txt -> return (T.unpack txt) -- | Parse a numeric character using the given numeric parser.- numRef :: MonadParsec MMarkErr Text m => m Char numRef = do o <- getOffset let f = between (string "&#") (char ';')- n <- try (f (char' 'x' *> L.hexadecimal)) <|> f L.decimal+ n <- try (f (char' 'x' *> L.hexadecimal)) <|> f L.decimal if n == 0 || n > fromEnum (maxBound :: Char) then customFailure' o (InvalidNumericCharacter n) else return (Char.chr n)@@ -994,10 +1026,13 @@ sc1' = void $ takeWhile1P (Just "white space") isSpace eol :: MonadParsec e Text m => m ()-eol = void . label "newline" $ choice- [ string "\n"- , string "\r\n"- , string "\r" ]+eol =+ void . label "newline" $+ choice+ [ string "\n",+ string "\r\n",+ string "\r"+ ] eol' :: MonadParsec e Text m => m Bool eol' = option False (True <$ eol)@@ -1023,7 +1058,7 @@ '^' -> True '_' -> True '~' -> True- _ -> False+ _ -> False isMarkupChar :: Char -> Bool isMarkupChar x = isFrameConstituent x || f x@@ -1032,17 +1067,17 @@ '[' -> True ']' -> True '`' -> True- _ -> False+ _ -> False isSpecialChar :: Char -> Bool isSpecialChar x = isMarkupChar x || x == '\\' || x == '!' || x == '<' isAsciiPunctuation :: Char -> Bool isAsciiPunctuation x =- (x >= '!' && x <= '/') ||- (x >= ':' && x <= '@') ||- (x >= '[' && x <= '`') ||- (x >= '{' && x <= '~')+ (x >= '!' && x <= '/')+ || (x >= ':' && x <= '@')+ || (x >= '[' && x <= '`')+ || (x >= '{' && x <= '~') ---------------------------------------------------------------------------- -- Other helpers@@ -1064,18 +1099,18 @@ where m = snd $ T.foldl' f (0, 0) (T.takeWhile isSpace txt) f (!j, !n) ch- | j >= i = (j, n)- | ch == ' ' = (j + 1, n + 1)+ | j >= i = (j, n)+ | ch == ' ' = (j + 1, n + 1) | ch == '\t' = (j + 4, n + 1)- | otherwise = (j, n)+ | otherwise = (j, n) i = unPos indent - 1 assembleParagraph :: [Text] -> Text assembleParagraph = go where- go [] = ""- go [x] = T.dropWhileEnd isSpace x- go (x:xs) = x <> "\n" <> go xs+ go [] = ""+ go [x] = T.dropWhileEnd isSpace x+ go (x : xs) = x <> "\n" <> go xs collapseWhiteSpace :: Text -> Text collapseWhiteSpace =@@ -1084,54 +1119,55 @@ 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+ (True, False) -> (False, ch)+ (False, True) -> (True, ' ')+ (True, True) -> (True, '\0')+ g ' ' = True g '\t' = True g '\n' = True- g _ = False+ g _ = False inlineStateDel :: InlineState -> Text inlineStateDel = \case- SingleFrame x -> inlineFrameDel x+ SingleFrame x -> inlineFrameDel x DoubleFrame x y -> inlineFrameDel x <> inlineFrameDel y liftFrame :: InlineFrame -> NonEmpty Inline -> Inline liftFrame = \case- StrongFrame -> Strong- EmphasisFrame -> Emphasis- StrongFrame_ -> Strong- EmphasisFrame_ -> Emphasis- StrikeoutFrame -> Strikeout- SubscriptFrame -> Subscript+ 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 -> "~"+ EmphasisFrame -> "*"+ EmphasisFrame_ -> "_"+ StrongFrame -> "**"+ StrongFrame_ -> "__"+ StrikeoutFrame -> "~~"+ SubscriptFrame -> "~" SuperscriptFrame -> "^" replaceEof :: forall e. Show e => String -> ParseError Text e -> ParseError Text e replaceEof altLabel = \case TrivialError pos us es -> TrivialError pos (f <$> us) (E.map f es)- FancyError pos xs -> FancyError pos xs+ FancyError pos xs -> FancyError pos xs where f EndOfInput = Label (NE.fromList altLabel)- f x = x+ f x = x isEmailUri :: URI -> Maybe Text isEmailUri uri = case URI.unRText <$> uri ^. uriPath of [x] ->- if Email.isValid (TE.encodeUtf8 x) &&- (isNothing (URI.uriScheme uri) ||- URI.uriScheme uri == Just mailtoScheme)+ if Email.isValid (TE.encodeUtf8 x)+ && ( isNothing (URI.uriScheme uri)+ || URI.uriScheme uri == Just mailtoScheme+ ) then Just x else Nothing _ -> Nothing@@ -1139,8 +1175,7 @@ -- | 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 -- parser later if this is unacceptable for someone's needs.--decodeYaml :: [T.Text] -> Int -> (Either (Int,String) Aeson.Value)+decodeYaml :: [T.Text] -> Int -> (Either (Int, String) Aeson.Value) #ifdef ghcjs_HOST_OS decodeYaml _ _ = pure $ Aeson.object [] #else@@ -1148,44 +1183,43 @@ case (Yaml.decodeEither' . TE.encodeUtf8 . T.intercalate "\n") ls of Left err' -> let (moffset, err) = splitYamlError err'- in Left (maybe doffset (+ doffset) moffset, err)+ in Left (maybe doffset (+ doffset) moffset, err) Right v -> Right v -splitYamlError- :: Yaml.ParseException- -> (Maybe Int, String)+splitYamlError ::+ Yaml.ParseException ->+ (Maybe Int, String) splitYamlError = \case Yaml.NonScalarKey -> (Nothing, "non scalar key") Yaml.UnknownAlias anchor -> (Nothing, "unknown alias \"" ++ anchor ++ "\"") Yaml.UnexpectedEvent exptd unexptd ->- ( Nothing- , "unexpected event: expected " ++ show exptd- ++ ", but received " ++ show unexptd+ ( Nothing,+ "unexpected event: expected " ++ show exptd+ ++ ", but received "+ ++ show unexptd ) Yaml.InvalidYaml myerror -> case myerror of Nothing -> (Nothing, "unspecified error") Just yerror -> case yerror of Yaml.YamlException s -> (Nothing, s) Yaml.YamlParseException problem context mark ->- ( Just (Yaml.yamlIndex mark)- , case context of+ ( Just (Yaml.yamlIndex mark),+ case context of "" -> problem- _ -> context ++ ", " ++ problem+ _ -> context ++ ", " ++ problem ) Yaml.AesonException s -> (Nothing, s) Yaml.OtherParseException exc -> (Nothing, show exc) Yaml.NonStringKeyAlias anchor value ->- ( Nothing- , "non-string key alias; anchor name: " ++ anchor- ++ ", value: " ++ show value+ ( Nothing,+ "non-string key alias; anchor name: " ++ anchor+ ++ ", value: "+ ++ show value ) Yaml.CyclicIncludes -> (Nothing, "cyclic includes")-#if MIN_VERSION_yaml(0,11,1) Yaml.LoadSettingsException _ _ -> (Nothing, "loading settings exception")-#endif-#if MIN_VERSION_yaml(0,11,2) Yaml.NonStringKey _ -> (Nothing, "non string key")-#endif+ Yaml.MultipleDocuments -> (Nothing, "multiple documents") #endif emptyIspSpan :: Isp@@ -1196,20 +1230,20 @@ if getAny $ foldMap (foldMap (Any . isParagraph)) (drop 1 x :| xs) then fmap toParagraph <$> xs' else case x of- [] -> xs'- (y:ys) -> r $ (toNaked y : ys) :| xs+ [] -> xs'+ (y : ys) -> r $ (toNaked y : ys) :| xs where- (x:|xs) = r xs'+ (x :| xs) = r xs' r = NE.reverse . fmap reverse isParagraph = \case OrderedList _ _ -> False UnorderedList _ -> False- Naked _ -> False- _ -> True+ Naked _ -> False+ _ -> True toParagraph (Naked inner) = Paragraph inner- toParagraph other = other+ toParagraph other = other toNaked (Paragraph inner) = Naked inner- toNaked other = other+ toNaked other = other succeeds :: Alternative m => m () -> m Bool succeeds m = True <$ m <|> pure False@@ -1226,29 +1260,30 @@ toNesTokens = NE.fromList . T.unpack unexpEic :: MonadParsec e Text m => ErrorItem Char -> m a-unexpEic x = failure- (Just x)- (E.singleton . Label . NE.fromList $ "inline content")+unexpEic x =+ failure+ (Just x)+ (E.singleton . Label . NE.fromList $ "inline content") nes :: a -> NonEmpty a nes a = a :| [] fromRight :: Either a b -> b fromRight (Right x) = x-fromRight _ =+fromRight _ = error "Text.MMark.Parser.fromRight: the impossible happened" bakeText :: (String -> String) -> Text bakeText = T.pack . reverse . ($ []) -- | Report custom failure at specified location.--customFailure'- :: MonadParsec MMarkErr Text m- => Int- -> MMarkErr- -> m a+customFailure' ::+ MonadParsec MMarkErr Text m =>+ Int ->+ MMarkErr ->+ m a customFailure' o e =- parseError $ FancyError- o- (E.singleton (ErrorCustom e))+ parseError $+ FancyError+ o+ (E.singleton (ErrorCustom e))
Text/MMark/Parser/Internal.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}+ -- | -- Module : Text.MMark.Parser.Internal -- Copyright : © 2017–present Mark Karpov@@ -9,114 +11,119 @@ -- -- An internal module that builds a framework on which the -- "Text.MMark.Parser" module is built.--{-# LANGUAGE RankNTypes #-}- module Text.MMark.Parser.Internal ( -- * Block-level parser monad- BParser- , runBParser- , isNakedAllowed- , refLevel- , subEnv- , registerReference+ BParser,+ runBParser,+ isNakedAllowed,+ refLevel,+ subEnv,+ registerReference,+ -- * Inline-level parser monad- , IParser- , runIParser- , disallowEmpty- , isEmptyAllowed- , disallowLinks- , isLinksAllowed- , disallowImages- , isImagesAllowed- , getLastChar- , lastChar- , lookupReference- , Isp (..)- , CharType (..)+ IParser,+ runIParser,+ disallowEmpty,+ isEmptyAllowed,+ disallowLinks,+ isLinksAllowed,+ disallowImages,+ isImagesAllowed,+ getLastChar,+ lastChar,+ lookupReference,+ Isp (..),+ CharType (..),+ -- * Reference and footnote definitions- , Defs+ Defs,+ -- * Other- , MMarkErr (..) )+ MMarkErr (..),+ ) where import Control.Monad.State.Strict import Data.Bifunctor import Data.Function ((&)) import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import qualified Data.List.NonEmpty as NE import Data.Ratio ((%)) import Data.Text (Text) import Data.Text.Metrics (damerauLevenshteinNorm)-import Lens.Micro (Lens', (^.), (.~), set, over)+import Lens.Micro (Lens', over, set, (.~), (^.)) import Lens.Micro.Extras (view) import Text.MMark.Parser.Internal.Type import Text.Megaparsec hiding (State)+import qualified Text.Megaparsec as M import Text.URI (URI)-import qualified Data.HashMap.Strict as HM-import qualified Data.List.NonEmpty as NE-import qualified Text.Megaparsec as M ---------------------------------------------------------------------------- -- Block-level parser monad -- | Block-level parser type.- type BParser a = ParsecT MMarkErr Text (State BlockState) a -- | Run a computation in the 'BParser' monad.--runBParser- :: BParser a- -- ^ The parser to run- -> FilePath- -- ^ File name (only to be used in error messages), may be empty- -> Text- -- ^ Input to parse- -> Either (ParseErrorBundle Text MMarkErr) (a, Defs)- -- ^ Result of parsing+runBParser ::+ -- | The parser to run+ BParser a ->+ -- | File name (only to be used in error messages), may be empty+ FilePath ->+ -- | Input to parse+ Text ->+ -- | Result of parsing+ Either (ParseErrorBundle Text MMarkErr) (a, Defs) runBParser p file input = case runState (snd <$> runParserT' p st) initialBlockState of- (Left bundle, _) -> Left bundle+ (Left bundle, _) -> Left bundle (Right x, st') -> Right (x, st' ^. bstDefs) where st = mkInitialState file input 0 -- | Ask whether naked paragraphs are allowed in this context.- isNakedAllowed :: BParser Bool isNakedAllowed = gets (^. bstAllowNaked) -- | Lookup current reference indentation level.- refLevel :: BParser Pos refLevel = gets (^. bstRefLevel) -- | Execute 'BParser' computation with modified environment.--subEnv- :: Bool -- ^ Whether naked paragraphs should be allowed- -> Pos -- ^ Reference indentation level- -> BParser a -- ^ The parser we want to set the environment for- -> BParser a -- ^ The resulting parser+subEnv ::+ -- | Whether naked paragraphs should be allowed+ Bool ->+ -- | Reference indentation level+ Pos ->+ -- | The parser we want to set the environment for+ BParser a ->+ -- | The resulting parser+ BParser a subEnv allowNaked rlevel =- locally bstAllowNaked allowNaked .- locally bstRefLevel rlevel+ locally bstAllowNaked allowNaked+ . locally bstRefLevel rlevel -- | Register a reference (link\/image) definition.--registerReference- :: Text -- ^ Reference name- -> (URI, Maybe Text) -- ^ Reference 'URI' and optional title- -> BParser Bool -- ^ 'True' if there is a conflicting definition+registerReference ::+ -- | Reference name+ Text ->+ -- | Reference 'URI' and optional title+ (URI, Maybe Text) ->+ -- | 'True' if there is a conflicting definition+ BParser Bool registerReference = registerGeneric referenceDefs -- | A generic function for registering definitions in 'BParser'.--registerGeneric- :: Lens' Defs (HashMap DefLabel a) -- ^ How to access the definition map- -> Text -- ^ Definition name- -> a -- ^ Data- -> BParser Bool -- ^ 'True' if there is a conflicting definition+registerGeneric ::+ -- | How to access the definition map+ Lens' Defs (HashMap DefLabel a) ->+ -- | Definition name+ Text ->+ -- | Data+ a ->+ -- | 'True' if there is a conflicting definition+ BParser Bool registerGeneric l name a = do let dlabel = mkDefLabel name defs <- gets (^. bstDefs . l)@@ -130,21 +137,19 @@ -- Inline-level parser monad -- | Inline-level parser type.- type IParser a = StateT InlineState (Parsec MMarkErr Text) a -- | Run a computation in the 'IParser' monad.--runIParser- :: Defs- -- ^ Reference and footnote definitions obtained as a result of- -- block-level parsing- -> IParser a- -- ^ The parser to run- -> Isp- -- ^ Input for the parser- -> Either (ParseError Text MMarkErr) a- -- ^ Result of parsing+runIParser ::+ -- | Reference and footnote definitions obtained as a result of+ -- block-level parsing+ Defs ->+ -- | The parser to run+ IParser a ->+ -- | Input for the parser+ Isp ->+ -- | Result of parsing+ Either (ParseError Text MMarkErr) a runIParser _ _ (IspError err) = Left err runIParser defs p (IspSpan offset input) = first (NE.head . bundleErrors) (snd (runParser' (evalStateT p ist) pst))@@ -153,80 +158,69 @@ pst = mkInitialState "" input offset -- | Disallow parsing of empty inlines.- disallowEmpty :: IParser a -> IParser a disallowEmpty = locally istAllowEmpty False -- | Ask whether parsing of empty inlines is allowed.- isEmptyAllowed :: IParser Bool isEmptyAllowed = gets (view istAllowEmpty) -- | Disallow parsing of links.- disallowLinks :: IParser a -> IParser a disallowLinks = locally istAllowLinks False -- | Ask whether parsing of links is allowed.- isLinksAllowed :: IParser Bool isLinksAllowed = gets (view istAllowLinks) -- | Disallow parsing of images.- disallowImages :: IParser a -> IParser a disallowImages = locally istAllowImages False -- | Ask whether parsing of images is allowed.- isImagesAllowed :: IParser Bool isImagesAllowed = gets (view istAllowImages) -- | Get type of the last parsed character.- getLastChar :: IParser CharType getLastChar = gets (view istLastChar) -- | Register type of the last parsed character.- lastChar :: CharType -> IParser () lastChar = modify' . set istLastChar {-# INLINE lastChar #-} -- | Lookup a link\/image reference definition.--lookupReference- :: Text- -- ^ Reference name- -> IParser (Either [Text] (URI, Maybe Text))- -- ^ A collection of suggested reference names in 'Left' (typo- -- corrections) or the requested definition in 'Right'+lookupReference ::+ -- | Reference name+ Text ->+ -- | A collection of suggested reference names in 'Left' (typo+ -- corrections) or the requested definition in 'Right'+ IParser (Either [Text] (URI, Maybe Text)) lookupReference = lookupGeneric referenceDefs -- | A generic function for looking up definition in 'IParser'.--lookupGeneric- :: Lens' Defs (HashMap DefLabel a)- -- ^ How to access the definition map- -> Text- -- ^ Definition name- -> IParser (Either [Text] a)- -- ^ A collection of suggested reference names in 'Left' (typo- -- corrections) or the requested definition in 'Right'+lookupGeneric ::+ -- | How to access the definition map+ Lens' Defs (HashMap DefLabel a) ->+ -- | Definition name+ Text ->+ -- | A collection of suggested reference names in 'Left' (typo+ -- corrections) or the requested definition in 'Right'+ IParser (Either [Text] a) lookupGeneric l name = do let dlabel = mkDefLabel name defs <- gets (view (istDefs . l)) case HM.lookup dlabel defs of Nothing -> return . Left $ closeNames dlabel (HM.keys defs)- Just x -> return (Right x)+ Just x -> return (Right x) -- | Select close enough (using the normalized Damerau-Levenshtein metric) -- definition labels.- closeNames :: DefLabel -> [DefLabel] -> [Text]-closeNames r'- = filter (\x -> damerauLevenshteinNorm r x >= (2 % 3))- . map unDefLabel+closeNames r' =+ filter (\x -> damerauLevenshteinNorm r x >= (2 % 3))+ . map unDefLabel where r = unDefLabel r' @@ -234,27 +228,30 @@ -- Helpers -- | Setup initial parser state.--mkInitialState- :: FilePath -- ^ File name to use- -> Text -- ^ Input- -> Int -- ^ Starting offset- -> M.State Text e-mkInitialState file input offset = M.State- { stateInput = input- , stateOffset = offset- , statePosState = PosState- { pstateInput = input- , pstateOffset = offset- , pstateSourcePos = initialPos file- , pstateTabWidth = mkPos 4- , pstateLinePrefix = ""+mkInitialState ::+ -- | File name to use+ FilePath ->+ -- | Input+ Text ->+ -- | Starting offset+ Int ->+ M.State Text e+mkInitialState file input offset =+ M.State+ { stateInput = input,+ stateOffset = offset,+ statePosState =+ PosState+ { pstateInput = input,+ pstateOffset = offset,+ pstateSourcePos = initialPos file,+ pstateTabWidth = mkPos 4,+ pstateLinePrefix = ""+ },+ stateParseErrors = [] }- , stateParseErrors = []- } -- | Locally change state in a state monad and then restore it back.- locally :: MonadState s m => Lens' s a -> a -> m b -> m b locally l x m = do y <- gets (^. l)
Text/MMark/Parser/Internal/Type.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+ -- | -- Module : Text.MMark.Parser.Internal.Type -- Copyright : © 2017–present Mark Karpov@@ -8,165 +14,152 @@ -- Portability : portable -- -- Types for the internal helper definitions for the parser.--{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TemplateHaskell #-}- module Text.MMark.Parser.Internal.Type ( -- * Block-level parser state- BlockState- , initialBlockState- , bstAllowNaked- , bstRefLevel- , bstDefs+ BlockState,+ initialBlockState,+ bstAllowNaked,+ bstRefLevel,+ bstDefs,+ -- * Inline-level parser state- , InlineState- , initialInlineState- , istLastChar- , istAllowEmpty- , istAllowLinks- , istAllowImages- , istDefs- , Isp (..)- , CharType (..)+ InlineState,+ initialInlineState,+ istLastChar,+ istAllowEmpty,+ istAllowLinks,+ istAllowImages,+ istDefs,+ Isp (..),+ CharType (..),+ -- * Reference and footnote definitions- , Defs- , referenceDefs- , DefLabel- , mkDefLabel- , unDefLabel+ Defs,+ referenceDefs,+ DefLabel,+ mkDefLabel,+ unDefLabel,+ -- * Other- , MMarkErr (..) )+ MMarkErr (..),+ ) where import Control.DeepSeq import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI import Data.Data (Data) import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM import Data.Hashable (Hashable) import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Data.Proxy import Data.Text (Text)+import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics import Lens.Micro.TH import Text.Megaparsec import Text.URI (URI)-import qualified Data.CaseInsensitive as CI-import qualified Data.HashMap.Strict as HM-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup ((<>))-#endif- ---------------------------------------------------------------------------- -- Block-level parser state -- | Block-level parser state.- data BlockState = BlockState- { _bstAllowNaked :: Bool- -- ^ Should we consider a paragraph that does not end with a blank line+ { -- | Should we consider a paragraph that does not end with a blank line -- 'Naked'? It does not make sense to do so for top-level document, but -- in lists, 'Naked' text is pretty common.- , _bstRefLevel :: Pos- -- ^ Current reference level: 1 column for top-level of document, column+ _bstAllowNaked :: Bool,+ -- | Current reference level: 1 column for top-level of document, column -- where content starts for block quotes and lists.- , _bstDefs :: Defs- -- ^ Reference and footnote definitions+ _bstRefLevel :: Pos,+ -- | Reference and footnote definitions+ _bstDefs :: Defs } -- | Initial value for 'BlockState'.- initialBlockState :: BlockState-initialBlockState = BlockState- { _bstAllowNaked = False- , _bstRefLevel = pos1- , _bstDefs = emptyDefs- }+initialBlockState =+ BlockState+ { _bstAllowNaked = False,+ _bstRefLevel = pos1,+ _bstDefs = emptyDefs+ } ---------------------------------------------------------------------------- -- Inline-level parser state -- | Inline-level parser state.- data InlineState = InlineState- { _istLastChar :: !CharType- -- ^ Type of the last encountered character- , _istAllowEmpty :: Bool- -- ^ Whether to allow empty inlines- , _istAllowLinks :: Bool- -- ^ Whether to allow parsing of links- , _istAllowImages :: Bool- -- ^ Whether to allow parsing of images- , _istDefs :: Defs- -- ^ Reference link definitions+ { -- | Type of the last encountered character+ _istLastChar :: !CharType,+ -- | Whether to allow empty inlines+ _istAllowEmpty :: Bool,+ -- | Whether to allow parsing of links+ _istAllowLinks :: Bool,+ -- | Whether to allow parsing of images+ _istAllowImages :: Bool,+ -- | Reference link definitions+ _istDefs :: Defs } -- | Initial value for 'InlineState'.- initialInlineState :: InlineState-initialInlineState = InlineState- { _istLastChar = SpaceChar- , _istAllowEmpty = True- , _istAllowLinks = True- , _istAllowImages = True- , _istDefs = emptyDefs- }+initialInlineState =+ InlineState+ { _istLastChar = SpaceChar,+ _istAllowEmpty = True,+ _istAllowLinks = True,+ _istAllowImages = True,+ _istDefs = emptyDefs+ } -- | 'Inline' source pending parsing.- data Isp- = IspSpan Int Text- -- ^ We have an inline source pending parsing- | IspError (ParseError Text MMarkErr)- -- ^ We should just return this parse error+ = -- | We have an inline source pending parsing+ IspSpan Int Text+ | -- | We should just return this parse error+ IspError (ParseError Text MMarkErr) deriving (Eq, Show) -- | Type of the last seen character.- data CharType- = SpaceChar -- ^ White space or a transparent character- | PunctChar -- ^ Punctuation character- | OtherChar -- ^ Other character+ = -- | White space or a transparent character+ SpaceChar+ | -- | Punctuation character+ PunctChar+ | -- | Other character+ OtherChar deriving (Eq, Ord, Show) ---------------------------------------------------------------------------- -- Reference and footnote definitions -- | An opaque container for reference and footnote definitions.- newtype Defs = Defs- { _referenceDefs :: HashMap DefLabel (URI, Maybe Text)- -- ^ Reference definitions containing a 'URI' and optionally title+ { -- | Reference definitions containing a 'URI' and optionally title+ _referenceDefs :: HashMap DefLabel (URI, Maybe Text) } -- | Empty 'Defs'.- emptyDefs :: Defs-emptyDefs = Defs- { _referenceDefs = HM.empty- }+emptyDefs =+ Defs+ { _referenceDefs = HM.empty+ } -- | An opaque type for definition label.- newtype DefLabel = DefLabel (CI Text) deriving (Eq, Ord, Hashable) -- | Smart constructor for the 'DefLabel' type.- mkDefLabel :: Text -> DefLabel mkDefLabel = DefLabel . CI.mk . T.unwords . T.words -- | Extract 'Text' value from a 'DefLabel'.- unDefLabel :: DefLabel -> Text unDefLabel (DefLabel x) = CI.original x @@ -174,38 +167,37 @@ -- Other -- | MMark custom parse errors.- data MMarkErr- = YamlParseError String- -- ^ YAML error that occurred during parsing of a YAML block- | NonFlankingDelimiterRun (NonEmpty Char)- -- ^ This delimiter run should be in left- or right- flanking position- | ListStartIndexTooBig Word- -- ^ Ordered list start numbers must be nine digits or less+ = -- | YAML error that occurred during parsing of a YAML block+ YamlParseError String+ | -- | This delimiter run should be in left- or right- flanking position+ NonFlankingDelimiterRun (NonEmpty Char)+ | -- | Ordered list start numbers must be nine digits or less -- -- @since 0.0.2.0- | ListIndexOutOfOrder Word Word- -- ^ The index in an ordered list is out of order, first number is the+ 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 -- -- @since 0.0.2.0- | DuplicateReferenceDefinition Text- -- ^ Duplicate reference definitions are not allowed+ ListIndexOutOfOrder Word Word+ | -- | Duplicate reference definitions are not allowed -- -- @since 0.0.3.0- | CouldNotFindReferenceDefinition Text [Text]- -- ^ Could not find this reference definition, the second argument is+ DuplicateReferenceDefinition Text+ | -- | Could not find this reference definition, the second argument is -- the collection of close names (typo corrections) -- -- @since 0.0.3.0- | InvalidNumericCharacter Int- -- ^ This numeric character is invalid+ CouldNotFindReferenceDefinition Text [Text]+ | -- | This numeric character is invalid -- -- @since 0.0.3.0- | UnknownHtmlEntityName Text- -- ^ Unknown HTML5 entity name+ InvalidNumericCharacter Int+ | -- | Unknown HTML5 entity name -- -- @since 0.0.3.0+ UnknownHtmlEntityName Text deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) instance ShowErrorComponent MMarkErr where@@ -223,14 +215,18 @@ ++ show expected DuplicateReferenceDefinition name -> "duplicate reference definitions are not allowed: \""- ++ T.unpack name ++ "\""+ ++ T.unpack name+ ++ "\"" CouldNotFindReferenceDefinition name alts -> "could not find a matching reference definition for \""- ++ T.unpack name ++ "\""+ ++ T.unpack name+ ++ "\"" ++ case NE.nonEmpty alts of- Nothing -> ""- Just xs -> "\nperhaps you meant "- ++ orList (quote . T.unpack <$> xs) ++ "?"+ Nothing -> ""+ Just xs ->+ "\nperhaps you meant "+ ++ orList (quote . T.unpack <$> xs)+ ++ "?" where quote x = "\"" ++ x ++ "\"" InvalidNumericCharacter n ->@@ -242,11 +238,10 @@ -- | Print a pretty list where items are separated with commas and the word -- “or” according to the rules of English punctuation.- orList :: NonEmpty String -> String-orList (x:|[]) = x-orList (x:|[y]) = x <> " or " <> y-orList xs = intercalate ", " (NE.init xs) <> ", or " <> NE.last xs+orList (x :| []) = x+orList (x :| [y]) = x <> " or " <> y+orList xs = intercalate ", " (NE.init xs) <> ", or " <> NE.last xs ---------------------------------------------------------------------------- -- Lens TH
Text/MMark/Render.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+ -- | -- Module : Text.MMark.Render -- Copyright : © 2017–present Mark Karpov@@ -8,13 +12,9 @@ -- Portability : portable -- -- MMark rendering machinery.--{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}- module Text.MMark.Render- ( render )+ ( render,+ ) where import Control.Arrow@@ -22,13 +22,13 @@ import Data.Char (isSpace) import Data.Function (fix) import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T import Lucid import Text.MMark.Trans import Text.MMark.Type import Text.MMark.Util-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T-import qualified Text.URI as URI+import qualified Text.URI as URI -- | Render a 'MMark' markdown document. You can then render @'Html' ()@ to -- various things:@@ -36,59 +36,54 @@ -- * to lazy 'Data.Taxt.Lazy.Text' with 'renderText' -- * to lazy 'Data.ByteString.Lazy.ByteString' with 'renderBS' -- * directly to file with 'renderToFile'- render :: MMark -> Html () render MMark {..} = mapM_ rBlock mmarkBlocks where Extension {..} = mmarkExtension- rBlock- = applyBlockRender extBlockRender- . fmap rInlines- . applyBlockTrans extBlockTrans- rInlines- = (mkOisInternal &&& mapM_ (applyInlineRender extInlineRender))- . fmap (applyInlineTrans extInlineTrans)+ rBlock =+ applyBlockRender extBlockRender+ . fmap rInlines+ . applyBlockTrans extBlockTrans+ rInlines =+ (mkOisInternal &&& mapM_ (applyInlineRender extInlineRender))+ . fmap (applyInlineTrans extInlineTrans) -- | Apply a 'Render' to a given @'Block' 'Html' ()@.--applyBlockRender- :: Render (Block (Ois, Html ()))- -> Block (Ois, Html ())- -> Html ()+applyBlockRender ::+ Render (Block (Ois, Html ())) ->+ Block (Ois, Html ()) ->+ Html () applyBlockRender r = fix (runRender r . defaultBlockRender) --- | The default 'Block' render. Note that it does not care about what we--- have rendered so far because it always starts rendering. Thus it's OK to--- just pass it something dummy as the second argument of the inner--- function.--defaultBlockRender- :: (Block (Ois, Html ()) -> Html ())- -- ^ Rendering function to use to render sub-blocks- -> Block (Ois, Html ()) -> Html ()+-- | The default 'Block' render.+defaultBlockRender ::+ -- | Rendering function to use to render sub-blocks+ (Block (Ois, Html ()) -> Html ()) ->+ Block (Ois, Html ()) ->+ Html () defaultBlockRender blockRender = \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 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)@@ -131,22 +126,20 @@ mkId ois = [(id_ . headerId . getOis) ois] alignStyle = \case CellAlignDefault -> []- CellAlignLeft -> [style_ "text-align:left"]- CellAlignRight -> [style_ "text-align:right"]- CellAlignCenter -> [style_ "text-align:center"]+ CellAlignLeft -> [style_ "text-align:left"]+ CellAlignRight -> [style_ "text-align:right"]+ CellAlignCenter -> [style_ "text-align:center"] -- | Apply a render to a given 'Inline'.- applyInlineRender :: Render Inline -> Inline -> Html () applyInlineRender r = fix (runRender r . defaultInlineRender) --- | The default render for 'Inline' elements. Comments about--- 'defaultBlockRender' apply here just as well.--defaultInlineRender- :: (Inline -> Html ())- -- ^ Rendering function to use to render sub-inlines- -> Inline -> Html ()+-- | The default render for 'Inline' elements.+defaultInlineRender ::+ -- | Rendering function to use to render sub-inlines+ (Inline -> Html ()) ->+ Inline ->+ Html () defaultInlineRender inlineRender = \case Plain txt -> toHtml txt@@ -166,12 +159,11 @@ code_ (toHtml txt) Link inner dest mtitle -> let title = maybe [] (pure . title_) mtitle- in a_ (href_ (URI.render dest) : title) (mapM_ inlineRender inner)+ in a_ (href_ (URI.render dest) : title) (mapM_ inlineRender inner) Image desc src mtitle -> let title = maybe [] (pure . title_) mtitle- in img_ (alt_ (asPlainText desc) : src_ (URI.render src) : title)+ in img_ (alt_ (asPlainText desc) : src_ (URI.render src) : title) -- | HTML containing a newline.- newline :: Html () newline = "\n"
Text/MMark/Trans.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ -- | -- Module : Text.MMark.Trans -- Copyright : © 2017–present Mark Karpov@@ -8,40 +10,36 @@ -- Portability : portable -- -- MMark block\/inline transformation helpers.--{-# LANGUAGE LambdaCase #-}- module Text.MMark.Trans- ( applyBlockTrans- , applyInlineTrans )+ ( applyBlockTrans,+ applyInlineTrans,+ ) where import Data.Monoid hiding ((<>)) import Text.MMark.Type -- | Apply block transformation in the @'Endo' 'Bni'@ form to a block 'Bni'.- applyBlockTrans :: Endo Bni -> Bni -> Bni applyBlockTrans trans@(Endo f) = \case- Blockquote xs -> f (Blockquote (s xs))+ Blockquote xs -> f (Blockquote (s xs)) OrderedList w xs -> f (OrderedList w (s <$> xs)) UnorderedList xs -> f (UnorderedList (s <$> xs))- other -> f other+ other -> f other where s = fmap (applyBlockTrans trans) -- | Apply inline transformation in the @'Endo' 'Inline'@ form to an -- 'Inline'.- 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)+ 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+ other -> f other where s = fmap (applyInlineTrans trans)
Text/MMark/Type.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+ -- | -- Module : Text.MMark.Type -- Copyright : © 2017–present Mark Karpov@@ -9,24 +15,18 @@ -- -- Internal type definitions. Some of these are re-exported in the public -- modules.--{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}- module Text.MMark.Type- ( MMark (..)- , Extension (..)- , Render (..)- , Bni- , Block (..)- , CellAlign (..)- , Inline (..)- , Ois- , mkOisInternal- , getOis )+ ( MMark (..),+ Extension (..),+ Render (..),+ Bni,+ Block (..),+ CellAlign (..),+ Inline (..),+ Ois,+ mkOisInternal,+ getOis,+ ) where import Control.DeepSeq@@ -44,14 +44,13 @@ -- | Representation of 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- { mmarkYaml :: Maybe Value- -- ^ Parsed YAML document at the beginning (optional)- , mmarkBlocks :: [Bni]- -- ^ Actual contents of the document- , mmarkExtension :: Extension- -- ^ Extension specifying how to process and render the blocks+ { -- | 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 } instance NFData MMark where@@ -60,7 +59,6 @@ -- | Dummy instance. -- -- @since 0.0.5.0- instance Show MMark where show = const "MMark {..}" @@ -85,50 +83,51 @@ -- 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- { extBlockTrans :: Endo Bni- -- ^ Block transformation- , extBlockRender :: Render (Block (Ois, Html ()))- -- ^ Block render- , extInlineTrans :: Endo Inline- -- ^ Inline transformation- , extInlineRender :: Render Inline- -- ^ Inline render+ { -- | 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 }+ 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 }+ 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 ()@.- newtype Render a = Render- { runRender :: (a -> Html ()) -> a -> Html () }+ {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+ mempty = Render id mappend = (<>) -- | A shortcut for the frequently used type @'Block' ('NonEmpty' -- 'Inline')@.- type Bni = Block (NonEmpty Inline) -- | We can think of a markdown document as a collection of@@ -139,36 +138,34 @@ -- -- We can divide blocks into two types: container blocks, which can contain -- other blocks, and leaf blocks, which cannot.- data Block a- = ThematicBreak- -- ^ Thematic break, leaf block- | Heading1 a- -- ^ Heading (level 1), leaf block- | Heading2 a- -- ^ Heading (level 2), leaf block- | Heading3 a- -- ^ Heading (level 3), leaf block- | Heading4 a- -- ^ Heading (level 4), leaf block- | Heading5 a- -- ^ Heading (level 5), leaf block- | Heading6 a- -- ^ Heading (level 6), leaf block- | CodeBlock (Maybe Text) Text- -- ^ Code block, leaf block with info string and contents- | Naked a- -- ^ Naked content, without an enclosing tag- | Paragraph a- -- ^ Paragraph, leaf block- | Blockquote [Block a]- -- ^ Blockquote container block- | OrderedList Word (NonEmpty [Block a])- -- ^ Ordered list ('Word' is the start index), container block- | UnorderedList (NonEmpty [Block a])- -- ^ Unordered list, container block- | Table (NonEmpty CellAlign) (NonEmpty (NonEmpty a))- -- ^ Table, first argument is the alignment options, then we have a+ = -- | Thematic break, leaf block+ ThematicBreak+ | -- | Heading (level 1), leaf block+ Heading1 a+ | -- | Heading (level 2), leaf block+ Heading2 a+ | -- | Heading (level 3), leaf block+ Heading3 a+ | -- | Heading (level 4), leaf block+ Heading4 a+ | -- | Heading (level 5), leaf block+ Heading5 a+ | -- | Heading (level 6), leaf block+ Heading6 a+ | -- | Code block, leaf block with info string and contents+ CodeBlock (Maybe Text) Text+ | -- | Naked content, without an enclosing tag+ Naked a+ | -- | Paragraph, leaf block+ Paragraph a+ | -- | Blockquote container block+ Blockquote [Block a]+ | -- | Ordered list ('Word' is the start index), container block+ OrderedList Word (NonEmpty [Block a])+ | -- | Unordered list, container block+ UnorderedList (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. --@@ -176,6 +173,7 @@ -- 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) instance NFData a => NFData (Block a)@@ -183,39 +181,41 @@ -- | Options for cell alignment in tables. -- -- @since 0.0.4.0- data CellAlign- = CellAlignDefault -- ^ No specific alignment specified- | CellAlignLeft -- ^ Left-alignment- | CellAlignRight -- ^ Right-alignment- | CellAlignCenter -- ^ Center-alignment+ = -- | No specific alignment specified+ CellAlignDefault+ | -- | Left-alignment+ CellAlignLeft+ | -- | Right-alignment+ CellAlignRight+ | -- | Center-alignment+ CellAlignCenter deriving (Show, Eq, Ord, Data, Typeable, Generic) instance NFData CellAlign -- | Inline markdown content.- data Inline- = Plain Text- -- ^ Plain text- | LineBreak- -- ^ Line break (hard)- | Emphasis (NonEmpty Inline)- -- ^ Emphasis- | Strong (NonEmpty Inline)- -- ^ Strong emphasis- | Strikeout (NonEmpty Inline)- -- ^ Strikeout- | Subscript (NonEmpty Inline)- -- ^ Subscript- | Superscript (NonEmpty Inline)- -- ^ Superscript- | CodeSpan Text- -- ^ Code span- | Link (NonEmpty Inline) URI (Maybe Text)- -- ^ Link with text, destination, and optionally title- | Image (NonEmpty Inline) URI (Maybe Text)- -- ^ Image with description, URL, and optionally title+ = -- | Plain text+ Plain Text+ | -- | Line break (hard)+ LineBreak+ | -- | Emphasis+ Emphasis (NonEmpty Inline)+ | -- | Strong emphasis+ Strong (NonEmpty Inline)+ | -- | Strikeout+ Strikeout (NonEmpty Inline)+ | -- | Subscript+ Subscript (NonEmpty Inline)+ | -- | Superscript+ Superscript (NonEmpty Inline)+ | -- | Code span+ CodeSpan Text+ | -- | Link with text, destination, and optionally title+ Link (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) instance NFData Inline@@ -225,16 +225,13 @@ -- render, but only for inspection. Altering of 'Ois' is not possible -- because the user cannot construct a value of the 'Ois' type, he\/she can -- only inspect it with 'getOis'.- newtype Ois = Ois (NonEmpty Inline) -- | Make an 'Ois' value. This is an internal constructor that should not be -- exposed!- mkOisInternal :: NonEmpty Inline -> Ois mkOisInternal = Ois -- | Project @'NonEmpty' 'Inline'@ from 'Ois'.- getOis :: Ois -> NonEmpty Inline getOis (Ois inlines) = inlines
Text/MMark/Util.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+ -- | -- Module : Text.MMark.Util -- Copyright : © 2017–present Mark Karpov@@ -8,60 +11,57 @@ -- Portability : portable -- -- Internal utilities.--{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}- module Text.MMark.Util- ( asPlainText- , headerId- , headerFragment )+ ( asPlainText,+ headerId,+ headerFragment,+ ) where -import Data.Char (isSpace, isAlphaNum)+import Data.Char (isAlphaNum, isSpace) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)+import qualified Data.Text as T import Text.MMark.Type import Text.URI (URI (..))-import qualified Data.Text as T-import qualified Text.URI as URI+import qualified Text.URI as URI -- | Convert a non-empty collection of 'Inline's into their plain text -- representation. This is used e.g. to render image descriptions.- 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+ 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+ 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. -- -- See also: 'headerFragment'.- headerId :: NonEmpty Inline -> Text-headerId = T.intercalate "-"- . T.words- . T.filter (\x -> isAlphaNum x || isSpace x)- . T.toLower- . asPlainText+headerId =+ T.intercalate "-"+ . T.words+ . T.filter (\x -> isAlphaNum x || isSpace x)+ . T.toLower+ . asPlainText -- | Generate a 'URI' containing only a fragment from its textual -- representation. Useful for getting URL from id of a header.- headerFragment :: Text -> URI-headerFragment fragment = URI- { uriScheme = Nothing- , uriAuthority = Left False- , uriPath = Nothing- , uriQuery = []- , uriFragment = URI.mkFragment fragment }+headerFragment fragment =+ URI+ { uriScheme = Nothing,+ uriAuthority = Left False,+ uriPath = Nothing,+ uriQuery = [],+ uriFragment = URI.mkFragment fragment+ }
bench/memory/Main.hs view
@@ -1,8 +1,8 @@ module Main (main) where -import Weigh import qualified Data.Text.IO as T-import qualified Text.MMark as MMark+import qualified Text.MMark as MMark+import Weigh main :: IO () main = mainWith $ do@@ -23,10 +23,11 @@ ---------------------------------------------------------------------------- -- Helpers -bparser- :: FilePath -- ^ File from which the input has been loaded- -> Weigh ()+bparser ::+ -- | File from which the input has been loaded+ FilePath ->+ Weigh () bparser path = action name (p <$> T.readFile path) where name = "with file: " ++ path- p = MMark.parse path+ p = MMark.parse path
bench/speed/Main.hs view
@@ -2,31 +2,33 @@ import Criterion.Main import qualified Data.Text.IO as T-import qualified Text.MMark as MMark+import qualified Text.MMark as MMark main :: IO ()-main = defaultMain- [ bparser "data/bench-yaml-block.md"- , bparser "data/bench-thematic-break.md"- , bparser "data/bench-heading.md"- , bparser "data/bench-fenced-code-block.md"- , bparser "data/bench-indented-code-block.md"- , bparser "data/bench-intensive-emphasis.md"- , bparser "data/bench-unordered-list.md"- , bparser "data/bench-ordered-list.md"- , bparser "data/bench-blockquote.md"- , bparser "data/bench-paragraph.md"- , bparser "data/table.md"- , bparser "data/comprehensive.md"- ]+main =+ defaultMain+ [ bparser "data/bench-yaml-block.md",+ bparser "data/bench-thematic-break.md",+ bparser "data/bench-heading.md",+ bparser "data/bench-fenced-code-block.md",+ bparser "data/bench-indented-code-block.md",+ bparser "data/bench-intensive-emphasis.md",+ bparser "data/bench-unordered-list.md",+ bparser "data/bench-ordered-list.md",+ bparser "data/bench-blockquote.md",+ bparser "data/bench-paragraph.md",+ bparser "data/table.md",+ bparser "data/comprehensive.md"+ ] ---------------------------------------------------------------------------- -- Helpers -bparser- :: FilePath -- ^ File from which to load parser's input- -> Benchmark+bparser ::+ -- | File from which to load parser's input+ FilePath ->+ Benchmark bparser path = env (T.readFile path) (bench name . nf p) where name = "with file: " ++ path- p = MMark.parse path+ p = MMark.parse path
data/comprehensive.html view
@@ -9,7 +9,7 @@ Vestibulum nec ornare leo. Cras pharetra, ex sed dapibus pretium, diam lectus accumsan enim, at malesuada tellus lorem et orci. Sed condimentum varius ex in mollis.</p>-<p><a href="https://example.org/">https://example.org/</a></p>+<p><a href="https://example.org">https://example.org</a></p> <p>Ut in imperdiet neque. Etiam iaculis rhoncus nisl vel porta. Praesent velit orci, laoreet suscipit bibendum eu, ornare et orci. Fusce feugiat, felis a vehicula pulvinar, nulla purus dictum arcu, et varius urna purus et nibh.@@ -29,7 +29,7 @@ risus. Maecenas vehicula, leo vitae semper tristique, libero urna consectetur massa, eget pharetra magna est nec massa. Vestibulum malesuada lobortis lacinia.</p>-<p><img src="https://example.org/image.png" alt="My image"></p>+<p><img alt="My image" src="https://example.org/image.png"></p> <p>Phasellus tincidunt metus quam, vel mollis turpis ultrices et. Phasellus consequat diam eu turpis sollicitudin tempus. Fusce suscipit bibendum nisl, quis rutrum eros volutpat in. Fusce tempor nisi eu ligula volutpat, eu
mmark.cabal view
@@ -1,131 +1,156 @@-name: mmark-version: 0.0.7.2-cabal-version: 1.18-tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1-license: BSD3-license-file: LICENSE.md-author: Mark Karpov <markkarpov92@gmail.com>-maintainer: Mark Karpov <markkarpov92@gmail.com>-homepage: https://github.com/mmark-md/mmark-bug-reports: https://github.com/mmark-md/mmark/issues-category: Text-synopsis: Strict markdown processor for writers-build-type: Simple-description: Strict markdown processor for writers.-extra-doc-files: CHANGELOG.md- , README.md-data-files: data/*.md- , data/*.html+cabal-version: 1.18+name: mmark+version: 0.0.7.3+license: BSD3+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+author: Mark Karpov <markkarpov92@gmail.com>+tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1+homepage: https://github.com/mmark-md/mmark+bug-reports: https://github.com/mmark-md/mmark/issues+synopsis: Strict markdown processor for writers+description: Strict markdown processor for writers.+category: Text+build-type: Simple+data-files:+ data/*.md+ data/*.html +extra-doc-files:+ CHANGELOG.md+ README.md+ source-repository head- type: git- location: https://github.com/mmark-md/mmark.git+ type: git+ location: https://github.com/mmark-md/mmark.git flag dev- description: Turn on development settings.- manual: True- default: False+ description: Turn on development settings.+ default: False+ manual: True library- build-depends: aeson >= 0.11 && < 1.5- , base >= 4.11 && < 5.0- , case-insensitive >= 1.2 && < 1.3- , containers >= 0.5 && < 0.7- , deepseq >= 1.3 && < 1.5- , dlist >= 0.8 && < 0.9- , email-validate >= 2.2 && < 2.4- , foldl >= 1.2 && < 1.5- , hashable >= 1.0.1.1 && < 1.4- , html-entity-map >= 0.1 && < 0.2- , lucid >= 2.6 && < 3.0- , megaparsec >= 8.0 && < 9.0- , microlens >= 0.4 && < 0.5- , microlens-th >= 0.4 && < 0.5- , modern-uri >= 0.3 && < 0.4- , mtl >= 2.0 && < 3.0- , parser-combinators >= 0.4 && < 2.0- , text >= 0.2 && < 1.3- , text-metrics >= 0.3 && < 0.4- , unordered-containers >= 0.2.5 && < 0.3- if !impl(ghcjs)- build-depends: yaml >= 0.8.10 && < 0.12- exposed-modules: Text.MMark- , Text.MMark.Extension- other-modules: Text.MMark.Parser- , Text.MMark.Parser.Internal- , Text.MMark.Parser.Internal.Type- , Text.MMark.Render- , Text.MMark.Trans- , Text.MMark.Type- , Text.MMark.Util- if flag(dev)- ghc-options: -O0 -Wall -Werror- else- ghc-options: -O2 -Wall- if flag(dev)- ghc-options: -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wnoncanonical-monad-instances- if impl(ghcjs)- ghcjs-options: +RTS -K1G -RTS -Wall+ exposed-modules:+ Text.MMark+ Text.MMark.Extension - default-language: Haskell2010+ other-modules:+ Text.MMark.Parser+ Text.MMark.Parser.Internal+ Text.MMark.Parser.Internal.Type+ Text.MMark.Render+ Text.MMark.Trans+ Text.MMark.Type+ Text.MMark.Util + default-language: Haskell2010+ build-depends:+ aeson >=0.11 && <1.6,+ base >=4.13 && <5.0,+ case-insensitive >=1.2 && <1.3,+ containers >=0.5 && <0.7,+ deepseq >=1.3 && <1.5,+ dlist >=0.8 && <2.0,+ email-validate >=2.2 && <2.4,+ foldl >=1.2 && <1.5,+ hashable >=1.0.1.1 && <1.4,+ html-entity-map >=0.1 && <0.2,+ lucid >=2.6 && <3.0,+ megaparsec >=8.0 && <10.0,+ microlens >=0.4 && <0.5,+ microlens-th >=0.4 && <0.5,+ modern-uri >=0.3.4 && <0.4,+ mtl >=2.0 && <3.0,+ parser-combinators >=0.4 && <2.0,+ text >=0.2 && <1.3,+ text-metrics >=0.3 && <0.4,+ unordered-containers >=0.2.5 && <0.3++ if !impl(ghcjs >=0)+ build-depends: yaml >=0.11.5 && <0.12++ if flag(dev)+ ghc-options: -O0 -Wall -Werror++ else+ ghc-options: -O2 -Wall++ if flag(dev)+ ghc-options:+ -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances++ if impl(ghcjs >=0)+ ghcjs-options: +RTS -K1G -RTS -Wall+ test-suite tests- main-is: Spec.hs- hs-source-dirs: tests- type: exitcode-stdio-1.0- build-depends: QuickCheck >= 2.4 && < 3.0- , aeson >= 0.11 && < 1.5- , base >= 4.11 && < 5.0- , foldl >= 1.2 && < 1.5- , hspec >= 2.0 && < 3.0- , hspec-megaparsec >= 2.0 && < 3.0- , lucid >= 2.6 && < 3.0- , megaparsec >= 8.0 && < 9.0- , mmark- , modern-uri >= 0.3 && < 0.4- , text >= 0.2 && < 1.3- other-modules: Text.MMarkSpec- , Text.MMark.ExtensionSpec- , Text.MMark.TestUtils- if flag(dev)- ghc-options: -O0 -Wall -Werror- else- ghc-options: -O2 -Wall- if impl(ghcjs)- ghcjs-options: -O0 +RTS -K1G -M5G -RTS -Wall -Wwarn=missing-home-modules- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ other-modules:+ Text.MMarkSpec+ Text.MMark.ExtensionSpec+ Text.MMark.TestUtils + default-language: Haskell2010+ build-depends:+ QuickCheck >=2.4 && <3.0,+ aeson >=0.11 && <1.6,+ base >=4.13 && <5.0,+ foldl >=1.2 && <1.5,+ hspec >=2.0 && <3.0,+ hspec-megaparsec >=2.0 && <3.0,+ lucid >=2.6 && <3.0,+ megaparsec >=8.0 && <10.0,+ mmark,+ modern-uri >=0.3 && <0.4,+ text >=0.2 && <1.3++ if flag(dev)+ ghc-options: -O0 -Wall -Werror++ else+ ghc-options: -O2 -Wall++ if impl(ghcjs >=0)+ ghcjs-options: -O0 +RTS -K1G -M5G -RTS -Wall -Wwarn=missing-home-modules+ benchmark bench-speed- main-is: Main.hs- hs-source-dirs: bench/speed- type: exitcode-stdio-1.0- build-depends: base >= 4.11 && < 5.0- , criterion >= 0.6.2.1 && < 1.6- , mmark- , text >= 0.2 && < 1.3- if flag(dev)- ghc-options: -O2 -Wall -Werror- else- ghc-options: -O2 -Wall- if impl(ghcjs)- ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench/speed+ default-language: Haskell2010+ build-depends:+ base >=4.13 && <5.0,+ criterion >=0.6.2.1 && <1.6,+ mmark,+ text >=0.2 && <1.3 + if flag(dev)+ ghc-options: -O2 -Wall -Werror++ else+ ghc-options: -O2 -Wall++ if impl(ghcjs >=0)+ ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules+ benchmark bench-memory- main-is: Main.hs- hs-source-dirs: bench/memory- type: exitcode-stdio-1.0- build-depends: base >= 4.11 && < 5.0- , mmark- , text >= 0.2 && < 1.3- , weigh >= 0.0.4- if flag(dev)- ghc-options: -O2 -Wall -Werror- else- ghc-options: -O2 -Wall- if impl(ghcjs)- ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench/memory+ default-language: Haskell2010+ build-depends:+ base >=4.13 && <5.0,+ mmark,+ text >=0.2 && <1.3,+ weigh >=0.0.4++ if flag(dev)+ ghc-options: -O2 -Wall -Werror++ else+ ghc-options: -O2 -Wall++ if impl(ghcjs >=0)+ ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules
tests/Text/MMark/ExtensionSpec.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.MMark.ExtensionSpec (spec) where import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)+import qualified Data.Text as T+import qualified Lucid as L import Test.Hspec import Test.QuickCheck+import qualified Text.MMark as MMark import Text.MMark.Extension (Block (..), Inline (..))-import Text.MMark.TestUtils-import qualified Data.Text as T-import qualified Lucid as L-import qualified Text.MMark as MMark import qualified Text.MMark.Extension as Ext-import qualified Text.URI as URI+import Text.MMark.TestUtils+import qualified Text.URI as URI spec :: Spec spec = parallel $ do@@ -35,7 +35,7 @@ it "extensions can affect nested block structures" $ do doc <- mkDoc "* # Something" toText (MMark.useExtension add_h1_content doc)- `shouldBe` "<ul>\n<li>\n<h1 data-content=\"Something\" id=\"something\">Something</h1>\n</li>\n</ul>\n"+ `shouldBe` "<ul>\n<li>\n<h1 data-content=\"Something\" id=\"something\">Something</h1>\n</li>\n</ul>\n" describe "inlineTrans" $ do it "works" $ do doc <- mkDoc "# My *heading*"@@ -55,7 +55,7 @@ toText (MMark.useExtension (add_em_class "foo") doc) `shouldBe` "<p><a href=\"/url\"><em class=\"foo\">heading</em></a></p>\n" describe "asPlainText" $ do- let f x = Ext.asPlainText (x:|[])+ let f x = Ext.asPlainText (x :| []) context "with Plain" $ it "works" $ property $ \txt ->@@ -97,18 +97,18 @@ f (Image (Plain txt :| []) uri Nothing) `shouldBe` txt describe "headerId" $ it "works" $- Ext.headerId (Plain "Something like that":| []) `shouldBe`- "something-like-that"+ Ext.headerId (Plain "Something like that" :| [])+ `shouldBe` "something-like-that" describe "headerFragment" $ it "generates URIs with just that fragment" $ property $ \fragment -> do let uri = Ext.headerFragment fragment frag <- URI.mkFragment fragment- URI.uriScheme uri `shouldBe` Nothing+ URI.uriScheme uri `shouldBe` Nothing URI.uriAuthority uri `shouldBe` Left False- URI.uriPath uri `shouldBe` Nothing- URI.uriQuery uri `shouldBe` []- URI.uriFragment uri `shouldBe` Just frag+ URI.uriPath uri `shouldBe` Nothing+ URI.uriQuery uri `shouldBe` []+ URI.uriFragment uri `shouldBe` Just frag ---------------------------------------------------------------------------- -- Arbitrary instances@@ -120,34 +120,32 @@ -- 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+ other -> 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 -- general.- add_h1_content :: MMark.Extension add_h1_content = Ext.blockRender $ \old block -> case block of- Heading1 inner -> L.with (old (Heading1 inner))- [ L.data_ "content" (Ext.asPlainText . Ext.getOis . fst $ inner) ]- other -> old other+ Heading1 inner ->+ L.with+ (old (Heading1 inner))+ [L.data_ "content" (Ext.asPlainText . Ext.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+ other -> other -- | Add given class to all 'Emphasis' things.- add_em_class :: Text -> MMark.Extension add_em_class given = Ext.inlineRender $ \old inline -> case inline of Emphasis inner -> L.with (old (Emphasis inner)) [L.class_ given]- other -> old other+ other -> old other
tests/Text/MMark/TestUtils.hs view
@@ -1,51 +1,45 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Text.MMark.TestUtils ( -- * Document creation and rendering- mkDoc- , toText+ mkDoc,+ toText,+ -- * Parser expectations- , (~~->)- , (~->)- , (=->)- , (==->)- , (##->)+ (~~->),+ (~->),+ (=->),+ (==->),+ (##->), ) where import Control.Monad+import qualified Data.List.NonEmpty as NE import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import qualified Lucid as L import Test.Hspec import Text.MMark (MMark, MMarkErr)+import qualified Text.MMark as MMark import Text.Megaparsec-import qualified Data.List.NonEmpty as NE-import qualified Data.Text.Lazy as TL-import qualified Lucid as L-import qualified Text.MMark as MMark -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup ((<>))-#endif- ---------------------------------------------------------------------------- -- Document creation and rendering -- | Create an 'MMark' document from given input reporting an expectation -- failure if it cannot be parsed.- mkDoc :: Text -> IO MMark mkDoc input = case MMark.parse "" input of Left bundle -> do expectationFailure $- "while parsing a document, parse error(s) occurred:\n" ++- errorBundlePretty bundle+ "while parsing a document, parse error(s) occurred:\n"+ ++ errorBundlePretty bundle undefined Right x -> return x -- | Render an 'MMark' document to 'Text'.- toText :: MMark -> Text toText = TL.toStrict . L.renderText . MMark.render @@ -54,75 +48,80 @@ -- | Create an expectation that parser should fail producing a certain -- collection of 'ParseError's.- infix 2 ~~-> -(~~->)- :: Text- -- ^ Input for parser- -> [ParseError Text MMarkErr]- -- ^ Expected collection of parse errors, in order- -> Expectation+(~~->) ::+ -- | Input for parser+ Text ->+ -- | Expected collection of parse errors, in order+ [ParseError Text MMarkErr] ->+ Expectation input ~~-> errs'' = case MMark.parse "" input of- Left bundle' -> unless (bundle == bundle') . expectationFailure $- "\nthe parser is expected to fail with:\n\n" ++- errorBundlePretty bundle ++- "\nbut it failed with:\n\n" ++- errorBundlePretty bundle'- Right x -> expectationFailure $- "the parser is expected to fail, but it parsed: " ++ show (toText x)+ Left bundle' ->+ unless (bundle == bundle') . expectationFailure $+ "\nthe parser is expected to fail with:\n\n"+ ++ errorBundlePretty bundle+ ++ "\nbut it failed with:\n\n"+ ++ errorBundlePretty bundle'+ Right x ->+ expectationFailure $+ "the parser is expected to fail, but it parsed: " ++ show (toText x) where- bundle = ParseErrorBundle- { bundleErrors = NE.fromList errs''- , bundlePosState = PosState- { pstateInput = input- , pstateOffset = 0- , pstateSourcePos = initialPos ""- , pstateTabWidth = mkPos 4- , pstateLinePrefix = ""+ bundle =+ ParseErrorBundle+ { bundleErrors = NE.fromList errs'',+ bundlePosState =+ PosState+ { pstateInput = input,+ pstateOffset = 0,+ pstateSourcePos = initialPos "",+ pstateTabWidth = mkPos 4,+ pstateLinePrefix = ""+ } }- } -- | The same as @('~~->')@, but expects only one parse error.- infix 2 ~-> -(~->)- :: Text- -- ^ Input for parser- -> ParseError Text MMarkErr- -- ^ Expected parse error to compare with- -> Expectation+(~->) ::+ -- | Input for parser+ Text ->+ -- | Expected parse error to compare with+ ParseError Text MMarkErr ->+ Expectation input ~-> err = input ~~-> [err] -- | Test parser and render by specifying input for parser and expected -- output of render.- infix 2 =-> -(=->)- :: Text -- ^ Input for MMark parser- -> Text -- ^ Output of render to match against- -> Expectation+(=->) ::+ -- | Input for MMark parser+ Text ->+ -- | Output of render to match against+ Text ->+ Expectation input =-> expected = case MMark.parse "" input of- Left bundle -> expectationFailure $- "the parser is expected to succeed, but it failed with:\n" ++- errorBundlePretty bundle+ Left bundle ->+ expectationFailure $+ "the parser is expected to succeed, but it failed with:\n"+ ++ errorBundlePretty bundle Right factual -> toText factual `shouldBe` expected -- | Just like @('=->')@, but also appends newline to given input and tries -- with that as well.--infix ==->+infix 9 ==-> -(==->)- :: Text -- ^ Input for MMark parser- -> Text -- ^ Output of render to match against- -> Expectation+(==->) ::+ -- | Input for MMark parser+ Text ->+ -- | Output of render to match against+ Text ->+ Expectation input ==-> expected = do- input =-> expected+ input =-> expected mappend input "\n" =-> expected -- | Just like @('==->')@, but the expectation is set with a 'Lucid.Html'@@ -130,9 +129,10 @@ -- outputted HTML, which can cause GHCJs and GHC to output different strings -- (as Lucid uses an unordered map underneath for the attributes and GHCJs -- and GHC have different hashing functions).--(##->)- :: Text -- ^ Input for MMark parser- -> L.Html () -- ^ Lucid builder to match against- -> Expectation+(##->) ::+ -- | Input for MMark parser+ Text ->+ -- | Lucid builder to match against+ L.Html () ->+ Expectation input ##-> expected = input ==-> (TL.toStrict (L.renderText expected) <> "\n")
tests/Text/MMarkSpec.hs view
@@ -1,2134 +1,2189 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Text.MMarkSpec (spec) where--import Data.Aeson-import Data.Char-import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid-import Data.Text (Text)-import Lucid-import Test.Hspec-import Test.Hspec.Megaparsec-import Text.MMark (MMarkErr (..))-import Text.MMark.Extension (Inline (..))-import Text.MMark.TestUtils-import Text.Megaparsec (ErrorFancy (..), Stream)-import qualified Control.Foldl as L-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import qualified Text.MMark as MMark-import qualified Text.MMark.Extension as Ext---- 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:------ <http://spec.commonmark.org/0.28/>--spec :: Spec-spec = parallel $ do- describe "parse and render" $ do- context "2.2 Tabs" $ do- it "CM1" $- "\tfoo\tbaz\t\tbim" ==->- "<pre><code>foo\tbaz\t\tbim\n</code></pre>\n"- it "CM2" $- " \tfoo\tbaz\t\tbim" ==->- "<pre><code>foo\tbaz\t\tbim\n</code></pre>\n"- it "CM3" $- " a\ta\n ὐ\ta" ==->- "<pre><code>a\ta\nὐ\ta\n</code></pre>\n"- it "CM4" $- " - foo\n\n\tbar" ==->- "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- it "CM5" $- "- foo\n\n\t\tbar" ==->- "<ul>\n<li>\n<p>foo</p>\n<pre><code> bar\n</code></pre>\n</li>\n</ul>\n"- it "CM6" $- ">\t\tfoo" ==->- "<blockquote>\n<pre><code> foo\n</code></pre>\n</blockquote>\n"- it "CM7" $- "-\t\tfoo" ==->- "<ul>\n<li>\n<pre><code> foo\n</code></pre>\n</li>\n</ul>\n"- it "CM8" $- " foo\n\tbar" ==->- "<pre><code>foo\nbar\n</code></pre>\n"- it "CM9" $- " - foo\n - bar\n\t - baz" ==->- "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"- it "CM10" $- "#\tFoo" ==-> "<h1 id=\"foo\">Foo</h1>\n"- it "CM11" $- "*\t*\t*\t" ==-> "<hr>\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___" ==-> "<hr>\n<hr>\n<hr>\n"- it "CM14" $- "+++" ==-> "<p>+++</p>\n"- it "CM15" $- "===" ==-> "<p>===</p>\n"- it "CM16" $- let s = "--\n**\n__\n"- in s ~-> errFancy 3 (nonFlanking "**")- it "CM17" $- " ***\n ***\n ***" ==-> "<hr>\n<hr>\n<hr>\n"- it "CM18" $- " ***" ==-> "<pre><code>***\n</code></pre>\n"- it "CM19" $- let s = "Foo\n ***\n"- in s ~-> errFancy 8 (nonFlanking "***")- it "CM20" $- "_____________________________________" ==->- "<hr>\n"- it "CM21" $- " - - -" ==-> "<hr>\n"- it "CM22" $- " ** * ** * ** * **" ==-> "<hr>\n"- it "CM23" $- "- - - -" ==-> "<hr>\n"- it "CM24" $- "- - - - " ==-> "<hr>\n"- it "CM25" $- let s = "_ _ _ _ a\n\na------\n\n---a---\n"- in s ~-> errFancy 0 (nonFlanking "_")- it "CM26" $- " *-*" ==-> "<p><em>-</em></p>\n"- it "CM27" $- "- foo\n***\n- bar" ==->- "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"- it "CM28" $- "Foo\n***\nbar" ==->- "<p>Foo</p>\n<hr>\n<p>bar</p>\n"- it "CM29" $- "Foo\n---\nbar" ==->- "<p>Foo</p>\n<hr>\n<p>bar</p>\n"- it "CM30" $- "* Foo\n* * *\n* Bar" ==->- "<ul>\n<li>\nFoo\n</li>\n<li>\n<ul>\n<li>\n<ul>\n<li>\n\n</li>\n</ul>\n</li>\n</ul>\n</li>\n<li>\nBar\n</li>\n</ul>\n"- it "CM31" $- "- Foo\n- * * *" ==->- "<ul>\n<li>\nFoo\n</li>\n<li>\n<hr>\n</li>\n</ul>\n"- context "4.2 ATX headings" $ do- it "CM32" $- "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo" ==->- "<h1 id=\"foo\">foo</h1>\n<h2 id=\"foo\">foo</h2>\n<h3 id=\"foo\">foo</h3>\n<h4 id=\"foo\">foo</h4>\n<h5 id=\"foo\">foo</h5>\n<h6 id=\"foo\">foo</h6>\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" ==-> "<p>## foo</p>\n"- it "CM36" $- "# foo *bar* \\*baz\\*" ==-> "<h1 id=\"foo-bar-baz\">foo <em>bar</em> *baz*</h1>\n"- it "CM37" $- "# foo " ==->- "<h1 id=\"foo\">foo</h1>\n"- it "CM38" $- " ### foo\n ## foo\n # foo" ==->- "<h3 id=\"foo\">foo</h3>\n<h2 id=\"foo\">foo</h2>\n<h1 id=\"foo\">foo</h1>\n"- it "CM39" $- " # foo" ==-> "<pre><code># foo\n</code></pre>\n"- it "CM40" $- "foo\n # bar" ==-> "<p>foo\n# bar</p>\n"- it "CM41" $- "## foo ##\n ### bar ###" ==->- "<h2 id=\"foo\">foo</h2>\n<h3 id=\"bar\">bar</h3>\n"- it "CM42" $- "# foo ##################################\n##### foo ##" ==->- "<h1 id=\"foo\">foo</h1>\n<h5 id=\"foo\">foo</h5>\n"- it "CM43" $- "### foo ### " ==-> "<h3 id=\"foo\">foo</h3>\n"- it "CM44" $- "### foo ### b" ==-> "<h3 id=\"foo-b\">foo ### b</h3>\n"- it "CM45" $- "# foo#" ==-> "<h1 id=\"foo\">foo#</h1>\n"- it "CM46" $- "### foo \\###\n## foo #\\##\n# foo \\#" ==->- "<h3 id=\"foo\">foo ###</h3>\n<h2 id=\"foo\">foo ###</h2>\n<h1 id=\"foo\">foo #</h1>\n"- it "CM47" $- "****\n## foo\n****" ==->- "<hr>\n<h2 id=\"foo\">foo</h2>\n<hr>\n"- it "CM48" $- "Foo bar\n# baz\nBar foo" ==->- "<p>Foo bar</p>\n<h1 id=\"baz\">baz</h1>\n<p>Bar foo</p>\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---------" ==->- "<p>Foo <em>bar</em>\n=========</p>\n<p>Foo <em>bar</em></p>\n<hr>\n"- it "CM51" $- "Foo *bar\nbaz*\n====" ==->- "<p>Foo <em>bar\nbaz</em>\n====</p>\n"- it "CM52" $- "Foo\n-------------------------\n\nFoo\n=" ==->- "<p>Foo</p>\n<hr>\n<p>Foo\n=</p>\n"- it "CM53" $- " Foo\n---\n\n Foo\n-----\n\n Foo\n ===" ==->- "<p>Foo</p>\n<hr>\n<p>Foo</p>\n<hr>\n<p>Foo\n===</p>\n"- it "CM54" $- " Foo\n ---\n\n Foo\n---" ==->- "<pre><code>Foo\n---\n\nFoo\n</code></pre>\n<hr>\n"- it "CM55" $- "Foo\n ---- " ==->- "<p>Foo</p>\n<hr>\n"- it "CM56" $- "Foo\n ---" ==->- "<p>Foo\n---</p>\n"- it "CM57" $- "Foo\n= =\n\nFoo\n--- -" ==->- "<p>Foo\n= =</p>\n<p>Foo</p>\n<hr>\n"- it "CM58" $- "Foo \n-----" ==->- "<p>Foo</p>\n<hr>\n"- it "CM59" $- "Foo\\\n----" ==->- "<p>Foo\\</p>\n<hr>\n"- it "CM60" $- let s = "`Foo\n----\n`\n\n<a title=\"a lot\n---\nof dashes\"/>\n"- in s ~~->- [ err 4 (ueib <> etok '`' <> ecsc)- , err 11 (ueib <> etok '`' <> ecsc) ]- it "CM61" $- "> Foo\n---" ==->- "<blockquote>\n<p>Foo</p>\n</blockquote>\n<hr>\n"- it "CM62" $- "> foo\nbar\n===" ==->- "<blockquote>\n<p>foo</p>\n</blockquote>\n<p>bar\n===</p>\n"- it "CM63" $- "- Foo\n---" ==->- "<ul>\n<li>\nFoo\n</li>\n</ul>\n<hr>\n"- it "CM64" $- "Foo\nBar\n---" ==->- "<p>Foo\nBar</p>\n<hr>\n"- it "CM65" $- "---\nFoo\n---\nBar\n---\nBaz" ==->- "<p>Bar</p>\n<hr>\n<p>Baz</p>\n"- it "CM66" $- "\n====" ==->- "<p>====</p>\n"- it "CM67" $- "---\n---" ==->- "" -- thinks that it's got a YAML block- it "CM68" $- "- foo\n-----" ==->- "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n"- it "CM69" $- " foo\n---" ==->- "<pre><code>foo\n</code></pre>\n<hr>\n"- it "CM70" $- "> foo\n-----" ==->- "<blockquote>\n<p>foo</p>\n</blockquote>\n<hr>\n"- it "CM71" $- "\\> foo\n------" ==->- "<p>> foo</p>\n<hr>\n"- it "CM72" $- "Foo\n\nbar\n---\nbaz" ==->- "<p>Foo</p>\n<p>bar</p>\n<hr>\n<p>baz</p>\n"- it "CM73" $- "Foo\nbar\n\n---\n\nbaz" ==->- "<p>Foo\nbar</p>\n<hr>\n<p>baz</p>\n"- it "CM74" $- "Foo\nbar\n* * *\nbaz" ==->- "<p>Foo\nbar</p>\n<hr>\n<p>baz</p>\n"- it "CM75" $- "Foo\nbar\n\\---\nbaz" ==->- "<p>Foo\nbar\n---\nbaz</p>\n"- context "4.4 Indented code blocks" $ do- it "CM76" $- " a simple\n indented code block" ==->- "<pre><code>a simple\n indented code block\n</code></pre>\n"- it "CM77" $- " - foo\n\n bar" ==->- "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- it "CM78" $- "1. foo\n\n - bar" ==->- "<ol>\n<li>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n"- it "CM79" $- " <a/>\n *hi*\n\n - one" ==->- "<pre><code><a/>\n*hi*\n\n- one\n</code></pre>\n"- it "CM80" $- " chunk1\n\n chunk2\n \n \n \n chunk3" ==->- "<pre><code>chunk1\n\nchunk2\n\n\n\nchunk3\n</code></pre>\n"- it "CM81" $- " chunk1\n \n chunk2" ==->- "<pre><code>chunk1\n \n chunk2\n</code></pre>\n"- it "CM82" $- "Foo\n bar\n" ==->- "<p>Foo\nbar</p>\n"- it "CM83" $- " foo\nbar" ==->- "<pre><code>foo\n</code></pre>\n<p>bar</p>\n"- it "CM84" $- "# Heading\n foo\nHeading\n------\n foo\n----\n" ==->- "<h1 id=\"heading\">Heading</h1>\n<pre><code>foo\n</code></pre>\n<p>Heading</p>\n<hr>\n<pre><code>foo\n</code></pre>\n<hr>\n"- it "CM85" $- " foo\n bar" ==->- "<pre><code> foo\nbar\n</code></pre>\n"- it "CM86" $- "\n \n foo\n \n" ==->- "<pre><code>foo\n</code></pre>\n"- it "CM87" $- " foo " ==->- "<pre><code>foo \n</code></pre>\n"- context "4.5 Fenced code blocks" $ do- it "CM88" $- "```\n<\n >\n```" ==->- "<pre><code><\n >\n</code></pre>\n"- it "CM89" $- "~~~\n<\n >\n~~~" ==->- "<pre><code><\n >\n</code></pre>\n"- it "CM90" $- "``\nfoo\n``\n" ==->- "<p><code>foo</code></p>\n"- it "CM91" $- "```\naaa\n~~~\n```" ==->- "<pre><code>aaa\n~~~\n</code></pre>\n"- it "CM92" $- "~~~\naaa\n```\n~~~" ==->- "<pre><code>aaa\n```\n</code></pre>\n"- it "CM93" $- "````\naaa\n```\n``````" ==->- "<pre><code>aaa\n```\n</code></pre>\n"- it "CM94" $- "~~~~\naaa\n~~~\n~~~~" ==->- "<pre><code>aaa\n~~~\n</code></pre>\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```" ==->- "<pre><code>\n \n</code></pre>\n"- it "CM99" $- "```\n```" ==->- "<pre><code></code></pre>\n"- it "CM100" $- " ```\n aaa\naaa\n```" ==->- "<pre><code>aaa\naaa\n</code></pre>\n"- it "CM101" $- " ```\naaa\n aaa\naaa\n ```" ==->- "<pre><code>aaa\naaa\naaa\n</code></pre>\n"- it "CM102" $- " ```\n aaa\n aaa\n aaa\n ```" ==->- "<pre><code>aaa\n aaa\naaa\n</code></pre>\n"- it "CM103" $- " ```\n aaa\n ```" ==->- "<pre><code>```\naaa\n```\n</code></pre>\n"- it "CM104" $- "```\naaa\n ```" ==->- "<pre><code>aaa\n</code></pre>\n"- it "CM105" $- " ```\naaa\n ```" ==->- "<pre><code>aaa\n</code></pre>\n"- it "CM106" $- let s = "```\naaa\n ```\n"- in s ~-> err 16- (ueof <> elabel "closing code fence" <> elabel "code block content")- it "CM107" $- "``` ```\naaa" ==->- "<p><code></code>\naaa</p>\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" ==->- "<p>foo</p>\n<pre><code>bar\n</code></pre>\n<p>baz</p>\n"- it "CM110" $- "foo\n---\n~~~\nbar\n~~~\n# baz" ==->- "<p>foo</p>\n<hr>\n<pre><code>bar\n</code></pre>\n<h1 id=\"baz\">baz</h1>\n"- it "CM111" $- "```ruby\ndef foo(x)\n return 3\nend\n```" ==->- "<pre><code class=\"language-ruby\">def foo(x)\n return 3\nend\n</code></pre>\n"- it "CM112" $- "~~~~ ruby startline=3 $%@#$\ndef foo(x)\n return 3\nend\n~~~~~~~" ==->- "<pre><code class=\"language-ruby\">def foo(x)\n return 3\nend\n</code></pre>\n"- it "CM113" $- "````;\n````" ==->- "<pre><code class=\"language-;\"></code></pre>\n"- it "CM114" $- "``` aa ```\nfoo" ==->- "<p><code>aa</code>\nfoo</p>\n"- it "CM115" $- "```\n``` aaa\n```" ==->- "<pre><code>``` aaa\n</code></pre>\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<my%20url>\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]" ==->- "<p><a href=\"/url\">foo</a></p>\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" ==->- "<p><a href=\"url\">foo</a></p>\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]" ==->- "<p><a href=\"/url\">Foo</a></p>\n"- it "CM171" $- "[ΑΓΩ]: /%CF%86%CE%BF%CF%85\n\n[αγω]" ==->- "<p><a href=\"/%cf%86%ce%bf%cf%85\">αγω</a></p>\n"- it "CM172" $- "[foo]: /url" ==->- ""- it "CM173" $- "[\nfoo\n]: /url\nbar" ==->- "<p>bar</p>\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\"" ==->- "<pre><code>[foo]: /url "title"\n</code></pre>\n"- it "CM177" $- "```\n[foo]: /url\n```" ==->- "<pre><code>[foo]: /url\n</code></pre>\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" ==->- "<h1 id=\"foo\"><a href=\"/url\">Foo</a></h1>\n<blockquote>\n<p>bar</p>\n</blockquote>\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" ==->- "<p><a href=\"/url\">foo</a></p>\n<blockquote>\n</blockquote>\n"- context "4.8 Paragraphs" $ do- it "CM182" $- "aaa\n\nbbb" ==->- "<p>aaa</p>\n<p>bbb</p>\n"- it "CM183" $- "aaa\nbbb\n\nccc\nddd" ==->- "<p>aaa\nbbb</p>\n<p>ccc\nddd</p>\n"- it "CM184" $- "aaa\n\n\nbbb" ==->- "<p>aaa</p>\n<p>bbb</p>\n"- it "CM185" $- " aaa\n bbb" ==->- "<p>aaa\nbbb</p>\n"- it "CM186" $- "aaa\n bbb\n ccc" ==->- "<p>aaa\nbbb\nccc</p>\n"- it "CM187" $- " aaa\nbbb" ==-> "<p>aaa\nbbb</p>\n"- it "CM188" $- " aaa\nbbb" ==->- "<pre><code>aaa\n</code></pre>\n<p>bbb</p>\n"- it "CM189" $- "aaa \nbbb " ==->- "<p>aaa\nbbb</p>\n"- context "4.9 Blank lines" $- it "CM190" $- " \n\naaa\n \n\n# aaa\n\n " ==->- "<p>aaa</p>\n<h1 id=\"aaa\">aaa</h1>\n"- context "5.1 Block quotes" $ do- it "CM191" $- "> # Foo\n bar\n baz" ==->- "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"- it "CM192" $- "># Foo\n bar\n baz" ==->- "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"- it "CM193" $- " > # Foo\n bar\n baz" ==->- "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"- it "CM194" $- " > # Foo\n > bar\n > baz" ==->- "<pre><code>> # Foo\n> bar\n> baz\n</code></pre>\n"- it "CM195" $- "> # Foo\n> bar\nbaz" ==->- "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"- it "CM196" $- "> bar\nbaz\n> foo" ==->- "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n<blockquote>\n<p>foo</p>\n</blockquote>\n"- it "CM197" $- "> foo\n---" ==->- "<blockquote>\n<p>foo</p>\n</blockquote>\n<hr>\n"- it "CM198" $- "> - foo\n- bar" ==->- "<blockquote>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</blockquote>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"- it "CM199" $- "> foo\n bar" ==->- "<blockquote>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</blockquote>\n"- it "CM200" $- "> ```\nfoo\n```" ==->- "<blockquote>\n<pre><code>foo\n</code></pre>\n</blockquote>\n"- it "CM201" $- "> foo\n - bar" ==->- "<blockquote>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</blockquote>\n"- it "CM202" $- ">" ==->- "<blockquote>\n</blockquote>\n"- it "CM203" $- ">\n> \n> " ==->- "<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n"- it "CM204" $- ">\n foo\n " ==->- "<blockquote>\n<p>foo</p>\n</blockquote>\n"- it "CM205" $- "> foo\n\n> bar" ==->- "<blockquote>\n<p>foo</p>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"- it "CM206" $- "> foo\n bar" ==->- "<blockquote>\n<p>foo\nbar</p>\n</blockquote>\n"- it "CM207" $- "> foo\n\n bar" ==->- "<blockquote>\n<p>foo</p>\n<p>bar</p>\n</blockquote>\n"- it "CM208" $- "foo\n> bar" ==->- "<p>foo</p>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"- it "CM209" $- "> aaa\n***\n> bbb" ==->- "<blockquote>\n<p>aaa</p>\n</blockquote>\n<hr>\n<blockquote>\n<p>bbb</p>\n</blockquote>\n"- it "CM210" $- "> bar\n baz" ==->- "<blockquote>\n<p>bar\nbaz</p>\n</blockquote>\n"- it "CM211" $- "> bar\n\nbaz" ==->- "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"- it "CM212" $- "> bar\n\nbaz" ==->- "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"- it "CM213" $- "> > > foo\nbar" ==->- "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo</p>\n</blockquote>\n</blockquote>\n</blockquote>\n<p>bar</p>\n"- it "CM214" $- ">>> foo\n bar\n baz" ==->- "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo\nbar\nbaz</p>\n</blockquote>\n</blockquote>\n</blockquote>\n"- it "CM215" $- "> code\n\n> not code" ==->- "<blockquote>\n<pre><code>code\n</code></pre>\n</blockquote>\n<blockquote>\n<p>not code</p>\n</blockquote>\n"- context "5.2 List items" $ do- it "CM216" $- "A paragraph\nwith two lines.\n\n indented code\n\n> A block quote." ==->- "<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n"- it "CM217" $- "1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->- "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"- it "CM218" $- "- one\n\n two" ==->- "<ul>\n<li>\none\n</li>\n</ul>\n<p>two</p>\n"- it "CM219" $- "- one\n\n two" ==->- "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"- it "CM220" $- " - one\n\n two" ==->- "<ul>\n<li>\none\n</li>\n</ul>\n<pre><code> two\n</code></pre>\n"- it "CM221" $- " - one\n\n two" ==->- "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"- it "CM222" $- " > > 1. one\n\n two" ==->- "<blockquote>\n<blockquote>\n<ol>\n<li>\none\n</li>\n</ol>\n<p>two</p>\n</blockquote>\n</blockquote>\n"- it "CM223" $- ">>- one\n\n two" ==->- "<blockquote>\n<blockquote>\n<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n</blockquote>\n</blockquote>\n"- it "CM224" $- "-one\n\n2.two" ==->- "<p>-one</p>\n<p>2.two</p>\n"- it "CM225" $- "- foo\n\n\n bar" ==->- "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- it "CM226" $- "1. foo\n\n ```\n bar\n ```\n\n baz\n\n > bam" ==->- "<ol>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n<p>baz</p>\n<blockquote>\n<p>bam</p>\n</blockquote>\n</li>\n</ol>\n"- it "CM227" $- "- Foo\n\n bar\n\n\n baz" ==->- "<ul>\n<li>\n<p>Foo</p>\n<pre><code>bar\n\n\nbaz\n</code></pre>\n</li>\n</ul>\n"- it "CM228" $- "123456789. ok" ==->- "<ol start=\"123456789\">\n<li>\nok\n</li>\n</ol>\n"- it "CM229" $- let s = "1234567890. not ok\n"- in s ~-> errFancy 0 (indexTooBig 1234567890)- it "CM230" $- "0. ok" ==->- "<ol start=\"0\">\n<li>\nok\n</li>\n</ol>\n"- it "CM231" $- "003. ok" ==->- "<ol start=\"3\">\n<li>\nok\n</li>\n</ol>\n"- it "CM232" $- "-1. not ok" ==->- "<p>-1. not ok</p>\n"- it "CM233" $- "- foo\n\n bar" ==->- "<ul>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ul>\n"- it "CM234" $- " 10. foo\n\n bar" ==->- "<ol start=\"10\">\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ol>\n"- it "CM235" $- " indented code\n\nparagraph\n\n more code" ==->- "<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n"- it "CM236" $- "1. indented code\n\n paragraph\n\n more code" ==->- "<ol>\n<li>\n<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"- it "CM237" $- "1. indented code\n\n paragraph\n\n more code" ==->- "<ol>\n<li>\n<pre><code> indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"- it "CM238" $- " foo\n\nbar" ==->- "<p>foo</p>\n<p>bar</p>\n"- it "CM239" $- "- foo\n\n bar" ==->- "<ul>\n<li>\nfoo\n</li>\n</ul>\n<p>bar</p>\n"- it "CM240" $- "- foo\n\n bar" ==->- "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- it "CM241" $- "-\n foo\n-\n ```\n bar\n ```\n-\n baz" ==->- "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<pre><code>bar\n</code></pre>\n</li>\n<li>\n<pre><code>baz\n</code></pre>\n</li>\n</ul>\n"- it "CM242" $- "- \n foo" ==->- "<ul>\n<li>\nfoo\n</li>\n</ul>\n"- it "CM243a" $- "-\n\n foo" ==->- "<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n"- it "CM243b" $- "1.\n\n foo" ==->- "<ol>\n<li>\n\n</li>\n</ol>\n<p>foo</p>\n"- it "CM244" $- "- foo\n-\n- bar" ==->- "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"- it "CM245" $- "- foo\n- \n- bar" ==->- "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"- it "CM246" $- "1. foo\n2.\n3. bar" ==->- "<ol>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ol>\n"- it "CM247" $- "*" ==->- "<ul>\n<li>\n\n</li>\n</ul>\n"- it "CM248" $- "foo\n*\n\nfoo\n1." ==->- "<p>foo</p>\n<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n<ol>\n<li>\n\n</li>\n</ol>\n"- it "CM249" $- " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->- "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"- it "CM250" $- " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->- "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"- it "CM251" $- " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->- "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"- it "CM252" $- " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->- "<pre><code>1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote.\n</code></pre>\n"- it "CM253" $- " 1. A paragraph\nwith two lines.\n\n indented code\n\n > A block quote." ==->- "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<p>with two lines.</p>\n<pre><code> indented code\n\n > A block quote.\n</code></pre>\n"- it "CM254" $- " 1. A paragraph\n with two lines." ==->- "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<pre><code>with two lines.\n</code></pre>\n"- it "CM255" $- "> 1. > Blockquote\ncontinued here." ==->- "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n</blockquote>\n<p>continued here.</p>\n"- it "CM256" $- "> 1. > Blockquote\n continued here." ==->- "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n<p>continued here.</p>\n</blockquote>\n"- it "CM257" $- "- foo\n - bar\n - baz\n - boo" ==->- "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n<ul>\n<li>\nboo\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"- it "CM258" $- "- foo\n - bar\n - baz\n - boo" ==->- "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n<li>\nboo\n</li>\n</ul>\n"- it "CM259" $- "10) foo\n - bar" ==->- "<ol start=\"10\">\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n"- it "CM260" $- "10) foo\n - bar" ==->- "<ol start=\"10\">\n<li>\nfoo\n</li>\n</ol>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"- it "CM261" $- "- - foo" ==->- "<ul>\n<li>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</li>\n</ul>\n"- it "CM262" $- "1. - 2. foo" ==->- "<ol>\n<li>\n<ul>\n<li>\n<ol start=\"2\">\n<li>\nfoo\n</li>\n</ol>\n</li>\n</ul>\n</li>\n</ol>\n"- it "CM263" $- "- # Foo\n- Bar\n ---\n baz" ==->- "<ul>\n<li>\n<h1 id=\"foo\">Foo</h1>\n</li>\n<li>\n<p>Bar</p>\n<hr>\n<p>baz</p>\n</li>\n</ul>\n"- context "5.3 Lists" $ do- it "CM264" $- "- foo\n- bar\n+ baz" ==->- "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ul>\n<ul>\n<li>\nbaz\n</li>\n</ul>\n"- it "CM265" $- "1. foo\n2. bar\n3) baz" ==->- "<ol>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ol>\n<ol start=\"3\">\n<li>\nbaz\n</li>\n</ol>\n"- it "CM266" $- "Foo\n- bar\n- baz" ==->- "<p>Foo</p>\n<ul>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n</ul>\n"- it "CM267" $- "The number of windows in my house is\n14. The number of doors is 6." ==->- "<p>The number of windows in my house is</p>\n<ol start=\"14\">\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"- it "CM268" $- "The number of windows in my house is\n1. The number of doors is 6." ==->- "<p>The number of windows in my house is</p>\n<ol>\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"- it "CM269" $- "- foo\n\n- bar\n\n\n- baz" ==->- "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<p>bar</p>\n</li>\n<li>\n<p>baz</p>\n</li>\n</ul>\n"- it "CM270" $- "- foo\n - bar\n - baz\n\n\n bim" ==->- "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\n<p>baz</p>\n<p>bim</p>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"- it "CM271" $- "- foo\n- bar\n\n<!-- -->\n\n- baz\n- bim" ==->- "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ul>\n<p><!-- --></p>\n<ul>\n<li>\nbaz\n</li>\n<li>\nbim\n</li>\n</ul>\n"- it "CM272" $- "- foo\n\n notcode\n\n- foo\n\n<!-- -->\n\n code" ==->- "<ul>\n<li>\n<p>foo</p>\n<p>notcode</p>\n</li>\n<li>\n<p>foo</p>\n</li>\n</ul>\n<p><!-- --></p>\n<pre><code>code\n</code></pre>\n"- it "CM273" $- "- a\n - b\n - c\n - d\n - e\n - f\n - g\n - h\n- i" ==->- "<ul>\n<li>\na\n</li>\n<li>\nb\n</li>\n<li>\nc\n</li>\n<li>\nd\n</li>\n<li>\ne\n</li>\n<li>\nf\n</li>\n<li>\ng\n</li>\n<li>\nh\n</li>\n<li>\ni\n</li>\n</ul>\n"- it "CM274" $- "1. a\n\n 2. b\n\n 3. c" ==->- "<ol>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ol>\n"- it "CM275" $- "- a\n- b\n\n- c" ==->- "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"- it "CM276" $- "* a\n*\n\n* c" ==->- "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p></p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"- it "CM277" $- "- a\n- b\n\n c\n- d" ==->- "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"- it "CM278" $- "- a\n- b\n\n [ref]: /url\n- d" ==->- "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"- it "CM279" $- "- a\n- ```\n b\n\n\n ```\n- c" ==->- "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<pre><code>b\n\n\n</code></pre>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"- it "CM280" $- "- a\n - b\n\n c\n- d" ==->- "<ul>\n<li>\na\n<ul>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n</ul>\n</li>\n<li>\nd\n</li>\n</ul>\n"- it "CM281" $- "* a\n > b\n >\n* c" ==->- "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<blockquote>\n</blockquote>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"- it "CM282" $- "- a\n > b\n ```\n c\n ```\n- d" ==->- "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<pre><code>c\n</code></pre>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"- it "CM283" $- "- a" ==->- "<ul>\n<li>\na\n</li>\n</ul>\n"- it "CM284" $- "- a\n - b" ==->- "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n</ul>\n</li>\n</ul>\n"- it "CM285" $- "1. ```\n foo\n ```\n\n bar" ==->- "<ol>\n<li>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</li>\n</ol>\n"- it "CM286" $- "* foo\n * bar\n\n baz" ==->- "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\nbaz\n</li>\n</ul>\n"- it "CM287" $- "- a\n - b\n - c\n\n- d\n - e\n - f" ==->- "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n<li>\nc\n</li>\n</ul>\n</li>\n<li>\nd\n<ul>\n<li>\ne\n</li>\n<li>\nf\n</li>\n</ul>\n</li>\n</ul>\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"- ==-> "<p>!"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~</p>\n"- it "CM290" $- "\\\t\\A\\a\\ \\3\\φ\\«" ==->- "<p>\\\t\\A\\a\\ \\3\\φ\\«</p>\n"- it "CM291" $- "\\*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" ==->- "<p>*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"</p>\n"- it "CM292" $- let s = "\\\\*emphasis*"- in s ~-> errFancy 2 (nonFlanking "*")- it "CM293" $- "foo\\\nbar" ==->- "<p>foo<br>\nbar</p>\n"- it "CM294" $- "`` \\[\\` ``" ==->- "<p><code>\\[\\`</code></p>\n"- it "CM295" $- " \\[\\]" ==->- "<pre><code>\\[\\]\n</code></pre>\n"- it "CM296" $- "~~~\n\\[\\]\n~~~" ==->- "<pre><code>\\[\\]\n</code></pre>\n"- it "CM297" $- "<http://example.com?find=*>" ==->- "<p><a href=\"http://example.com/?find=*\">http://example.com/?find=*</a></p>\n"- it "CM298" $- "<a href=\"/bar\\/)\">" ==->- "<p><a href="/bar/)"></p>\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```" ==->- "<pre><code class=\"language-foo+bar\">foo\n</code></pre>\n"- context "6.2 Entity and numeric character references" $ do- it "CM302" $- " & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸" ==->- "<p> & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸</p>\n"- it "CM303a" $- "# Ӓ Ϡ" ==->- "<p># Ӓ Ϡ</p>\n"- it "CM303b" $- "�" ~-> errFancy 0 (invalidNumChar 98765432)- it "CM303c" $- "�" ~-> errFancy 0 (invalidNumChar 0)- it "CM304" $- "" ആ ಫ" ==->- "<p>" ആ ಫ</p>\n"- it "CM305a" $- " " ==-> "<p>&nbsp</p>\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?;" ==-> "<p>&hi?;</p>\n"- it "CM306" $- "©" ==->- "<p>&copy</p>\n"- it "CM307" $- let s = "&MadeUpEntity;"- in s ~-> errFancy 0 (unknownEntity "MadeUpEntity")- it "CM308" $- "<a href=\"öö.html\">" ==->- "<p><a href="\246\246.html"></p>\n"- it "CM309" $- "[foo](/föö \"föö\")" ##->- p_ (a_ [href_ "/föö",title_ "f\246\246"] "foo")- it "CM310" $- "[foo]\n\n[foo]: /föö \"föö\"" ##->- p_ (a_ [href_ "/föö",title_ "f\246\246"] "foo")- it "CM311" $- "``` föö\nfoo\n```" ==->- "<pre><code class=\"language-f\246\246\">foo\n</code></pre>\n"- it "CM312" $- "`föö`" ==->- "<p><code>f&ouml;&ouml;</code></p>\n"- it "CM313" $- " föfö" ==->- "<pre><code>f&ouml;f&ouml;\n</code></pre>\n"- context "6.3 Code spans" $ do- it "CM314" $- "`foo`" ==-> "<p><code>foo</code></p>\n"- it "CM315" $- "`` foo ` bar ``" ==->- "<p><code>foo ` bar</code></p>\n"- it "CM316" $- "` `` `" ==-> "<p><code>``</code></p>\n"- it "CM317" $- "``\nfoo\n``" ==-> "<p><code>foo</code></p>\n"- it "CM318" $- "`foo bar\n baz`" ==-> "<p><code>foo bar baz</code></p>\n"- it "CM319" $- "`a b`" ==-> "<p><code>a b</code></p>\n"- it "CM320" $- "`foo `` bar`" ==-> "<p><code>foo `` bar</code></p>\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 = "`<a href=\"`\">`\n"- in s ~-> err 14 (ueib <> etok '`' <> ecsc)- it "CM325" $- "<a href=\"`\">`" ==->- "<p><a href="<code>"></code></p>\n"- it "CM326" $- let s = "`<http://foo.bar.`baz>`\n"- in s ~-> err 23 (ueib <> etok '`' <> ecsc)- it "CM327" $- "<http://foo.bar.`baz>`" ==->- "<p><http://foo.bar.<code>baz></code></p>\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*" ==-> "<p><em>foo bar</em></p>\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_" ==-> "<p><em>foo bar</em></p>\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*)*" ==->- "<p><em>(<em>foo</em>)</em></p>\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_)_" ==->- "<p><em>(<em>foo</em>)</em></p>\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" ==-> "<p><em>(bar)</em>.</p>\n"- it "CM358" $- "**foo bar**\n" ==-> "<p><strong>foo bar</strong></p>\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__" ==-> "<p><strong>foo bar</strong></p>\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__" ==->- "<p><strong>foo, <strong>bar</strong>, baz</strong></p>\n"- it "CM370" $- "foo-__\\(bar)__" ==-> "<p>foo-<strong>(bar)</strong></p>\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**)*" ==->- "<p><em>(<strong>foo</strong>)</em></p>\n"- it "CM374" $- "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**" ==->- "<p><strong>Gomphocarpus (<em>Gomphocarpus physocarpus</em>, syn.\n<em>Asclepias physocarpa</em>)</strong></p>\n"- it "CM375" $- "**foo \"*bar*\" foo**" ==->- "<p><strong>foo "<em>bar</em>" foo</strong></p>\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__)_" ==->- "<p><em>(<strong>foo</strong>)</em></p>\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__" ==->- "<p><strong>foo__bar__baz</strong></p>\n"- it "CM383" $- "__(bar\\)__." ==->- "<p><strong>(bar)</strong>.</p>\n"- it "CM384" $- "*foo [bar](/url)*" ==->- "<p><em>foo <a href=\"/url\">bar</a></em></p>\n"- it "CM385" $- "*foo\nbar*" ==->- "<p><em>foo\nbar</em></p>\n"- it "CM386" $- "_foo __bar__ baz_" ==->- "<p><em>foo <strong>bar</strong> baz</em></p>\n"- it "CM387" $- "_foo _bar_ baz_" ==->- "<p><em>foo <em>bar</em> baz</em></p>\n"- it "CM388" $- let s = "__foo_ bar_"- in s ~-> err 5 (utoks "_ " <> etoks "__" <> eic)- it "CM389" $- "*foo *bar**" ==->- "<p><em>foo <em>bar</em></em></p>\n"- it "CM390" $- "*foo **bar** baz*" ==->- "<p><em>foo <strong>bar</strong> baz</em></p>\n"- it "CM391" $- let s = "*foo**bar**baz*\n"- in s ~-> errFancy 5 (nonFlanking "*")- it "CM392" $- "***foo** bar*\n" ==-> "<p><em><strong>foo</strong> bar</em></p>\n"- it "CM393" $- "*foo **bar***\n" ==-> "<p><em>foo <strong>bar</strong></em></p>\n"- it "CM394" $- let s = "*foo**bar***\n"- in s ~-> errFancy 5 (nonFlanking "*")- it "CM395" $- "*foo **bar *baz* bim** bop*\n" ==->- "<p><em>foo <strong>bar <em>baz</em> bim</strong> bop</em></p>\n"- it "CM396" $- "*foo [*bar*](/url)*\n" ==->- "<p><em>foo <a href=\"/url\"><em>bar</em></a></em></p>\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)**" ==->- "<p><strong>foo <a href=\"/url\">bar</a></strong></p>\n"- it "CM400" $- "**foo\nbar**" ==->- "<p><strong>foo\nbar</strong></p>\n"- it "CM401" $- "__foo _bar_ baz__" ==->- "<p><strong>foo <em>bar</em> baz</strong></p>\n"- it "CM402" $- "__foo __bar__ baz__" ==->- "<p><strong>foo <strong>bar</strong> baz</strong></p>\n"- it "CM403" $- "____foo__ bar__" ==->- "<p><strong><strong>foo</strong> bar</strong></p>\n"- it "CM404" $- "**foo **bar****" ==->- "<p><strong>foo <strong>bar</strong></strong></p>\n"- it "CM405" $- "**foo *bar* baz**" ==->- "<p><strong>foo <em>bar</em> baz</strong></p>\n"- it "CM406" $- let s = "**foo*bar*baz**\n"- in s ~-> err 5 (utoks "*b" <> etoks "**" <> eic)- it "CM407" $- "***foo* bar**" ==->- "<p><strong><em>foo</em> bar</strong></p>\n"- it "CM408" $- "**foo *bar***" ==->- "<p><strong>foo <em>bar</em></strong></p>\n"- it "CM409" $- "**foo *bar **baz**\nbim* bop**" ==->- "<p><strong>foo <em>bar <strong>baz</strong>\nbim</em> bop</strong></p>\n"- it "CM410" $- "**foo [*bar*](/url)**" ==->- "<p><strong>foo <a href=\"/url\"><em>bar</em></a></strong></p>\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 *\\**" ==-> "<p>foo <em>*</em></p>\n"- it "CM415" $- "foo *\\_*\n" ==-> "<p>foo <em>_</em></p>\n"- it "CM416" $- let s = "foo *****\n"- in s ~-> errFancy 8 (nonFlanking "*")- it "CM417" $- "foo **\\***" ==-> "<p>foo <strong>*</strong></p>\n"- it "CM418" $- "foo **\\_**\n" ==-> "<p>foo <strong>_</strong></p>\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 _\\__" ==-> "<p>foo <em>_</em></p>\n"- it "CM427" $- "foo _\\*_" ==-> "<p>foo <em>*</em></p>\n"- it "CM428" $- let s = "foo _____\n"- in s ~-> errFancy 8 (nonFlanking "_")- it "CM429" $- "foo __\\___" ==-> "<p>foo <strong>_</strong></p>\n"- it "CM430" $- "foo __\\*__" ==-> "<p>foo <strong>*</strong></p>\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**" ==-> "<p><strong>foo</strong></p>\n"- it "CM438" $- "*_foo_*" ==-> "<p><em><em>foo</em></em></p>\n"- it "CM439" $- "__foo__" ==-> "<p><strong>foo</strong></p>\n"- it "CM440" $- "_*foo*_" ==-> "<p><em><em>foo</em></em></p>\n"- it "CM441" $- "****foo****" ==-> "<p><strong><strong>foo</strong></strong></p>\n"- it "CM442" $- "____foo____" ==-> "<p><strong><strong>foo</strong></strong></p>\n"- it "CM443" $- "******foo******" ==->- "<p><strong><strong><strong>foo</strong></strong></strong></p>\n"- it "CM444" $- "***foo***" ==-> "<p><em><strong>foo</strong></em></p>\n"- it "CM445" $- "_____foo_____" ==->- "<p><strong><strong><em>foo</em></strong></strong></p>\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 = "*<img src=\"foo\" title=\"*\"/>\n"- in s ~-> errFancy 23 (nonFlanking "*")- it "CM453" $- let s = "**<a href=\"**\">"- in s ~-> errFancy 11 (nonFlanking "**")- it "CM454" $- let s = "__<a href=\"__\">\n"- in s ~-> errFancy 11 (nonFlanking "__")- it "CM455" $- "*a `*`*" ==-> "<p><em>a <code>*</code></em></p>\n"- it "CM456" $- "_a `_`_" ==-> "<p><em>a <code>_</code></em></p>\n"- it "CM457" $- let s = "**a<http://foo.bar/?q=**>"- in s ~-> err 25 (ueib <> etoks "**" <> eic)- it "CM458" $- let s = "__a<http://foo.bar/?q=__>"- 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)" ==->- "<p><a href=\"/uri\">link</a></p>\n"- it "CM461" $- let s = "[link]()"- in s ~-> err 7- (utok ')' <> etok '<' <> elabel "URI" <> ews)- it "CM462" $- "[link](<>)" ==->- "<p><a href>link</a></p>\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](</my uri>)\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](<foo\nbar>)\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" ==->- "<p><a href=\"foo(and(bar\">link</a>))</p>\n"- it "CM469" $- let s = "[link](foo\\(and\\(bar\\))"- in s ~-> err 10 (utok '\\' <> euric <> euri)- it "CM470" $- "[link](<foo(and(bar)>)" ==->- "<p><a href=\"foo(and(bar)\">link</a></p>\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"- ==-> "<p><a href=\"#fragment\">link</a></p>\n<p><a href=\"http://example.com/#fragment\">link</a></p>\n<p><a href=\"http://example.com/?foo=3#frag\">link</a></p>\n"- it "CM473" $- let s = "[link](foo\\bar)"- in s ~-> err 10 (utok '\\' <> euric <> euri)- it "CM474" $- "[link](foo%20bä)"- ==-> "<p><a href=\"foo%20b&auml;\">link</a></p>\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" ==->- "<p><a href=\"/uri\">link [bar</a></p>\n"- it "CM487" $- "[link *foo **bar** `#`*](/uri)" ==->- "<p><a href=\"/uri\">link <em>foo <strong>bar</strong> <code>#</code></em></a></p>\n"- it "CM488" $- "[](/uri)" ==->- "<p><a href=\"/uri\"><img src=\"moon.jpg\" alt=\"moon\"></a></p>\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 = "](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 <bar attr=\"](baz)\">" ==->- "<p><a href=\"baz\">foo <bar attr="</a>"></p>\n"- it "CM496" $- let s = "[foo`](/uri)`\n"- in s ~-> err 13 (ueib <> etok ']' <> eic)- it "CM497" $- "[foo<http://example.com/?search=](uri)>" ==->- "<p><a href=\"uri\">foo<http://example.com/?search=</a>></p>\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" ==->- "<p><a href=\"/uri\">link [bar</a></p>\n"- it "CM501" $- "[link *foo **bar** `#`*][ref]\n\n[ref]: /uri" ==->- "<p><a href=\"/uri\">link <em>foo <strong>bar</strong> <code>#</code></em></a></p>\n"- it "CM502" $- "[][ref]\n\n[ref]: /uri" ==->- "<p><a href=\"/uri\"><img src=\"moon.jpg\" alt=\"moon\"></a></p>\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 <bar attr=\"][ref]\">\n\n[ref]: /uri" ==->- "<p><a href=\"/uri\">foo <bar attr="</a>"></p>\n"- it "CM508" $- let s = "[foo`][ref]`\n\n[ref]: /uri"- in s ~-> err 12 (ueib <> etok ']' <> eic)- it "CM509" $- "[foo<http://example.com/?search=][ref]>\n\n[ref]: /uri" ==->- "<p><a href=\"/uri\">foo<http://example.com/?search=</a>></p>\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" ==->- "<p><a href=\"/url\">Толпой</a> is a Russian word.</p>\n"- it "CM512" $- "[Foo\n bar]: /url\n\n[Baz][Foo bar]" ==->- "<p><a href=\"/url\">Baz</a></p>\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" ==->- "<p><a href=\"/url\">bar</a></p>\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" ==->- "<p><a href=\"/uri\">foo</a></p>\n"- it "CM521" $- "[bar\\\\]: /uri\n\n[bar\\\\]" ==->- "<p><a href=\"/uri\">bar\\</a></p>\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" ==->- "<p><a href=\"/url\">foo</a> bar</p>\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" ==->- "<p><a href=\"/url2\">foo</a></p>\n"- it "CM537" $- "[foo][]\n\n[foo]: /url1" ==->- "<p><a href=\"/url1\">foo</a></p>\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" ==->- "<p><a href=\"/url2\">foo</a><a href=\"/url1\">baz</a></p>\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\")" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"foo\"></p>\n"- it "CM544" $- "![foo *bar*](train.jpg \"train & tracks\")" ==->- "<p><img src=\"train.jpg\" title=\"train & tracks\" alt=\"foo bar\"></p>\n"- it "CM545" $- let s = "](/url2)\n"- in s ~-> err 6 (utok '!' <> etok ']' <> eic)- it "CM546" $- "](/url2)" ==->- "<p><img src=\"/url2\" alt=\"foo bar\"></p>\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\"" ==->- "<p><img src=\"train.jpg\" title=\"train & tracks\" alt=\"foo bar\"></p>\n"- it "CM549" $- "" ==->- "<p><img src=\"train.jpg\" alt=\"foo\"></p>\n"- it "CM550" $- "My ![foo bar](/path/to/train.jpg \"title\" )" ==->- "<p>My <img src=\"/path/to/train.jpg\" title=\"title\" alt=\"foo bar\"></p>\n"- it "CM551" $- "" ==->- "<p><img src=\"url\" alt=\"foo\"></p>\n"- it "CM552" $- "" ==-> "<p><img src=\"/url\" alt></p>\n"- it "CM553" $- "![foo][bar]\n\n[bar]: /url" ==->- "<p><img src=\"/url\" alt=\"foo\"></p>\n"- it "CM554" $- "![foo][bar]\n\n[BAR]: /url" ==->- "<p><img src=\"/url\" alt=\"foo\"></p>\n"- it "CM555" $- "![foo][]\n\n[foo]: /url \"title\"" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"foo\"></p>\n"- it "CM556" $- "![foo bar][]\n\n[foo bar]: /url \"title\"" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"foo bar\"></p>\n"- it "CM557" $- "![Foo][]\n\n[foo]: /url \"title\"" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"Foo\"></p>\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\"" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"foo\"></p>\n"- it "CM560" $- "![*foo* bar]\n\n[foo bar]: /url \"title\"\n" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"foo bar\"></p>\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\"" ==->- "<p><img src=\"/url\" title=\"title\" alt=\"Foo\"></p>\n"- it "CM563" $- "!\\[foo\\]\n\n[foo]: /url \"title\"" ==->- "<p>![foo]</p>\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>" ==->- "<p><a href=\"http://foo.bar.baz/\">http://foo.bar.baz/</a></p>\n"- it "CM566" $- "<http://foo.bar.baz/test?q=hello&id=22&boolean>" ==->- "<p><a href=\"http://foo.bar.baz/test?q=hello&id=22&boolean\">http://foo.bar.baz/test?q=hello&id=22&boolean</a></p>\n"- it "CM567" $- "<irc://foo.bar:2233/baz>" ==->- "<p><a href=\"irc://foo.bar:2233/baz\">irc://foo.bar:2233/baz</a></p>\n"- it "CM568" $- "<MAILTO:FOO@BAR.BAZ>" ==->- "<p><a href=\"mailto:FOO@BAR.BAZ\">FOO@BAR.BAZ</a></p>\n"- it "CM569" $- "<a+b+c:d>" ==->- "<p><a href=\"a+b+c:d\">a+b+c:d</a></p>\n"- it "CM570" $- "<made-up-scheme://foo,bar>" ==->- "<p><a href=\"made-up-scheme://foo/,bar\">made-up-scheme://foo/,bar</a></p>\n"- it "CM571" $- "<http://../>" ==->- "<p><a href=\"http://../\">http://../</a></p>\n"- it "CM572" $- "<localhost:5001/foo>" ==->- "<p><a href=\"localhost:5001/foo\">localhost:5001/foo</a></p>\n"- it "CM573" $- "<http://foo.bar/baz bim>\n" ==->- "<p><http://foo.bar/baz bim></p>\n"- it "CM574" $- "<http://example.com/\\[\\>" ==->- "<p><http://example.com/[></p>\n"- it "CM575" $- "<foo@bar.example.com>" ==->- "<p><a href=\"mailto:foo@bar.example.com\">foo@bar.example.com</a></p>\n"- it "CM576" $- "<foo+special@Bar.baz-bar0.com>" ==->- "<p><a href=\"mailto:foo+special@Bar.baz-bar0.com\">foo+special@Bar.baz-bar0.com</a></p>\n"- it "CM577" $- "<foo\\+@bar.example.com>" ==->- "<p><foo+@bar.example.com></p>\n"- it "CM578" $- "<>" ==->- "<p><></p>\n"- it "CM579" $- "< http://foo.bar >" ==->- "<p>< http://foo.bar ></p>\n"- it "CM580" $- "<m:abc>" ==->- "<p><a href=\"m:abc\">m:abc</a></p>\n"- it "CM581" $- "<foo.bar.baz>" ==->- "<p><a href=\"foo.bar.baz\">foo.bar.baz</a></p>\n"- it "CM582" $- "http://example.com" ==->- "<p>http://example.com</p>\n"- it "CM583" $- "foo@bar.example.com" ==->- "<p>foo@bar.example.com</p>\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" ==->- "<p>foo\nbaz</p>\n"- it "CM606" $- "foo\\\nbaz\n" ==->- "<p>foo<br>\nbaz</p>\n"- it "CM607" $- "foo \nbaz" ==->- "<p>foo\nbaz</p>\n"- it "CM608" $- "foo \n bar" ==->- "<p>foo\nbar</p>\n"- it "CM609" $- "foo\\\n bar" ==->- "<p>foo<br>\nbar</p>\n"- it "CM610" $- "*foo \nbar*" ==->- "<p><em>foo\nbar</em></p>\n"- it "CM611" $- "*foo\\\nbar*" ==->- "<p><em>foo<br>\nbar</em></p>\n"- it "CM612" $- "`code \nspan`" ==->- "<p><code>code span</code></p>\n"- it "CM613" $- "`code\\\nspan`" ==->- "<p><code>code\\ span</code></p>\n"- it "CM614" $- "<a href=\"foo \nbar\">" ==->- "<p><a href="foo\nbar"></p>\n"- it "CM615" $- "<a href=\"foo\\\nbar\">" ==->- "<p><a href="foo<br>\nbar"></p>\n"- it "CM616" $- "foo\\" ==->- "<p>foo\\</p>\n"- it "CM617" $- "foo " ==->- "<p>foo</p>\n"- it "CM618" $- "### foo\\" ==->- "<h3 id=\"foo\">foo\\</h3>\n"- it "CM619" $- "### foo " ==->- "<h3 id=\"foo\">foo</h3>\n"- context "6.10 Soft line breaks" $ do- it "CM620" $- "foo\nbaz" ==->- "<p>foo\nbaz</p>\n"- it "CM621" $- "foo \n baz" ==->- "<p>foo\nbaz</p>\n"- context "6.11 Textual content" $ do- it "CM622" $- "hello $.;'there" ==->- "<p>hello $.;'there</p>\n"- it "CM623" $- "Foo χρῆν" ==->- "<p>Foo χρῆν</p>\n"- it "CM624" $- "Multiple spaces" ==->- "<p>Multiple spaces</p>\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." ==->- "<p>It's <del>bad</del> news.</p>\n"- it "combines with emphasis" $- "**It's ~~bad~~** news." ==->- "<p><strong>It's <del>bad</del></strong> news.</p>\n"- it "interacts with subscript reasonably (1)" $- "It's ~~~bad~~ news~." ==->- "<p>It's <sub><del>bad</del> news</sub>.</p>\n"- it "interacts with subscript reasonably (2)" $- "It's ~~~bad~ news~~." ==->- "<p>It's <del><sub>bad</sub> news</del>.</p>\n"- context "subscript" $ do- it "works in simplest form" $- "It's ~bad~ news." ==->- "<p>It's <sub>bad</sub> news.</p>\n"- it "combines with emphasis" $- "**It's ~bad~** news." ==->- "<p><strong>It's <sub>bad</sub></strong> news.</p>\n"- context "superscript" $ do- it "works in simplest form" $- "It's ^bad^ news." ==->- "<p>It's <sup>bad</sup> news.</p>\n"- it "combines with emphasis" $- "**It's ^bad^** news." ==->- "<p><strong>It's <sup>bad</sup></strong> news.</p>\n"- it "a composite, complex example" $- "***Something ~~~is not~~ going~ ^so well^** today*." ==->- "<p><em><strong>Something <sub><del>is not</del> going</sub> <sup>so well</sup></strong> today</em>.</p>\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 = "<table>\n<thead>\n<tr><th>Foo</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td></tr>\n</tbody>\n</table>\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- | ---" ==->- "<p>Foo | Bar\nab- | ---</p>\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 | \\|" ==->- "<table>\n<thead>\n<tr><th>Foo |</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>|</td></tr>\n</tbody>\n</table>\n"- it "escaped characters preserve backslashes for inline-level parser" $- "Foo | Bar\n--- | ---\n\\*foo\\* | bar" ==->- "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>*foo*</td><td>bar</td></tr>\n</tbody>\n</table>\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" ==->- "<table>\n<thead>\n<tr><th><code>|Foo|</code></th><th><code>|Bar|</code></th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>bar</td></tr>\n</tbody>\n</table>\n"- it "pipes in code spans in cells do not fool the parser" $- "Foo | Bar\n--- | ---\n`|foo|` | `|bar|`" ==->- "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td><code>|foo|</code></td><td><code>|bar|</code></td></tr>\n</tbody>\n</table>\n"- it "multi-line code spans are disallowed in table headers" $- "`Foo\nBar` | Bar\n--- | ---\nfoo | bar" ==->- "<p><code>Foo Bar</code> | Bar\n--- | ---\nfoo | bar</p>\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--- | ---" ==->- "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"- it "recognizes end of table correctly" $- "Foo | Bar\n--- | ---\nfoo | bar\n\nHere goes a paragraph." ==->- "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>bar</td></tr>\n</tbody>\n</table>\n<p>Here goes a paragraph.</p>\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" ==->- "<table>\n<thead>\n<tr><th>+ foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"- "+ foo | bar\n -----|----\n" ==->- "<table>\n<thead>\n<tr><th>+ foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"- it "tables have higher precedence than ordered lists" $ do- "1. foo | bar\n-------|----\n" ==->- "<table>\n<thead>\n<tr><th>1. foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"- "1. foo | bar\n ------|----\n" ==->- "<table>\n<thead>\n<tr><th>1. foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"- it "if table is indented inside unordered list, it's put there" $- "+ foo | bar\n ----|----\n" ==->- "<ul>\n<li>\n<table>\n<thead>\n<tr><th>foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</li>\n</ul>\n"- it "if table is indented inside ordered list, it's put there" $- "1. foo | bar\n ----|----\n" ==->- "<ol>\n<li>\n<table>\n<thead>\n<tr><th>foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</li>\n</ol>\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`- "<p>Here we go...</p>\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`- "<p>Here we go.123</p>\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-#ifdef ghcjs_HOST_OS- let r = object []-#else- let r = object- [ "x" .= Number 100- , "y" .= Number 200 ]-#endif- 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-#ifndef ghcjs_HOST_OS- context "when it is invalid" $ do- let mappingErr = fancy . ErrorCustom . YamlParseError $- "mapping values are not allowed in this context"- it "signal 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)- ]-#endif--------------------------------------------------------------------------------- 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 contents of another file.--withFiles- :: FilePath -- ^ Markdown document- -> FilePath -- ^ HTML document containing the correct result- -> Expectation-withFiles input output = do- i <- TIO.readFile input- o <- TIO.readFile output- i ==-> o--------------------------------------------------------------------------------- Helpers---- | Unexpected end of inline block.--ueib :: Stream s => ET s-ueib = ulabel "end of inline block"---- | Expecting end of inline block.--eeib :: Stream s => ET s-eeib = elabel "end of inline block"---- | Expecting end of URI.--euri :: Stream s => ET s-euri = elabel "end of URI"---- | Expecting inline content.--eic :: Stream s => ET s-eic = elabel "inline content"---- | Expecting white space.--ews :: Stream s => ET s-ews = elabel "white space"---- | Expecting code span content.--ecsc :: Stream s => 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"- ]---- | 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---- | Error component complaining that the given starting index of an ordered--- list is too big.--indexTooBig :: Word -> EF MMarkErr-indexTooBig = fancy . ErrorCustom . ListStartIndexTooBig---- | Error component complaining about non-consecutive indices in an ordered--- list.--indexNonCons :: Word -> Word -> EF MMarkErr-indexNonCons actual expected = fancy . ErrorCustom $- ListIndexOutOfOrder actual expected---- | Error component complaining about a missing link\/image reference.--couldNotMatchRef :: Text -> [Text] -> EF MMarkErr-couldNotMatchRef name names = fancy . ErrorCustom $- CouldNotFindReferenceDefinition name names---- | Error component complaining about a duplicate reference definition.--duplicateRef :: Text -> EF MMarkErr-duplicateRef = fancy . ErrorCustom . DuplicateReferenceDefinition---- | Error component complaining about an invalid numeric character.--invalidNumChar :: Int -> EF MMarkErr-invalidNumChar = fancy . ErrorCustom . InvalidNumericCharacter---- | Error component complaining about an unknown HTML5 entity name.-+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.MMarkSpec (spec) where++import qualified Control.Foldl as L+import Data.Aeson+import Data.Char+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Lucid+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.MMark (MMarkErr (..))+import qualified Text.MMark as MMark+import Text.MMark.Extension (Inline (..))+import qualified Text.MMark.Extension as Ext+import Text.MMark.TestUtils+import Text.Megaparsec (ErrorFancy (..), Stream)++-- 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:+--+-- <http://spec.commonmark.org/0.28/>++spec :: Spec+spec = parallel $ do+ describe "parse and render" $ do+ context "2.2 Tabs" $ do+ it "CM1" $+ "\tfoo\tbaz\t\tbim"+ ==-> "<pre><code>foo\tbaz\t\tbim\n</code></pre>\n"+ it "CM2" $+ " \tfoo\tbaz\t\tbim"+ ==-> "<pre><code>foo\tbaz\t\tbim\n</code></pre>\n"+ it "CM3" $+ " a\ta\n ὐ\ta"+ ==-> "<pre><code>a\ta\nὐ\ta\n</code></pre>\n"+ it "CM4" $+ " - foo\n\n\tbar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM5" $+ "- foo\n\n\t\tbar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<pre><code> bar\n</code></pre>\n</li>\n</ul>\n"+ it "CM6" $+ ">\t\tfoo"+ ==-> "<blockquote>\n<pre><code> foo\n</code></pre>\n</blockquote>\n"+ it "CM7" $+ "-\t\tfoo"+ ==-> "<ul>\n<li>\n<pre><code> foo\n</code></pre>\n</li>\n</ul>\n"+ it "CM8" $+ " foo\n\tbar"+ ==-> "<pre><code>foo\nbar\n</code></pre>\n"+ it "CM9" $+ " - foo\n - bar\n\t - baz"+ ==-> "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM10" $+ "#\tFoo" ==-> "<h1 id=\"foo\">Foo</h1>\n"+ it "CM11" $+ "*\t*\t*\t" ==-> "<hr>\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___" ==-> "<hr>\n<hr>\n<hr>\n"+ it "CM14" $+ "+++" ==-> "<p>+++</p>\n"+ it "CM15" $+ "===" ==-> "<p>===</p>\n"+ it "CM16" $+ let s = "--\n**\n__\n"+ in s ~-> errFancy 3 (nonFlanking "**")+ it "CM17" $+ " ***\n ***\n ***" ==-> "<hr>\n<hr>\n<hr>\n"+ it "CM18" $+ " ***" ==-> "<pre><code>***\n</code></pre>\n"+ it "CM19" $+ let s = "Foo\n ***\n"+ in s ~-> errFancy 8 (nonFlanking "***")+ it "CM20" $+ "_____________________________________"+ ==-> "<hr>\n"+ it "CM21" $+ " - - -" ==-> "<hr>\n"+ it "CM22" $+ " ** * ** * ** * **" ==-> "<hr>\n"+ it "CM23" $+ "- - - -" ==-> "<hr>\n"+ it "CM24" $+ "- - - - " ==-> "<hr>\n"+ it "CM25" $+ let s = "_ _ _ _ a\n\na------\n\n---a---\n"+ in s ~-> errFancy 0 (nonFlanking "_")+ it "CM26" $+ " *-*" ==-> "<p><em>-</em></p>\n"+ it "CM27" $+ "- foo\n***\n- bar"+ ==-> "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM28" $+ "Foo\n***\nbar"+ ==-> "<p>Foo</p>\n<hr>\n<p>bar</p>\n"+ it "CM29" $+ "Foo\n---\nbar"+ ==-> "<p>Foo</p>\n<hr>\n<p>bar</p>\n"+ it "CM30" $+ "* Foo\n* * *\n* Bar"+ ==-> "<ul>\n<li>\nFoo\n</li>\n<li>\n<ul>\n<li>\n<ul>\n<li>\n\n</li>\n</ul>\n</li>\n</ul>\n</li>\n<li>\nBar\n</li>\n</ul>\n"+ it "CM31" $+ "- Foo\n- * * *"+ ==-> "<ul>\n<li>\nFoo\n</li>\n<li>\n<hr>\n</li>\n</ul>\n"+ context "4.2 ATX headings" $ do+ it "CM32" $+ "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo"+ ==-> "<h1 id=\"foo\">foo</h1>\n<h2 id=\"foo\">foo</h2>\n<h3 id=\"foo\">foo</h3>\n<h4 id=\"foo\">foo</h4>\n<h5 id=\"foo\">foo</h5>\n<h6 id=\"foo\">foo</h6>\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" ==-> "<p>## foo</p>\n"+ it "CM36" $+ "# foo *bar* \\*baz\\*" ==-> "<h1 id=\"foo-bar-baz\">foo <em>bar</em> *baz*</h1>\n"+ it "CM37" $+ "# foo "+ ==-> "<h1 id=\"foo\">foo</h1>\n"+ it "CM38" $+ " ### foo\n ## foo\n # foo"+ ==-> "<h3 id=\"foo\">foo</h3>\n<h2 id=\"foo\">foo</h2>\n<h1 id=\"foo\">foo</h1>\n"+ it "CM39" $+ " # foo" ==-> "<pre><code># foo\n</code></pre>\n"+ it "CM40" $+ "foo\n # bar" ==-> "<p>foo\n# bar</p>\n"+ it "CM41" $+ "## foo ##\n ### bar ###"+ ==-> "<h2 id=\"foo\">foo</h2>\n<h3 id=\"bar\">bar</h3>\n"+ it "CM42" $+ "# foo ##################################\n##### foo ##"+ ==-> "<h1 id=\"foo\">foo</h1>\n<h5 id=\"foo\">foo</h5>\n"+ it "CM43" $+ "### foo ### " ==-> "<h3 id=\"foo\">foo</h3>\n"+ it "CM44" $+ "### foo ### b" ==-> "<h3 id=\"foo-b\">foo ### b</h3>\n"+ it "CM45" $+ "# foo#" ==-> "<h1 id=\"foo\">foo#</h1>\n"+ it "CM46" $+ "### foo \\###\n## foo #\\##\n# foo \\#"+ ==-> "<h3 id=\"foo\">foo ###</h3>\n<h2 id=\"foo\">foo ###</h2>\n<h1 id=\"foo\">foo #</h1>\n"+ it "CM47" $+ "****\n## foo\n****"+ ==-> "<hr>\n<h2 id=\"foo\">foo</h2>\n<hr>\n"+ it "CM48" $+ "Foo bar\n# baz\nBar foo"+ ==-> "<p>Foo bar</p>\n<h1 id=\"baz\">baz</h1>\n<p>Bar foo</p>\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---------"+ ==-> "<p>Foo <em>bar</em>\n=========</p>\n<p>Foo <em>bar</em></p>\n<hr>\n"+ it "CM51" $+ "Foo *bar\nbaz*\n===="+ ==-> "<p>Foo <em>bar\nbaz</em>\n====</p>\n"+ it "CM52" $+ "Foo\n-------------------------\n\nFoo\n="+ ==-> "<p>Foo</p>\n<hr>\n<p>Foo\n=</p>\n"+ it "CM53" $+ " Foo\n---\n\n Foo\n-----\n\n Foo\n ==="+ ==-> "<p>Foo</p>\n<hr>\n<p>Foo</p>\n<hr>\n<p>Foo\n===</p>\n"+ it "CM54" $+ " Foo\n ---\n\n Foo\n---"+ ==-> "<pre><code>Foo\n---\n\nFoo\n</code></pre>\n<hr>\n"+ it "CM55" $+ "Foo\n ---- "+ ==-> "<p>Foo</p>\n<hr>\n"+ it "CM56" $+ "Foo\n ---"+ ==-> "<p>Foo\n---</p>\n"+ it "CM57" $+ "Foo\n= =\n\nFoo\n--- -"+ ==-> "<p>Foo\n= =</p>\n<p>Foo</p>\n<hr>\n"+ it "CM58" $+ "Foo \n-----"+ ==-> "<p>Foo</p>\n<hr>\n"+ it "CM59" $+ "Foo\\\n----"+ ==-> "<p>Foo\\</p>\n<hr>\n"+ it "CM60" $+ let s = "`Foo\n----\n`\n\n<a title=\"a lot\n---\nof dashes\"/>\n"+ in s+ ~~-> [ err 4 (ueib <> etok '`' <> ecsc),+ err 11 (ueib <> etok '`' <> ecsc)+ ]+ it "CM61" $+ "> Foo\n---"+ ==-> "<blockquote>\n<p>Foo</p>\n</blockquote>\n<hr>\n"+ it "CM62" $+ "> foo\nbar\n==="+ ==-> "<blockquote>\n<p>foo</p>\n</blockquote>\n<p>bar\n===</p>\n"+ it "CM63" $+ "- Foo\n---"+ ==-> "<ul>\n<li>\nFoo\n</li>\n</ul>\n<hr>\n"+ it "CM64" $+ "Foo\nBar\n---"+ ==-> "<p>Foo\nBar</p>\n<hr>\n"+ it "CM65" $+ "---\nFoo\n---\nBar\n---\nBaz"+ ==-> "<p>Bar</p>\n<hr>\n<p>Baz</p>\n"+ it "CM66" $+ "\n===="+ ==-> "<p>====</p>\n"+ it "CM67" $+ "---\n---"+ ==-> "" -- thinks that it's got a YAML block+ it "CM68" $+ "- foo\n-----"+ ==-> "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n"+ it "CM69" $+ " foo\n---"+ ==-> "<pre><code>foo\n</code></pre>\n<hr>\n"+ it "CM70" $+ "> foo\n-----"+ ==-> "<blockquote>\n<p>foo</p>\n</blockquote>\n<hr>\n"+ it "CM71" $+ "\\> foo\n------"+ ==-> "<p>> foo</p>\n<hr>\n"+ it "CM72" $+ "Foo\n\nbar\n---\nbaz"+ ==-> "<p>Foo</p>\n<p>bar</p>\n<hr>\n<p>baz</p>\n"+ it "CM73" $+ "Foo\nbar\n\n---\n\nbaz"+ ==-> "<p>Foo\nbar</p>\n<hr>\n<p>baz</p>\n"+ it "CM74" $+ "Foo\nbar\n* * *\nbaz"+ ==-> "<p>Foo\nbar</p>\n<hr>\n<p>baz</p>\n"+ it "CM75" $+ "Foo\nbar\n\\---\nbaz"+ ==-> "<p>Foo\nbar\n---\nbaz</p>\n"+ context "4.4 Indented code blocks" $ do+ it "CM76" $+ " a simple\n indented code block"+ ==-> "<pre><code>a simple\n indented code block\n</code></pre>\n"+ it "CM77" $+ " - foo\n\n bar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM78" $+ "1. foo\n\n - bar"+ ==-> "<ol>\n<li>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n"+ it "CM79" $+ " <a/>\n *hi*\n\n - one"+ ==-> "<pre><code><a/>\n*hi*\n\n- one\n</code></pre>\n"+ it "CM80" $+ " chunk1\n\n chunk2\n \n \n \n chunk3"+ ==-> "<pre><code>chunk1\n\nchunk2\n\n\n\nchunk3\n</code></pre>\n"+ it "CM81" $+ " chunk1\n \n chunk2"+ ==-> "<pre><code>chunk1\n \n chunk2\n</code></pre>\n"+ it "CM82" $+ "Foo\n bar\n"+ ==-> "<p>Foo\nbar</p>\n"+ it "CM83" $+ " foo\nbar"+ ==-> "<pre><code>foo\n</code></pre>\n<p>bar</p>\n"+ it "CM84" $+ "# Heading\n foo\nHeading\n------\n foo\n----\n"+ ==-> "<h1 id=\"heading\">Heading</h1>\n<pre><code>foo\n</code></pre>\n<p>Heading</p>\n<hr>\n<pre><code>foo\n</code></pre>\n<hr>\n"+ it "CM85" $+ " foo\n bar"+ ==-> "<pre><code> foo\nbar\n</code></pre>\n"+ it "CM86" $+ "\n \n foo\n \n"+ ==-> "<pre><code>foo\n</code></pre>\n"+ it "CM87" $+ " foo "+ ==-> "<pre><code>foo \n</code></pre>\n"+ context "4.5 Fenced code blocks" $ do+ it "CM88" $+ "```\n<\n >\n```"+ ==-> "<pre><code><\n >\n</code></pre>\n"+ it "CM89" $+ "~~~\n<\n >\n~~~"+ ==-> "<pre><code><\n >\n</code></pre>\n"+ it "CM90" $+ "``\nfoo\n``\n"+ ==-> "<p><code>foo</code></p>\n"+ it "CM91" $+ "```\naaa\n~~~\n```"+ ==-> "<pre><code>aaa\n~~~\n</code></pre>\n"+ it "CM92" $+ "~~~\naaa\n```\n~~~"+ ==-> "<pre><code>aaa\n```\n</code></pre>\n"+ it "CM93" $+ "````\naaa\n```\n``````"+ ==-> "<pre><code>aaa\n```\n</code></pre>\n"+ it "CM94" $+ "~~~~\naaa\n~~~\n~~~~"+ ==-> "<pre><code>aaa\n~~~\n</code></pre>\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```"+ ==-> "<pre><code>\n \n</code></pre>\n"+ it "CM99" $+ "```\n```"+ ==-> "<pre><code></code></pre>\n"+ it "CM100" $+ " ```\n aaa\naaa\n```"+ ==-> "<pre><code>aaa\naaa\n</code></pre>\n"+ it "CM101" $+ " ```\naaa\n aaa\naaa\n ```"+ ==-> "<pre><code>aaa\naaa\naaa\n</code></pre>\n"+ it "CM102" $+ " ```\n aaa\n aaa\n aaa\n ```"+ ==-> "<pre><code>aaa\n aaa\naaa\n</code></pre>\n"+ it "CM103" $+ " ```\n aaa\n ```"+ ==-> "<pre><code>```\naaa\n```\n</code></pre>\n"+ it "CM104" $+ "```\naaa\n ```"+ ==-> "<pre><code>aaa\n</code></pre>\n"+ it "CM105" $+ " ```\naaa\n ```"+ ==-> "<pre><code>aaa\n</code></pre>\n"+ it "CM106" $+ let s = "```\naaa\n ```\n"+ in s+ ~-> err+ 16+ (ueof <> elabel "closing code fence" <> elabel "code block content")+ it "CM107" $+ "``` ```\naaa"+ ==-> "<p><code></code>\naaa</p>\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"+ ==-> "<p>foo</p>\n<pre><code>bar\n</code></pre>\n<p>baz</p>\n"+ it "CM110" $+ "foo\n---\n~~~\nbar\n~~~\n# baz"+ ==-> "<p>foo</p>\n<hr>\n<pre><code>bar\n</code></pre>\n<h1 id=\"baz\">baz</h1>\n"+ it "CM111" $+ "```ruby\ndef foo(x)\n return 3\nend\n```"+ ==-> "<pre><code class=\"language-ruby\">def foo(x)\n return 3\nend\n</code></pre>\n"+ it "CM112" $+ "~~~~ ruby startline=3 $%@#$\ndef foo(x)\n return 3\nend\n~~~~~~~"+ ==-> "<pre><code class=\"language-ruby\">def foo(x)\n return 3\nend\n</code></pre>\n"+ it "CM113" $+ "````;\n````"+ ==-> "<pre><code class=\"language-;\"></code></pre>\n"+ it "CM114" $+ "``` aa ```\nfoo"+ ==-> "<p><code>aa</code>\nfoo</p>\n"+ it "CM115" $+ "```\n``` aaa\n```"+ ==-> "<pre><code>``` aaa\n</code></pre>\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<my%20url>\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]"+ ==-> "<p><a href=\"/url\">foo</a></p>\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"+ ==-> "<p><a href=\"url\">foo</a></p>\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]"+ ==-> "<p><a href=\"/url\">Foo</a></p>\n"+ it "CM171" $+ "[ΑΓΩ]: /%CF%86%CE%BF%CF%85\n\n[αγω]"+ ==-> "<p><a href=\"/%cf%86%ce%bf%cf%85\">αγω</a></p>\n"+ it "CM172" $+ "[foo]: /url"+ ==-> ""+ it "CM173" $+ "[\nfoo\n]: /url\nbar"+ ==-> "<p>bar</p>\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\""+ ==-> "<pre><code>[foo]: /url "title"\n</code></pre>\n"+ it "CM177" $+ "```\n[foo]: /url\n```"+ ==-> "<pre><code>[foo]: /url\n</code></pre>\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"+ ==-> "<h1 id=\"foo\"><a href=\"/url\">Foo</a></h1>\n<blockquote>\n<p>bar</p>\n</blockquote>\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"+ ==-> "<p><a href=\"/url\">foo</a></p>\n<blockquote>\n</blockquote>\n"+ context "4.8 Paragraphs" $ do+ it "CM182" $+ "aaa\n\nbbb"+ ==-> "<p>aaa</p>\n<p>bbb</p>\n"+ it "CM183" $+ "aaa\nbbb\n\nccc\nddd"+ ==-> "<p>aaa\nbbb</p>\n<p>ccc\nddd</p>\n"+ it "CM184" $+ "aaa\n\n\nbbb"+ ==-> "<p>aaa</p>\n<p>bbb</p>\n"+ it "CM185" $+ " aaa\n bbb"+ ==-> "<p>aaa\nbbb</p>\n"+ it "CM186" $+ "aaa\n bbb\n ccc"+ ==-> "<p>aaa\nbbb\nccc</p>\n"+ it "CM187" $+ " aaa\nbbb" ==-> "<p>aaa\nbbb</p>\n"+ it "CM188" $+ " aaa\nbbb"+ ==-> "<pre><code>aaa\n</code></pre>\n<p>bbb</p>\n"+ it "CM189" $+ "aaa \nbbb "+ ==-> "<p>aaa\nbbb</p>\n"+ context "4.9 Blank lines" $+ it "CM190" $+ " \n\naaa\n \n\n# aaa\n\n "+ ==-> "<p>aaa</p>\n<h1 id=\"aaa\">aaa</h1>\n"+ context "5.1 Block quotes" $ do+ it "CM191" $+ "> # Foo\n bar\n baz"+ ==-> "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM192" $+ "># Foo\n bar\n baz"+ ==-> "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM193" $+ " > # Foo\n bar\n baz"+ ==-> "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM194" $+ " > # Foo\n > bar\n > baz"+ ==-> "<pre><code>> # Foo\n> bar\n> baz\n</code></pre>\n"+ it "CM195" $+ "> # Foo\n> bar\nbaz"+ ==-> "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM196" $+ "> bar\nbaz\n> foo"+ ==-> "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n<blockquote>\n<p>foo</p>\n</blockquote>\n"+ it "CM197" $+ "> foo\n---"+ ==-> "<blockquote>\n<p>foo</p>\n</blockquote>\n<hr>\n"+ it "CM198" $+ "> - foo\n- bar"+ ==-> "<blockquote>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</blockquote>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM199" $+ "> foo\n bar"+ ==-> "<blockquote>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</blockquote>\n"+ it "CM200" $+ "> ```\nfoo\n```"+ ==-> "<blockquote>\n<pre><code>foo\n</code></pre>\n</blockquote>\n"+ it "CM201" $+ "> foo\n - bar"+ ==-> "<blockquote>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</blockquote>\n"+ it "CM202" $+ ">"+ ==-> "<blockquote>\n</blockquote>\n"+ it "CM203" $+ ">\n> \n> "+ ==-> "<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n"+ it "CM204" $+ ">\n foo\n "+ ==-> "<blockquote>\n<p>foo</p>\n</blockquote>\n"+ it "CM205" $+ "> foo\n\n> bar"+ ==-> "<blockquote>\n<p>foo</p>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"+ it "CM206" $+ "> foo\n bar"+ ==-> "<blockquote>\n<p>foo\nbar</p>\n</blockquote>\n"+ it "CM207" $+ "> foo\n\n bar"+ ==-> "<blockquote>\n<p>foo</p>\n<p>bar</p>\n</blockquote>\n"+ it "CM208" $+ "foo\n> bar"+ ==-> "<p>foo</p>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"+ it "CM209" $+ "> aaa\n***\n> bbb"+ ==-> "<blockquote>\n<p>aaa</p>\n</blockquote>\n<hr>\n<blockquote>\n<p>bbb</p>\n</blockquote>\n"+ it "CM210" $+ "> bar\n baz"+ ==-> "<blockquote>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM211" $+ "> bar\n\nbaz"+ ==-> "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM212" $+ "> bar\n\nbaz"+ ==-> "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM213" $+ "> > > foo\nbar"+ ==-> "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo</p>\n</blockquote>\n</blockquote>\n</blockquote>\n<p>bar</p>\n"+ it "CM214" $+ ">>> foo\n bar\n baz"+ ==-> "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo\nbar\nbaz</p>\n</blockquote>\n</blockquote>\n</blockquote>\n"+ it "CM215" $+ "> code\n\n> not code"+ ==-> "<blockquote>\n<pre><code>code\n</code></pre>\n</blockquote>\n<blockquote>\n<p>not code</p>\n</blockquote>\n"+ context "5.2 List items" $ do+ it "CM216" $+ "A paragraph\nwith two lines.\n\n indented code\n\n> A block quote."+ ==-> "<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n"+ it "CM217" $+ "1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote."+ ==-> "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM218" $+ "- one\n\n two"+ ==-> "<ul>\n<li>\none\n</li>\n</ul>\n<p>two</p>\n"+ it "CM219" $+ "- one\n\n two"+ ==-> "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"+ it "CM220" $+ " - one\n\n two"+ ==-> "<ul>\n<li>\none\n</li>\n</ul>\n<pre><code> two\n</code></pre>\n"+ it "CM221" $+ " - one\n\n two"+ ==-> "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"+ it "CM222" $+ " > > 1. one\n\n two"+ ==-> "<blockquote>\n<blockquote>\n<ol>\n<li>\none\n</li>\n</ol>\n<p>two</p>\n</blockquote>\n</blockquote>\n"+ it "CM223" $+ ">>- one\n\n two"+ ==-> "<blockquote>\n<blockquote>\n<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n</blockquote>\n</blockquote>\n"+ it "CM224" $+ "-one\n\n2.two"+ ==-> "<p>-one</p>\n<p>2.two</p>\n"+ it "CM225" $+ "- foo\n\n\n bar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM226" $+ "1. foo\n\n ```\n bar\n ```\n\n baz\n\n > bam"+ ==-> "<ol>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n<p>baz</p>\n<blockquote>\n<p>bam</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM227" $+ "- Foo\n\n bar\n\n\n baz"+ ==-> "<ul>\n<li>\n<p>Foo</p>\n<pre><code>bar\n\n\nbaz\n</code></pre>\n</li>\n</ul>\n"+ it "CM228" $+ "123456789. ok"+ ==-> "<ol start=\"123456789\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM229" $+ let s = "1234567890. not ok\n"+ in s ~-> errFancy 0 (indexTooBig 1234567890)+ it "CM230" $+ "0. ok"+ ==-> "<ol start=\"0\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM231" $+ "003. ok"+ ==-> "<ol start=\"3\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM232" $+ "-1. not ok"+ ==-> "<p>-1. not ok</p>\n"+ it "CM233" $+ "- foo\n\n bar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ul>\n"+ it "CM234" $+ " 10. foo\n\n bar"+ ==-> "<ol start=\"10\">\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ol>\n"+ it "CM235" $+ " indented code\n\nparagraph\n\n more code"+ ==-> "<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n"+ it "CM236" $+ "1. indented code\n\n paragraph\n\n more code"+ ==-> "<ol>\n<li>\n<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"+ it "CM237" $+ "1. indented code\n\n paragraph\n\n more code"+ ==-> "<ol>\n<li>\n<pre><code> indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"+ it "CM238" $+ " foo\n\nbar"+ ==-> "<p>foo</p>\n<p>bar</p>\n"+ it "CM239" $+ "- foo\n\n bar"+ ==-> "<ul>\n<li>\nfoo\n</li>\n</ul>\n<p>bar</p>\n"+ it "CM240" $+ "- foo\n\n bar"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM241" $+ "-\n foo\n-\n ```\n bar\n ```\n-\n baz"+ ==-> "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<pre><code>bar\n</code></pre>\n</li>\n<li>\n<pre><code>baz\n</code></pre>\n</li>\n</ul>\n"+ it "CM242" $+ "- \n foo"+ ==-> "<ul>\n<li>\nfoo\n</li>\n</ul>\n"+ it "CM243a" $+ "-\n\n foo"+ ==-> "<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n"+ it "CM243b" $+ "1.\n\n foo"+ ==-> "<ol>\n<li>\n\n</li>\n</ol>\n<p>foo</p>\n"+ it "CM244" $+ "- foo\n-\n- bar"+ ==-> "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM245" $+ "- foo\n- \n- bar"+ ==-> "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM246" $+ "1. foo\n2.\n3. bar"+ ==-> "<ol>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ol>\n"+ it "CM247" $+ "*"+ ==-> "<ul>\n<li>\n\n</li>\n</ul>\n"+ it "CM248" $+ "foo\n*\n\nfoo\n1."+ ==-> "<p>foo</p>\n<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n<ol>\n<li>\n\n</li>\n</ol>\n"+ it "CM249" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote."+ ==-> "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM250" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote."+ ==-> "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM251" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote."+ ==-> "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM252" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote."+ ==-> "<pre><code>1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote.\n</code></pre>\n"+ it "CM253" $+ " 1. A paragraph\nwith two lines.\n\n indented code\n\n > A block quote."+ ==-> "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<p>with two lines.</p>\n<pre><code> indented code\n\n > A block quote.\n</code></pre>\n"+ it "CM254" $+ " 1. A paragraph\n with two lines."+ ==-> "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<pre><code>with two lines.\n</code></pre>\n"+ it "CM255" $+ "> 1. > Blockquote\ncontinued here."+ ==-> "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n</blockquote>\n<p>continued here.</p>\n"+ it "CM256" $+ "> 1. > Blockquote\n continued here."+ ==-> "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n<p>continued here.</p>\n</blockquote>\n"+ it "CM257" $+ "- foo\n - bar\n - baz\n - boo"+ ==-> "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n<ul>\n<li>\nboo\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM258" $+ "- foo\n - bar\n - baz\n - boo"+ ==-> "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n<li>\nboo\n</li>\n</ul>\n"+ it "CM259" $+ "10) foo\n - bar"+ ==-> "<ol start=\"10\">\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n"+ it "CM260" $+ "10) foo\n - bar"+ ==-> "<ol start=\"10\">\n<li>\nfoo\n</li>\n</ol>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM261" $+ "- - foo"+ ==-> "<ul>\n<li>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM262" $+ "1. - 2. foo"+ ==-> "<ol>\n<li>\n<ul>\n<li>\n<ol start=\"2\">\n<li>\nfoo\n</li>\n</ol>\n</li>\n</ul>\n</li>\n</ol>\n"+ it "CM263" $+ "- # Foo\n- Bar\n ---\n baz"+ ==-> "<ul>\n<li>\n<h1 id=\"foo\">Foo</h1>\n</li>\n<li>\n<p>Bar</p>\n<hr>\n<p>baz</p>\n</li>\n</ul>\n"+ context "5.3 Lists" $ do+ it "CM264" $+ "- foo\n- bar\n+ baz"+ ==-> "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ul>\n<ul>\n<li>\nbaz\n</li>\n</ul>\n"+ it "CM265" $+ "1. foo\n2. bar\n3) baz"+ ==-> "<ol>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ol>\n<ol start=\"3\">\n<li>\nbaz\n</li>\n</ol>\n"+ it "CM266" $+ "Foo\n- bar\n- baz"+ ==-> "<p>Foo</p>\n<ul>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n</ul>\n"+ it "CM267" $+ "The number of windows in my house is\n14. The number of doors is 6."+ ==-> "<p>The number of windows in my house is</p>\n<ol start=\"14\">\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"+ it "CM268" $+ "The number of windows in my house is\n1. The number of doors is 6."+ ==-> "<p>The number of windows in my house is</p>\n<ol>\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"+ it "CM269" $+ "- foo\n\n- bar\n\n\n- baz"+ ==-> "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<p>bar</p>\n</li>\n<li>\n<p>baz</p>\n</li>\n</ul>\n"+ it "CM270" $+ "- foo\n - bar\n - baz\n\n\n bim"+ ==-> "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\n<p>baz</p>\n<p>bim</p>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM271" $+ "- foo\n- bar\n\n<!-- -->\n\n- baz\n- bim"+ ==-> "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ul>\n<p><!-- --></p>\n<ul>\n<li>\nbaz\n</li>\n<li>\nbim\n</li>\n</ul>\n"+ it "CM272" $+ "- foo\n\n notcode\n\n- foo\n\n<!-- -->\n\n code"+ ==-> "<ul>\n<li>\n<p>foo</p>\n<p>notcode</p>\n</li>\n<li>\n<p>foo</p>\n</li>\n</ul>\n<p><!-- --></p>\n<pre><code>code\n</code></pre>\n"+ it "CM273" $+ "- a\n - b\n - c\n - d\n - e\n - f\n - g\n - h\n- i"+ ==-> "<ul>\n<li>\na\n</li>\n<li>\nb\n</li>\n<li>\nc\n</li>\n<li>\nd\n</li>\n<li>\ne\n</li>\n<li>\nf\n</li>\n<li>\ng\n</li>\n<li>\nh\n</li>\n<li>\ni\n</li>\n</ul>\n"+ it "CM274" $+ "1. a\n\n 2. b\n\n 3. c"+ ==-> "<ol>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ol>\n"+ it "CM275" $+ "- a\n- b\n\n- c"+ ==-> "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM276" $+ "* a\n*\n\n* c"+ ==-> "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p></p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM277" $+ "- a\n- b\n\n c\n- d"+ ==-> "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ it "CM278" $+ "- a\n- b\n\n [ref]: /url\n- d"+ ==-> "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ it "CM279" $+ "- a\n- ```\n b\n\n\n ```\n- c"+ ==-> "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<pre><code>b\n\n\n</code></pre>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM280" $+ "- a\n - b\n\n c\n- d"+ ==-> "<ul>\n<li>\na\n<ul>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n</ul>\n</li>\n<li>\nd\n</li>\n</ul>\n"+ it "CM281" $+ "* a\n > b\n >\n* c"+ ==-> "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<blockquote>\n</blockquote>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM282" $+ "- a\n > b\n ```\n c\n ```\n- d"+ ==-> "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<pre><code>c\n</code></pre>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ it "CM283" $+ "- a"+ ==-> "<ul>\n<li>\na\n</li>\n</ul>\n"+ it "CM284" $+ "- a\n - b"+ ==-> "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM285" $+ "1. ```\n foo\n ```\n\n bar"+ ==-> "<ol>\n<li>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</li>\n</ol>\n"+ it "CM286" $+ "* foo\n * bar\n\n baz"+ ==-> "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\nbaz\n</li>\n</ul>\n"+ it "CM287" $+ "- a\n - b\n - c\n\n- d\n - e\n - f"+ ==-> "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n<li>\nc\n</li>\n</ul>\n</li>\n<li>\nd\n<ul>\n<li>\ne\n</li>\n<li>\nf\n</li>\n</ul>\n</li>\n</ul>\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"+ ==-> "<p>!"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~</p>\n"+ it "CM290" $+ "\\\t\\A\\a\\ \\3\\φ\\«"+ ==-> "<p>\\\t\\A\\a\\ \\3\\φ\\«</p>\n"+ it "CM291" $+ "\\*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"+ ==-> "<p>*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"</p>\n"+ it "CM292" $+ let s = "\\\\*emphasis*"+ in s ~-> errFancy 2 (nonFlanking "*")+ it "CM293" $+ "foo\\\nbar"+ ==-> "<p>foo<br>\nbar</p>\n"+ it "CM294" $+ "`` \\[\\` ``"+ ==-> "<p><code>\\[\\`</code></p>\n"+ it "CM295" $+ " \\[\\]"+ ==-> "<pre><code>\\[\\]\n</code></pre>\n"+ it "CM296" $+ "~~~\n\\[\\]\n~~~"+ ==-> "<pre><code>\\[\\]\n</code></pre>\n"+ it "CM297" $+ "<http://example.com?find=*>"+ ==-> "<p><a href=\"http://example.com?find=*\">http://example.com?find=*</a></p>\n"+ it "CM298" $+ "<a href=\"/bar\\/)\">"+ ==-> "<p><a href="/bar/)"></p>\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```"+ ==-> "<pre><code class=\"language-foo+bar\">foo\n</code></pre>\n"+ context "6.2 Entity and numeric character references" $ do+ it "CM302" $+ " & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸"+ ==-> "<p> & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸</p>\n"+ it "CM303a" $+ "# Ӓ Ϡ"+ ==-> "<p># Ӓ Ϡ</p>\n"+ it "CM303b" $+ "�" ~-> errFancy 0 (invalidNumChar 98765432)+ it "CM303c" $+ "�" ~-> errFancy 0 (invalidNumChar 0)+ it "CM304" $+ "" ആ ಫ"+ ==-> "<p>" ആ ಫ</p>\n"+ it "CM305a" $+ " " ==-> "<p>&nbsp</p>\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?;" ==-> "<p>&hi?;</p>\n"+ it "CM306" $+ "©"+ ==-> "<p>&copy</p>\n"+ it "CM307" $+ let s = "&MadeUpEntity;"+ in s ~-> errFancy 0 (unknownEntity "MadeUpEntity")+ it "CM308" $+ "<a href=\"öö.html\">"+ ==-> "<p><a href="\246\246.html"></p>\n"+ it "CM309" $+ "[foo](/föö \"föö\")"+ ##-> p_ (a_ [href_ "/föö", title_ "f\246\246"] "foo")+ it "CM310" $+ "[foo]\n\n[foo]: /föö \"föö\""+ ##-> p_ (a_ [href_ "/föö", title_ "f\246\246"] "foo")+ it "CM311" $+ "``` föö\nfoo\n```"+ ==-> "<pre><code class=\"language-f\246\246\">foo\n</code></pre>\n"+ it "CM312" $+ "`föö`"+ ==-> "<p><code>f&ouml;&ouml;</code></p>\n"+ it "CM313" $+ " föfö"+ ==-> "<pre><code>f&ouml;f&ouml;\n</code></pre>\n"+ context "6.3 Code spans" $ do+ it "CM314" $+ "`foo`" ==-> "<p><code>foo</code></p>\n"+ it "CM315" $+ "`` foo ` bar ``"+ ==-> "<p><code>foo ` bar</code></p>\n"+ it "CM316" $+ "` `` `" ==-> "<p><code>``</code></p>\n"+ it "CM317" $+ "``\nfoo\n``" ==-> "<p><code>foo</code></p>\n"+ it "CM318" $+ "`foo bar\n baz`" ==-> "<p><code>foo bar baz</code></p>\n"+ it "CM319" $+ "`a b`" ==-> "<p><code>a b</code></p>\n"+ it "CM320" $+ "`foo `` bar`" ==-> "<p><code>foo `` bar</code></p>\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 = "`<a href=\"`\">`\n"+ in s ~-> err 14 (ueib <> etok '`' <> ecsc)+ it "CM325" $+ "<a href=\"`\">`"+ ==-> "<p><a href="<code>"></code></p>\n"+ it "CM326" $+ let s = "`<http://foo.bar.`baz>`\n"+ in s ~-> err 23 (ueib <> etok '`' <> ecsc)+ it "CM327" $+ "<http://foo.bar.`baz>`"+ ==-> "<p><http://foo.bar.<code>baz></code></p>\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*" ==-> "<p><em>foo bar</em></p>\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_" ==-> "<p><em>foo bar</em></p>\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*)*"+ ==-> "<p><em>(<em>foo</em>)</em></p>\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_)_"+ ==-> "<p><em>(<em>foo</em>)</em></p>\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" ==-> "<p><em>(bar)</em>.</p>\n"+ it "CM358" $+ "**foo bar**\n" ==-> "<p><strong>foo bar</strong></p>\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__" ==-> "<p><strong>foo bar</strong></p>\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__"+ ==-> "<p><strong>foo, <strong>bar</strong>, baz</strong></p>\n"+ it "CM370" $+ "foo-__\\(bar)__" ==-> "<p>foo-<strong>(bar)</strong></p>\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**)*"+ ==-> "<p><em>(<strong>foo</strong>)</em></p>\n"+ it "CM374" $+ "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**"+ ==-> "<p><strong>Gomphocarpus (<em>Gomphocarpus physocarpus</em>, syn.\n<em>Asclepias physocarpa</em>)</strong></p>\n"+ it "CM375" $+ "**foo \"*bar*\" foo**"+ ==-> "<p><strong>foo "<em>bar</em>" foo</strong></p>\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__)_"+ ==-> "<p><em>(<strong>foo</strong>)</em></p>\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__"+ ==-> "<p><strong>foo__bar__baz</strong></p>\n"+ it "CM383" $+ "__(bar\\)__."+ ==-> "<p><strong>(bar)</strong>.</p>\n"+ it "CM384" $+ "*foo [bar](/url)*"+ ==-> "<p><em>foo <a href=\"/url\">bar</a></em></p>\n"+ it "CM385" $+ "*foo\nbar*"+ ==-> "<p><em>foo\nbar</em></p>\n"+ it "CM386" $+ "_foo __bar__ baz_"+ ==-> "<p><em>foo <strong>bar</strong> baz</em></p>\n"+ it "CM387" $+ "_foo _bar_ baz_"+ ==-> "<p><em>foo <em>bar</em> baz</em></p>\n"+ it "CM388" $+ let s = "__foo_ bar_"+ in s ~-> err 5 (utoks "_ " <> etoks "__" <> eic)+ it "CM389" $+ "*foo *bar**"+ ==-> "<p><em>foo <em>bar</em></em></p>\n"+ it "CM390" $+ "*foo **bar** baz*"+ ==-> "<p><em>foo <strong>bar</strong> baz</em></p>\n"+ it "CM391" $+ let s = "*foo**bar**baz*\n"+ in s ~-> errFancy 5 (nonFlanking "*")+ it "CM392" $+ "***foo** bar*\n" ==-> "<p><em><strong>foo</strong> bar</em></p>\n"+ it "CM393" $+ "*foo **bar***\n" ==-> "<p><em>foo <strong>bar</strong></em></p>\n"+ it "CM394" $+ let s = "*foo**bar***\n"+ in s ~-> errFancy 5 (nonFlanking "*")+ it "CM395" $+ "*foo **bar *baz* bim** bop*\n"+ ==-> "<p><em>foo <strong>bar <em>baz</em> bim</strong> bop</em></p>\n"+ it "CM396" $+ "*foo [*bar*](/url)*\n"+ ==-> "<p><em>foo <a href=\"/url\"><em>bar</em></a></em></p>\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)**"+ ==-> "<p><strong>foo <a href=\"/url\">bar</a></strong></p>\n"+ it "CM400" $+ "**foo\nbar**"+ ==-> "<p><strong>foo\nbar</strong></p>\n"+ it "CM401" $+ "__foo _bar_ baz__"+ ==-> "<p><strong>foo <em>bar</em> baz</strong></p>\n"+ it "CM402" $+ "__foo __bar__ baz__"+ ==-> "<p><strong>foo <strong>bar</strong> baz</strong></p>\n"+ it "CM403" $+ "____foo__ bar__"+ ==-> "<p><strong><strong>foo</strong> bar</strong></p>\n"+ it "CM404" $+ "**foo **bar****"+ ==-> "<p><strong>foo <strong>bar</strong></strong></p>\n"+ it "CM405" $+ "**foo *bar* baz**"+ ==-> "<p><strong>foo <em>bar</em> baz</strong></p>\n"+ it "CM406" $+ let s = "**foo*bar*baz**\n"+ in s ~-> err 5 (utoks "*b" <> etoks "**" <> eic)+ it "CM407" $+ "***foo* bar**"+ ==-> "<p><strong><em>foo</em> bar</strong></p>\n"+ it "CM408" $+ "**foo *bar***"+ ==-> "<p><strong>foo <em>bar</em></strong></p>\n"+ it "CM409" $+ "**foo *bar **baz**\nbim* bop**"+ ==-> "<p><strong>foo <em>bar <strong>baz</strong>\nbim</em> bop</strong></p>\n"+ it "CM410" $+ "**foo [*bar*](/url)**"+ ==-> "<p><strong>foo <a href=\"/url\"><em>bar</em></a></strong></p>\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 *\\**" ==-> "<p>foo <em>*</em></p>\n"+ it "CM415" $+ "foo *\\_*\n" ==-> "<p>foo <em>_</em></p>\n"+ it "CM416" $+ let s = "foo *****\n"+ in s ~-> errFancy 8 (nonFlanking "*")+ it "CM417" $+ "foo **\\***" ==-> "<p>foo <strong>*</strong></p>\n"+ it "CM418" $+ "foo **\\_**\n" ==-> "<p>foo <strong>_</strong></p>\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 _\\__" ==-> "<p>foo <em>_</em></p>\n"+ it "CM427" $+ "foo _\\*_" ==-> "<p>foo <em>*</em></p>\n"+ it "CM428" $+ let s = "foo _____\n"+ in s ~-> errFancy 8 (nonFlanking "_")+ it "CM429" $+ "foo __\\___" ==-> "<p>foo <strong>_</strong></p>\n"+ it "CM430" $+ "foo __\\*__" ==-> "<p>foo <strong>*</strong></p>\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**" ==-> "<p><strong>foo</strong></p>\n"+ it "CM438" $+ "*_foo_*" ==-> "<p><em><em>foo</em></em></p>\n"+ it "CM439" $+ "__foo__" ==-> "<p><strong>foo</strong></p>\n"+ it "CM440" $+ "_*foo*_" ==-> "<p><em><em>foo</em></em></p>\n"+ it "CM441" $+ "****foo****" ==-> "<p><strong><strong>foo</strong></strong></p>\n"+ it "CM442" $+ "____foo____" ==-> "<p><strong><strong>foo</strong></strong></p>\n"+ it "CM443" $+ "******foo******"+ ==-> "<p><strong><strong><strong>foo</strong></strong></strong></p>\n"+ it "CM444" $+ "***foo***" ==-> "<p><em><strong>foo</strong></em></p>\n"+ it "CM445" $+ "_____foo_____"+ ==-> "<p><strong><strong><em>foo</em></strong></strong></p>\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 = "*<img src=\"foo\" title=\"*\"/>\n"+ in s ~-> errFancy 23 (nonFlanking "*")+ it "CM453" $+ let s = "**<a href=\"**\">"+ in s ~-> errFancy 11 (nonFlanking "**")+ it "CM454" $+ let s = "__<a href=\"__\">\n"+ in s ~-> errFancy 11 (nonFlanking "__")+ it "CM455" $+ "*a `*`*" ==-> "<p><em>a <code>*</code></em></p>\n"+ it "CM456" $+ "_a `_`_" ==-> "<p><em>a <code>_</code></em></p>\n"+ it "CM457" $+ let s = "**a<http://foo.bar/?q=**>"+ in s ~-> err 25 (ueib <> etoks "**" <> eic)+ it "CM458" $+ let s = "__a<http://foo.bar/?q=__>"+ 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)"+ ==-> "<p><a href=\"/uri\">link</a></p>\n"+ it "CM461" $+ let s = "[link]()"+ in s+ ~-> err+ 7+ (utok ')' <> etok '<' <> elabel "URI" <> ews)+ it "CM462" $+ "[link](<>)"+ ==-> "<p><a href>link</a></p>\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](</my uri>)\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](<foo\nbar>)\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"+ ==-> "<p><a href=\"foo(and(bar\">link</a>))</p>\n"+ it "CM469" $+ let s = "[link](foo\\(and\\(bar\\))"+ in s ~-> err 10 (utok '\\' <> euric <> euri)+ it "CM470" $+ "[link](<foo(and(bar)>)"+ ==-> "<p><a href=\"foo(and(bar)\">link</a></p>\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"+ ==-> "<p><a href=\"#fragment\">link</a></p>\n<p><a href=\"http://example.com#fragment\">link</a></p>\n<p><a href=\"http://example.com?foo=3#frag\">link</a></p>\n"+ it "CM473" $+ let s = "[link](foo\\bar)"+ in s ~-> err 10 (utok '\\' <> euric <> euri)+ it "CM474" $+ "[link](foo%20bä)"+ ==-> "<p><a href=\"foo%20b&auml;\">link</a></p>\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"+ ==-> "<p><a href=\"/uri\">link [bar</a></p>\n"+ it "CM487" $+ "[link *foo **bar** `#`*](/uri)"+ ==-> "<p><a href=\"/uri\">link <em>foo <strong>bar</strong> <code>#</code></em></a></p>\n"+ it "CM488" $+ "[](/uri)"+ ==-> "<p><a href=\"/uri\"><img alt=\"moon\" src=\"moon.jpg\"></a></p>\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 = "](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 <bar attr=\"](baz)\">"+ ==-> "<p><a href=\"baz\">foo <bar attr="</a>"></p>\n"+ it "CM496" $+ let s = "[foo`](/uri)`\n"+ in s ~-> err 13 (ueib <> etok ']' <> eic)+ it "CM497" $+ "[foo<http://example.com/?search=](uri)>"+ ==-> "<p><a href=\"uri\">foo<http://example.com/?search=</a>></p>\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"+ ==-> "<p><a href=\"/uri\">link [bar</a></p>\n"+ it "CM501" $+ "[link *foo **bar** `#`*][ref]\n\n[ref]: /uri"+ ==-> "<p><a href=\"/uri\">link <em>foo <strong>bar</strong> <code>#</code></em></a></p>\n"+ it "CM502" $+ "[][ref]\n\n[ref]: /uri"+ ==-> "<p><a href=\"/uri\"><img alt=\"moon\" src=\"moon.jpg\"></a></p>\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 <bar attr=\"][ref]\">\n\n[ref]: /uri"+ ==-> "<p><a href=\"/uri\">foo <bar attr="</a>"></p>\n"+ it "CM508" $+ let s = "[foo`][ref]`\n\n[ref]: /uri"+ in s ~-> err 12 (ueib <> etok ']' <> eic)+ it "CM509" $+ "[foo<http://example.com/?search=][ref]>\n\n[ref]: /uri"+ ==-> "<p><a href=\"/uri\">foo<http://example.com/?search=</a>></p>\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"+ ==-> "<p><a href=\"/url\">Толпой</a> is a Russian word.</p>\n"+ it "CM512" $+ "[Foo\n bar]: /url\n\n[Baz][Foo bar]"+ ==-> "<p><a href=\"/url\">Baz</a></p>\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"+ ==-> "<p><a href=\"/url\">bar</a></p>\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"+ ==-> "<p><a href=\"/uri\">foo</a></p>\n"+ it "CM521" $+ "[bar\\\\]: /uri\n\n[bar\\\\]"+ ==-> "<p><a href=\"/uri\">bar\\</a></p>\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"+ ==-> "<p><a href=\"/url\">foo</a> bar</p>\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"+ ==-> "<p><a href=\"/url2\">foo</a></p>\n"+ it "CM537" $+ "[foo][]\n\n[foo]: /url1"+ ==-> "<p><a href=\"/url1\">foo</a></p>\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"+ ==-> "<p><a href=\"/url2\">foo</a><a href=\"/url1\">baz</a></p>\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\")"+ ==-> "<p><img alt=\"foo\" title=\"title\" src=\"/url\"></p>\n"+ it "CM544" $+ "![foo *bar*](train.jpg \"train & tracks\")"+ ==-> "<p><img alt=\"foo bar\" title=\"train & tracks\" src=\"train.jpg\"></p>\n"+ it "CM545" $+ let s = "](/url2)\n"+ in s ~-> err 6 (utok '!' <> etok ']' <> eic)+ it "CM546" $+ "](/url2)"+ ==-> "<p><img alt=\"foo bar\" src=\"/url2\"></p>\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\""+ ==-> "<p><img alt=\"foo bar\" title=\"train & tracks\" src=\"train.jpg\"></p>\n"+ it "CM549" $+ ""+ ==-> "<p><img alt=\"foo\" src=\"train.jpg\"></p>\n"+ it "CM550" $+ "My ![foo bar](/path/to/train.jpg \"title\" )"+ ==-> "<p>My <img alt=\"foo bar\" title=\"title\" src=\"/path/to/train.jpg\"></p>\n"+ it "CM551" $+ ""+ ==-> "<p><img alt=\"foo\" src=\"url\"></p>\n"+ it "CM552" $+ "" ==-> "<p><img alt src=\"/url\"></p>\n"+ it "CM553" $+ "![foo][bar]\n\n[bar]: /url"+ ==-> "<p><img alt=\"foo\" src=\"/url\"></p>\n"+ it "CM554" $+ "![foo][bar]\n\n[BAR]: /url"+ ==-> "<p><img alt=\"foo\" src=\"/url\"></p>\n"+ it "CM555" $+ "![foo][]\n\n[foo]: /url \"title\""+ ==-> "<p><img alt=\"foo\" title=\"title\" src=\"/url\"></p>\n"+ it "CM556" $+ "![foo bar][]\n\n[foo bar]: /url \"title\""+ ==-> "<p><img alt=\"foo bar\" title=\"title\" src=\"/url\"></p>\n"+ it "CM557" $+ "![Foo][]\n\n[foo]: /url \"title\""+ ==-> "<p><img alt=\"Foo\" title=\"title\" src=\"/url\"></p>\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\""+ ==-> "<p><img alt=\"foo\" title=\"title\" src=\"/url\"></p>\n"+ it "CM560" $+ "![*foo* bar]\n\n[foo bar]: /url \"title\"\n"+ ==-> "<p><img alt=\"foo bar\" title=\"title\" src=\"/url\"></p>\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\""+ ==-> "<p><img alt=\"Foo\" title=\"title\" src=\"/url\"></p>\n"+ it "CM563" $+ "!\\[foo\\]\n\n[foo]: /url \"title\""+ ==-> "<p>![foo]</p>\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>"+ ==-> "<p><a href=\"http://foo.bar.baz\">http://foo.bar.baz</a></p>\n"+ it "CM566" $+ "<http://foo.bar.baz/test?q=hello&id=22&boolean>"+ ==-> "<p><a href=\"http://foo.bar.baz/test?q=hello&id=22&boolean\">http://foo.bar.baz/test?q=hello&id=22&boolean</a></p>\n"+ it "CM567" $+ "<irc://foo.bar:2233/baz>"+ ==-> "<p><a href=\"irc://foo.bar:2233/baz\">irc://foo.bar:2233/baz</a></p>\n"+ it "CM568" $+ "<MAILTO:FOO@BAR.BAZ>"+ ==-> "<p><a href=\"mailto:FOO@BAR.BAZ\">FOO@BAR.BAZ</a></p>\n"+ it "CM569" $+ "<a+b+c:d>"+ ==-> "<p><a href=\"a+b+c:d\">a+b+c:d</a></p>\n"+ it "CM570" $+ "<made-up-scheme://foo,bar>"+ ==-> "<p><a href=\"made-up-scheme://foo/,bar\">made-up-scheme://foo/,bar</a></p>\n"+ it "CM571" $+ "<http://../>"+ ==-> "<p><a href=\"http://..\">http://..</a></p>\n"+ it "CM572" $+ "<localhost:5001/foo>"+ ==-> "<p><a href=\"localhost:5001/foo\">localhost:5001/foo</a></p>\n"+ it "CM573" $+ "<http://foo.bar/baz bim>\n"+ ==-> "<p><http://foo.bar/baz bim></p>\n"+ it "CM574" $+ "<http://example.com/\\[\\>"+ ==-> "<p><http://example.com/[></p>\n"+ it "CM575" $+ "<foo@bar.example.com>"+ ==-> "<p><a href=\"mailto:foo@bar.example.com\">foo@bar.example.com</a></p>\n"+ it "CM576" $+ "<foo+special@Bar.baz-bar0.com>"+ ==-> "<p><a href=\"mailto:foo+special@Bar.baz-bar0.com\">foo+special@Bar.baz-bar0.com</a></p>\n"+ it "CM577" $+ "<foo\\+@bar.example.com>"+ ==-> "<p><foo+@bar.example.com></p>\n"+ it "CM578" $+ "<>"+ ==-> "<p><></p>\n"+ it "CM579" $+ "< http://foo.bar >"+ ==-> "<p>< http://foo.bar ></p>\n"+ it "CM580" $+ "<m:abc>"+ ==-> "<p><a href=\"m:abc\">m:abc</a></p>\n"+ it "CM581" $+ "<foo.bar.baz>"+ ==-> "<p><a href=\"foo.bar.baz\">foo.bar.baz</a></p>\n"+ it "CM582" $+ "http://example.com"+ ==-> "<p>http://example.com</p>\n"+ it "CM583" $+ "foo@bar.example.com"+ ==-> "<p>foo@bar.example.com</p>\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"+ ==-> "<p>foo\nbaz</p>\n"+ it "CM606" $+ "foo\\\nbaz\n"+ ==-> "<p>foo<br>\nbaz</p>\n"+ it "CM607" $+ "foo \nbaz"+ ==-> "<p>foo\nbaz</p>\n"+ it "CM608" $+ "foo \n bar"+ ==-> "<p>foo\nbar</p>\n"+ it "CM609" $+ "foo\\\n bar"+ ==-> "<p>foo<br>\nbar</p>\n"+ it "CM610" $+ "*foo \nbar*"+ ==-> "<p><em>foo\nbar</em></p>\n"+ it "CM611" $+ "*foo\\\nbar*"+ ==-> "<p><em>foo<br>\nbar</em></p>\n"+ it "CM612" $+ "`code \nspan`"+ ==-> "<p><code>code span</code></p>\n"+ it "CM613" $+ "`code\\\nspan`"+ ==-> "<p><code>code\\ span</code></p>\n"+ it "CM614" $+ "<a href=\"foo \nbar\">"+ ==-> "<p><a href="foo\nbar"></p>\n"+ it "CM615" $+ "<a href=\"foo\\\nbar\">"+ ==-> "<p><a href="foo<br>\nbar"></p>\n"+ it "CM616" $+ "foo\\"+ ==-> "<p>foo\\</p>\n"+ it "CM617" $+ "foo "+ ==-> "<p>foo</p>\n"+ it "CM618" $+ "### foo\\"+ ==-> "<h3 id=\"foo\">foo\\</h3>\n"+ it "CM619" $+ "### foo "+ ==-> "<h3 id=\"foo\">foo</h3>\n"+ context "6.10 Soft line breaks" $ do+ it "CM620" $+ "foo\nbaz"+ ==-> "<p>foo\nbaz</p>\n"+ it "CM621" $+ "foo \n baz"+ ==-> "<p>foo\nbaz</p>\n"+ context "6.11 Textual content" $ do+ it "CM622" $+ "hello $.;'there"+ ==-> "<p>hello $.;'there</p>\n"+ it "CM623" $+ "Foo χρῆν"+ ==-> "<p>Foo χρῆν</p>\n"+ it "CM624" $+ "Multiple spaces"+ ==-> "<p>Multiple spaces</p>\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."+ ==-> "<p>It's <del>bad</del> news.</p>\n"+ it "combines with emphasis" $+ "**It's ~~bad~~** news."+ ==-> "<p><strong>It's <del>bad</del></strong> news.</p>\n"+ it "interacts with subscript reasonably (1)" $+ "It's ~~~bad~~ news~."+ ==-> "<p>It's <sub><del>bad</del> news</sub>.</p>\n"+ it "interacts with subscript reasonably (2)" $+ "It's ~~~bad~ news~~."+ ==-> "<p>It's <del><sub>bad</sub> news</del>.</p>\n"+ context "subscript" $ do+ it "works in simplest form" $+ "It's ~bad~ news."+ ==-> "<p>It's <sub>bad</sub> news.</p>\n"+ it "combines with emphasis" $+ "**It's ~bad~** news."+ ==-> "<p><strong>It's <sub>bad</sub></strong> news.</p>\n"+ context "superscript" $ do+ it "works in simplest form" $+ "It's ^bad^ news."+ ==-> "<p>It's <sup>bad</sup> news.</p>\n"+ it "combines with emphasis" $+ "**It's ^bad^** news."+ ==-> "<p><strong>It's <sup>bad</sup></strong> news.</p>\n"+ it "a composite, complex example" $+ "***Something ~~~is not~~ going~ ^so well^** today*."+ ==-> "<p><em><strong>Something <sub><del>is not</del> going</sub> <sup>so well</sup></strong> today</em>.</p>\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 = "<table>\n<thead>\n<tr><th>Foo</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td></tr>\n</tbody>\n</table>\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- | ---"+ ==-> "<p>Foo | Bar\nab- | ---</p>\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 | \\|"+ ==-> "<table>\n<thead>\n<tr><th>Foo |</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>|</td></tr>\n</tbody>\n</table>\n"+ it "escaped characters preserve backslashes for inline-level parser" $+ "Foo | Bar\n--- | ---\n\\*foo\\* | bar"+ ==-> "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>*foo*</td><td>bar</td></tr>\n</tbody>\n</table>\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"+ ==-> "<table>\n<thead>\n<tr><th><code>|Foo|</code></th><th><code>|Bar|</code></th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>bar</td></tr>\n</tbody>\n</table>\n"+ it "pipes in code spans in cells do not fool the parser" $+ "Foo | Bar\n--- | ---\n`|foo|` | `|bar|`"+ ==-> "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td><code>|foo|</code></td><td><code>|bar|</code></td></tr>\n</tbody>\n</table>\n"+ it "multi-line code spans are disallowed in table headers" $+ "`Foo\nBar` | Bar\n--- | ---\nfoo | bar"+ ==-> "<p><code>Foo Bar</code> | Bar\n--- | ---\nfoo | bar</p>\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--- | ---"+ ==-> "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"+ it "recognizes end of table correctly" $+ "Foo | Bar\n--- | ---\nfoo | bar\n\nHere goes a paragraph."+ ==-> "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>bar</td></tr>\n</tbody>\n</table>\n<p>Here goes a paragraph.</p>\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"+ ==-> "<table>\n<thead>\n<tr><th>+ foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"+ "+ foo | bar\n -----|----\n"+ ==-> "<table>\n<thead>\n<tr><th>+ foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"+ it "tables have higher precedence than ordered lists" $ do+ "1. foo | bar\n-------|----\n"+ ==-> "<table>\n<thead>\n<tr><th>1. foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"+ "1. foo | bar\n ------|----\n"+ ==-> "<table>\n<thead>\n<tr><th>1. foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"+ it "if table is indented inside unordered list, it's put there" $+ "+ foo | bar\n ----|----\n"+ ==-> "<ul>\n<li>\n<table>\n<thead>\n<tr><th>foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</li>\n</ul>\n"+ it "if table is indented inside ordered list, it's put there" $+ "1. foo | bar\n ----|----\n"+ ==-> "<ol>\n<li>\n<table>\n<thead>\n<tr><th>foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</li>\n</ol>\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` "<p>Here we go...</p>\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` "<p>Here we go.123</p>\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+#ifdef ghcjs_HOST_OS+ let r = object []+#else+ let r = object+ [ "x" .= Number 100+ , "y" .= Number 200 ]+#endif+ 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++#ifndef ghcjs_HOST_OS+ context "when it is invalid" $ do+ let mappingErr = fancy . ErrorCustom . YamlParseError $+ "mapping values are not allowed in this context"+ it "signal 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)+ ]+#endif++----------------------------------------------------------------------------+-- 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 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 :: Stream s => ET s+ueib = ulabel "end of inline block"++-- | Expecting end of inline block.+eeib :: Stream s => ET s+eeib = elabel "end of inline block"++-- | Expecting end of URI.+euri :: Stream s => ET s+euri = elabel "end of URI"++-- | Expecting inline content.+eic :: Stream s => ET s+eic = elabel "inline content"++-- | Expecting white space.+ews :: Stream s => ET s+ews = elabel "white space"++-- | Expecting code span content.+ecsc :: Stream s => 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"+ ]++-- | 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++-- | Error component complaining that the given starting index of an ordered+-- list is too big.+indexTooBig :: Word -> EF MMarkErr+indexTooBig = fancy . ErrorCustom . ListStartIndexTooBig++-- | Error component complaining about non-consecutive indices in an ordered+-- list.+indexNonCons :: Word -> Word -> EF MMarkErr+indexNonCons actual expected =+ fancy . ErrorCustom $+ ListIndexOutOfOrder actual expected++-- | Error component complaining about a missing link\/image reference.+couldNotMatchRef :: Text -> [Text] -> EF MMarkErr+couldNotMatchRef name names =+ fancy . ErrorCustom $+ CouldNotFindReferenceDefinition name names++-- | Error component complaining about a duplicate reference definition.+duplicateRef :: Text -> EF MMarkErr+duplicateRef = fancy . ErrorCustom . DuplicateReferenceDefinition++-- | Error component complaining about an invalid numeric character.+invalidNumChar :: Int -> EF MMarkErr+invalidNumChar = fancy . ErrorCustom . InvalidNumericCharacter++-- | Error component complaining about an unknown HTML5 entity name. unknownEntity :: Text -> EF MMarkErr unknownEntity = fancy . ErrorCustom . UnknownHtmlEntityName