diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,24 @@ +## MMark 0.0.3.2 + +* Empty strings are not parsed as URIs anymore (even though a valid URI may + be represented as the empty string). Instead, it's now possible to write + an empty URI using the `<>` syntax (which previously was not recognized as + a URI in some contexts). + +* Improved parse errors related to parsing of titles in links, images, and + reference definitions. + +* Parsing of reference definitions now can recover from failures, so the + parser doesn't choke on malformed reference definitions anymore. + +* Reduced allocations and improved speed of the parser significantly. + ## MMark 0.0.3.1 * Fixed a couple of bugs in the parser for reference definitions. * Now link and image titles may contain newline character as per the Common - Mark spec. They also may contain blank lines, which is against the spec - though. + Mark spec. ## MMark 0.0.3.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -203,8 +203,9 @@ character references is provided. In addition to that, when a URI reference in not enclosed with `<` and `>`, then closing parenthesis character `)` is not considered part of URI (use `` syntax if you - want a closing parenthesis as part of a URI). -* Titles in links and images can contain blank lines. + want a closing parenthesis as part of a URI). Since the empty string is a + valid URI and it may be confusing in some cases, we also force the user to + write `<>` to represent the empty URI. * Putting links in text of another link is not allowed, i.e. no nested links is possible. * Putting images in description of other images is not allowed (similarly to diff --git a/Text/MMark/Extension.hs b/Text/MMark/Extension.hs --- a/Text/MMark/Extension.hs +++ b/Text/MMark/Extension.hs @@ -111,7 +111,6 @@ -> (a -> Bni -> a) -- ^ Folding function -> L.Fold Bni a -- ^ Resulting 'L.Fold' scanner a f = L.Fold f a id -{-# INLINE scanner #-} -- | Create a 'L.FoldM' from an initial state and a folding function -- operating in monadic context. @@ -124,4 +123,3 @@ -> (a -> Bni -> m a) -- ^ Folding function -> L.FoldM m Bni a -- ^ Resulting 'L.FoldM' scannerM a f = L.FoldM f a return -{-# INLINE scannerM #-} diff --git a/Text/MMark/Internal.hs b/Text/MMark/Internal.hs --- a/Text/MMark/Internal.hs +++ b/Text/MMark/Internal.hs @@ -237,7 +237,6 @@ -> L.Fold Bni a -- ^ 'L.Fold' to use -> a -- ^ Result of scanning runScanner MMark {..} f = L.fold f mmarkBlocks -{-# INLINE runScanner #-} -- | Like 'runScanner', but allows to run scanners with monadic context. -- @@ -252,7 +251,6 @@ -> L.FoldM m Bni a -- ^ 'L.FoldM' to use -> m a -- ^ Result of scanning runScannerM MMark {..} f = L.foldM f mmarkBlocks -{-# INLINE runScannerM #-} ---------------------------------------------------------------------------- -- Renders diff --git a/Text/MMark/Parser.hs b/Text/MMark/Parser.hs --- a/Text/MMark/Parser.hs +++ b/Text/MMark/Parser.hs @@ -25,9 +25,10 @@ import Control.Applicative import Control.Monad import Data.Bifunctor (Bifunctor (..)) +import Data.Bool (bool) import Data.HTML.Entities (htmlEntityMap) import Data.List.NonEmpty (NonEmpty (..), (<|)) -import Data.Maybe (isNothing, fromJust, fromMaybe, catMaybes) +import Data.Maybe (isNothing, fromJust, fromMaybe, catMaybes, isJust) import Data.Monoid (Any (..)) import Data.Semigroup (Semigroup (..)) import Data.Text (Text) @@ -39,6 +40,7 @@ import Text.URI (URI) import qualified Control.Applicative.Combinators.NonEmpty as NE 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 @@ -72,22 +74,6 @@ | DoubleFrame InlineFrame InlineFrame -- ^ Two frames to be closed deriving (Eq, Ord, Show) --- | An auxiliary type for collapsing levels of 'Either's. - -data Pair s a - = PairL s - | PairR ([a] -> [a]) - -instance Semigroup s => Semigroup (Pair s a) where - (PairL l) <> (PairL r) = PairL (l <> r) - (PairL l) <> (PairR _) = PairL l - (PairR _) <> (PairL r) = PairL r - (PairR l) <> (PairR r) = PairR (l . r) - -instance Semigroup s => Monoid (Pair s a) where - mempty = PairR id - mappend = (<>) - ---------------------------------------------------------------------------- -- Top-level API @@ -111,18 +97,15 @@ Right ((myaml, rawBlocks), defs) -> let parsed = doInline <$> rawBlocks doInline = fmap - $ first (nes . replaceEof "end of inline block") + $ first (replaceEof "end of inline block") . runIParser defs pInlinesTop - f block = - case foldMap e2p block of - PairL errs -> PairL errs - PairR _ -> PairR (fmap fromRight block :) - in case foldMap f parsed of - PairL errs -> Left errs - PairR blocks -> Right MMark + e2p = either DList.singleton (const DList.empty) + in case NE.nonEmpty . DList.toList $ foldMap (foldMap e2p) parsed of + Nothing -> Right MMark { mmarkYaml = myaml - , mmarkBlocks = blocks [] + , mmarkBlocks = fmap fromRight <$> parsed , mmarkExtension = mempty } + Just errs -> Left errs ---------------------------------------------------------------------------- -- Block parser @@ -188,7 +171,7 @@ , Just <$> pUnorderedList , Just <$> pOrderedList , Just <$> pBlockquote - , Nothing <$ pReferenceDef + , pReferenceDef , Just <$> pParagraph ] _ -> Just <$> pIndentedCodeBlock @@ -316,7 +299,7 @@ let tooFar = sourceLine p > sourceLine bulletPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel - then return [if tooFar then emptyParagraph else emptyNaked] + then return [bool Naked Paragraph tooFar emptyIspSpan] else subEnv True rlevel pBlocks -- | Parse a list bullet. Return a tuple with the following components (in @@ -373,7 +356,7 @@ let tooFar = sourceLine p > sourceLine indexPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel - then return [if tooFar then emptyParagraph else emptyNaked] + then return [bool Naked Paragraph tooFar emptyIspSpan] else subEnv True rlevel pBlocks -- | Parse a list index. Return a tuple with the following components (in @@ -425,21 +408,30 @@ -- | Parse a link\/image reference definition and register it. -pReferenceDef :: BParser () +pReferenceDef :: BParser (Maybe (Block Isp)) pReferenceDef = do - (pos, dlabel) <- try $ pRefLabel <* char ':' - sc' <* optional eol <* sc' - uri <- pUri - mtitle <- optional . try $ do - try (sc1' *> optional eol *> sc') <|> (sc' *> eol *> sc') - pTitle - sc' - eof <|> eol - conflict <- registerReference dlabel (uri, mtitle) - when conflict $ do - setPosition pos - customFailure (DuplicateReferenceDefinition dlabel) - sc + (pos, dlabel) <- try (pRefLabel <* char ':') + withRecovery recover $ do + sc' <* optional eol <* sc' + uri <- pUri + 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 + conflict <- registerReference dlabel (uri, mtitle) + when conflict $ do + setPosition pos + customFailure (DuplicateReferenceDefinition dlabel) + Nothing <$ sc + where + recover err = + Just (Naked (IspError err)) <$ takeWhileP Nothing notNewline <* sc -- | Parse a paragraph or naked text (is some cases). @@ -583,7 +575,6 @@ pAutolink :: IParser Inline pAutolink = between (char '<') (char '>') $ do - notFollowedBy (char '>') -- empty links don't make sense uri' <- URI.parser let (txt, uri) = case isEmailUri uri' of @@ -682,10 +673,14 @@ return (dest, mtitle) where inplace = do - void (char '(') <* sc - dest <- pUri - mtitle <- optional (sc1 *> pTitle) - sc <* char ')' + void (char '(') + sc' + dest <- pUri + hadSpace <- option False (True <$ sc1) + mtitle <- if hadSpace + then optional pTitle <* sc' + else return Nothing + void (char ')') return (dest, mtitle) withRef = pRefLabel >>= uncurry lookupRef @@ -711,13 +706,14 @@ -- | Parse a URI. pUri :: (Ord e, Show e, MonadParsec e Text m) => m URI -pUri = - between (char '<') (char '>') URI.parser <|> naked +pUri = between (char '<') (char '>') URI.parser <|> naked where naked = do let f x = not (isSpaceN x || x == ')') - l = "end of URI literal" + l = "end of URI" (s, s') <- T.span f <$> getInput + when (T.null s) . void $ + (satisfy f "URI") -- this will now fail setInput s r <- region (replaceEof l) (URI.parser <* label l eof) setInput s' @@ -802,6 +798,19 @@ ---------------------------------------------------------------------------- -- Parsing helpers +manyIndexed :: (Alternative m, Num n) => n -> (n -> m a) -> m [a] +manyIndexed n' m = go n' + where + go !n = liftA2 (:) (m n) (go (n + 1)) <|> pure [] + +foldMany :: Alternative f => f (a -> a) -> f (a -> a) +foldMany f = go + where + go = (flip (.) <$> f <*> go) <|> pure id + +foldSome :: Alternative f => f (a -> a) -> f (a -> a) +foldSome f = flip (.) <$> f <*> foldMany f + nonEmptyLine :: BParser Text nonEmptyLine = takeWhile1P Nothing notNewline @@ -949,8 +958,7 @@ stripIndent :: Pos -> Text -> Text stripIndent indent txt = T.drop m txt where - m = snd $ T.foldl' f (0, 0) (T.takeWhile p txt) - p x = isSpace x || x == '>' + m = snd $ T.foldl' f (0, 0) (T.takeWhile isSpace txt) f (!j, !n) ch | j >= i = (j, n) | ch == ' ' = (j + 1, n + 1) @@ -1037,24 +1045,8 @@ r <- takeRest return (SourcePos file l c, r) -emptyParagraph :: Block Isp -emptyParagraph = Paragraph (IspSpan (initialPos "") "") - -emptyNaked :: Block Isp -emptyNaked = Naked (IspSpan (initialPos "") "") - -manyIndexed :: (Alternative m, Num n) => n -> (n -> m a) -> m [a] -manyIndexed n' m = go n' - where - go !n = liftA2 (:) (m n) (go (n + 1)) <|> pure [] - -foldMany :: Alternative f => f (a -> a) -> f (a -> a) -foldMany f = go - where - go = (flip (.) <$> f <*> go) <|> pure id - -foldSome :: Alternative f => f (a -> a) -> f (a -> a) -foldSome f = flip (.) <$> f <*> foldMany f +emptyIspSpan :: Isp +emptyIspSpan = IspSpan (initialPos "") "" normalizeListItems :: NonEmpty [Block Isp] -> NonEmpty [Block Isp] normalizeListItems xs' = @@ -1075,11 +1067,6 @@ toParagraph other = other toNaked (Paragraph inner) = Naked inner toNaked other = other - -e2p :: Either a b -> Pair a b -e2p = \case - Left a -> PairL a - Right b -> PairR (b:) succeeds :: Alternative m => m () -> m Bool succeeds m = True <$ m <|> pure False diff --git a/Text/MMark/Parser/Internal.hs b/Text/MMark/Parser/Internal.hs --- a/Text/MMark/Parser/Internal.hs +++ b/Text/MMark/Parser/Internal.hs @@ -10,8 +10,7 @@ -- An internal module that builds a framework on which the -- "Text.MMark.Parser" module is built. -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} module Text.MMark.Parser.Internal ( -- * Block-level parser monad @@ -44,7 +43,6 @@ , MMarkErr (..) ) where -import Control.Applicative import Control.Monad.State.Strict import Data.Default.Class import Data.Function ((&)) @@ -67,14 +65,7 @@ -- | Block-level parser type. -newtype BParser a = BParser - { unBParser :: ParsecT MMarkErr Text (State BlockState) a } - deriving ( Functor - , Applicative - , Alternative - , Monad - , MonadPlus - , MonadParsec MMarkErr Text ) +type BParser a = ParsecT MMarkErr Text (State BlockState) a -- | Run a computation in the 'BParser' monad. @@ -87,7 +78,7 @@ -- ^ Input to parse -> Either (NonEmpty (ParseError Char MMarkErr)) (a, Defs) -- ^ Result of parsing -runBParser (BParser p) file input = +runBParser p file input = case runState (runParserT p file input) def of (Left err, _) -> Left (err :| []) (Right x, st) -> Right (x, st ^. bstDefs) @@ -95,12 +86,12 @@ -- | Ask whether naked paragraphs are allowed in this context. isNakedAllowed :: BParser Bool -isNakedAllowed = BParser $ gets (^. bstAllowNaked) +isNakedAllowed = gets (^. bstAllowNaked) -- | Lookup current reference indentation level. refLevel :: BParser Pos -refLevel = BParser $ gets (^. bstRefLevel) +refLevel = gets (^. bstRefLevel) -- | Execute 'BParser' computation with modified environment. @@ -109,11 +100,9 @@ -> Pos -- ^ Reference indentation level -> BParser a -- ^ The parser we want to set the environment for -> BParser a -- ^ The resulting parser -subEnv allowNaked rlevel - = BParser - . locally bstAllowNaked allowNaked - . locally bstRefLevel rlevel - . unBParser +subEnv allowNaked rlevel = + locally bstAllowNaked allowNaked . + locally bstRefLevel rlevel -- | Register a reference (link\/image) definition. @@ -138,7 +127,7 @@ -> Text -- ^ Definition name -> a -- ^ Data -> BParser Bool -- ^ 'True' if there is a conflicting definition -registerGeneric l name a = BParser $ do +registerGeneric l name a = do let dlabel = mkDefLabel name defs <- gets (^. bstDefs . l) if HM.member dlabel defs @@ -152,14 +141,7 @@ -- | Inline-level parser type. -newtype IParser a = IParser - { unIParser :: StateT InlineState (Parsec MMarkErr Text) a } - deriving ( Functor - , Applicative - , Alternative - , Monad - , MonadPlus - , MonadParsec MMarkErr Text ) +type IParser a = StateT InlineState (Parsec MMarkErr Text) a -- | Run a computation in the 'IParser' monad. @@ -174,7 +156,7 @@ -> Either (ParseError Char MMarkErr) a -- ^ Result of parsing runIParser _ _ (IspError err) = Left err -runIParser defs (IParser p) (IspSpan startPos input) = +runIParser defs p (IspSpan startPos input) = snd (runParser' (evalStateT p ist) pst) where ist = def & istDefs .~ defs @@ -188,53 +170,53 @@ -- | Disallow parsing of empty inlines. disallowEmpty :: IParser a -> IParser a -disallowEmpty = IParser . locally istAllowEmpty False . unIParser +disallowEmpty = locally istAllowEmpty False -- | Ask whether parsing of empty inlines is allowed. isEmptyAllowed :: IParser Bool -isEmptyAllowed = IParser . gets $ view istAllowEmpty +isEmptyAllowed = gets (view istAllowEmpty) -- | Disallow parsing of links. disallowLinks :: IParser a -> IParser a -disallowLinks = IParser . locally istAllowLinks False . unIParser +disallowLinks = locally istAllowLinks False -- | Ask whether parsing of links is allowed. isLinksAllowed :: IParser Bool -isLinksAllowed = IParser . gets $ view istAllowLinks +isLinksAllowed = gets (view istAllowLinks) -- | Disallow parsing of images. disallowImages :: IParser a -> IParser a -disallowImages = IParser . locally istAllowImages False . unIParser +disallowImages = locally istAllowImages False -- | Ask whether parsing of images is allowed. isImagesAllowed :: IParser Bool -isImagesAllowed = IParser . gets $ view istAllowImages +isImagesAllowed = gets (view istAllowImages) -- | Ask whether the last seen char type was space. isLastSpace :: IParser Bool -isLastSpace = IParser . gets $ view (istLastChar . to (== SpaceChar)) +isLastSpace = gets $ view (istLastChar . to (== SpaceChar)) -- | Ask whether the last seen char type was “other” (not space). isLastOther :: IParser Bool -isLastOther = IParser . gets $ view (istLastChar . to (== OtherChar)) +isLastOther = gets $ view (istLastChar . to (== OtherChar)) -- | Register that the last seen char type is space. lastSpace :: IParser () -lastSpace = IParser . modify' $ set istLastChar SpaceChar +lastSpace = modify' $ set istLastChar SpaceChar {-# INLINE lastSpace #-} -- | Register that the last seen char type is “other” (not space). lastOther :: IParser () -lastOther = IParser . modify' $ set istLastChar OtherChar +lastOther = modify' $ set istLastChar OtherChar {-# INLINE lastOther #-} -- | Lookup a link\/image reference definition. @@ -267,7 +249,7 @@ -> IParser (Either [Text] a) -- ^ A collection of suggested reference names in 'Left' (typo -- corrections) or the requested definition in 'Right' -lookupGeneric l name = IParser $ do +lookupGeneric l name = do let dlabel = mkDefLabel name defs <- gets (view (istDefs . l)) case HM.lookup dlabel defs of diff --git a/mmark.cabal b/mmark.cabal --- a/mmark.cabal +++ b/mmark.cabal @@ -1,5 +1,5 @@ name: mmark -version: 0.0.3.1 +version: 0.0.3.2 cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license: BSD3 @@ -33,6 +33,7 @@ , containers >= 0.5 && < 0.6 , data-default-class , deepseq >= 1.3 && < 1.5 + , dlist >= 0.8 && < 0.9 , email-validate >= 2.2 && < 2.4 , foldl >= 1.2 && < 1.4 , hashable >= 1.0.1.1 && < 1.3 diff --git a/tests/Text/MMarkSpec.hs b/tests/Text/MMarkSpec.hs --- a/tests/Text/MMarkSpec.hs +++ b/tests/Text/MMarkSpec.hs @@ -122,12 +122,12 @@ "

foo

\n

foo

\n

foo

\n

foo

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

## foo

\n" it "CM36" $ @@ -166,8 +166,8 @@ it "CM49" $ let s = "## \n#\n### ###" in s ~~-> - [ err (posN 3 s) (utok '\n' <> elabel "heading character" <> elabel "white space") - , err (posN 5 s) (utok '\n' <> etok '#' <> elabel "white space") ] + [ err (posN 3 s) (utok '\n' <> elabel "heading character" <> ews) + , err (posN 5 s) (utok '\n' <> etok '#' <> ews) ] context "4.3 Setext headings" $ do -- NOTE we do not support them, the tests have been adjusted -- accordingly. @@ -389,9 +389,10 @@ "

foo

\n" it "CM161" $ let s = "[Foo bar\\]]:my_(url) 'title (with parens)'\n\n[Foo bar\\]]" - in s ~-> err (posN 19 s) (utoks ") " <> etok '#' <> etok '/' <> etok '?' - <> eeof <> elabel "newline" <> elabel "the rest of path piece" - <> elabel "white space" ) + in s ~~-> + [ err (posN 19 s) (utoks ") " <> etok '#' <> etok '/' <> etok '?' + <> elabel "newline" <> elabel "the rest of path piece" <> ews ) + , errFancy (posN 45 s) (couldNotMatchRef "Foo bar]" []) ] it "CM162" $ "[Foo bar]:\n\n'title'\n\n[Foo bar]" ==-> "

Foo bar

\n" @@ -405,12 +406,14 @@ "[foo]:\n/url\n\n[foo]" ==-> "

foo

\n" it "CM166" $ - "[foo]:\n\n[foo]" ==-> - "

foo

\n" -- URI may be actually empty! + let s = "[foo]:\n\n[foo]" + in s ~~-> + [ err (posN 7 s) (utok '\n' <> etok '<' <> elabel "URI" <> ews) + , errFancy (posN 9 s) (couldNotMatchRef "foo" []) ] it "CM167" $ let s = "[foo]: /url\\bar\\*baz \"foo\\\"bar\\baz\"\n\n[foo]\n" in s ~-> err (posN 11 s) (utok '\\' <> etok '#' <> etok '/' - <> etok '?' <> elabel "end of URI literal" <> elabel "the rest of path piece") + <> etok '?' <> euri <> elabel "the rest of path piece") it "CM168" $ "[foo]\n\n[foo]: url" ==-> "

foo

\n" @@ -431,12 +434,10 @@ "

bar

\n" it "CM174" $ let s = "[foo]: /url \"title\" ok" - in s ~-> err (posN 20 s) (utoks "ok" <> eeof <> elabel "newline" - <> elabel "white space") + in s ~-> err (posN 20 s) (utoks "ok" <> elabel "newline" <> ews) it "CM175" $ let s = "[foo]: /url\n\"title\" ok\n" - in s ~-> err (posN 20 s) (utoks "ok" <> eeof <> elabel "newline" - <> elabel "white space") + in s ~-> err (posN 20 s) (utoks "ok" <> elabel "newline" <> ews) it "CM176" $ " [foo]: /url \"title\"" ==-> "
[foo]: /url "title"\n
\n" @@ -823,8 +824,10 @@ (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi) it "CM300" $ let s = "[foo]\n\n[foo]: /bar\\* \"ti\\*tle\"" - in s ~-> err (posN 18 s) - (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi) + in s ~~-> + [ errFancy (posN 1 s) (couldNotMatchRef "foo" []) + , err (posN 18 s) + (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi) ] it "CM301" $ "``` foo\\+bar\nfoo\n```" ==-> "
foo\n
\n" @@ -1296,15 +1299,16 @@ "[link](/uri)" ==-> "

link

\n" it "CM461" $ - "[link]()" ==-> - "

link

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

link

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

link))

\n" @@ -1348,7 +1353,7 @@ in s ~-> err (posN 7 s) (utok '"' <> etoks "//" <> etok '#' <> etok '/' <> etok '<' <> etok '?' <> elabel "ASCII alpha character" <> euri <> - elabel "path piece" <> elabel "white space") + elabel "path piece" <> ews) it "CM476" $ "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" ==-> "

link\nlink\nlink

\n" @@ -1361,7 +1366,7 @@ (utok ' ' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi) it "CM479" $ let s = "[link](/url \"title \"and\" title\")\n" - in s ~-> err (posN 20 s) (utok 'a' <> etok ')' <> elabel "white space") + in s ~-> err (posN 20 s) (utok 'a' <> etok ')' <> ews) it "CM480" $ "[link](/url 'title \"and\" title')" ==-> "

link

\n" @@ -1547,12 +1552,12 @@ "[foo][]\n\n[foo]: /url1" ==-> "

foo

\n" it "CM538" $ - "[foo]()\n\n[foo]: /url1" ==-> - "

foo

\n" + let s = "[foo]()\n\n[foo]: /url1" + in s ~-> err (posN 6 s) (utok ')' <> etok '<' <> elabel "URI" <> ews) it "CM539" $ let s = "[foo](not a link)\n\n[foo]: /url1" in s ~-> err (posN 10 s) - (utok 'a' <> etok '"' <> etok '\'' <> etok '(' <> elabel "white space") + (utok 'a' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) it "CM540" $ let s = "[foo][bar][baz]\n\n[baz]: /url" in s ~-> errFancy (posN 6 s) (couldNotMatchRef "bar" ["baz"]) @@ -1672,7 +1677,7 @@ "

<foo+@bar.example.com>

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

<>

\n" + "

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

< http://foo.bar >

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

Something is not going so well today.

\n" + context "title parse errors" $ + it "parse error is OK in reference definitions" $ + let s = "[something]: something something" + in s ~-> err (posN 23 s) + (utoks "so" <> etok '\'' <> etok '\"' <> etok '(' <> + elabel "white space" <> elabel "newline") context "multiple parse errors" $ do it "they are reported in correct order" $ do let s = "Foo `\n\nBar `.\n" @@ -1799,7 +1810,7 @@ it "invalid headers are skipped properly" $ do let s = "#My header\n\nSomething goes __here __.\n" s ~~-> - [ err (posN 1 s) (utok 'M' <> etok '#' <> elabel "white space") + [ err (posN 1 s) (utok 'M' <> etok '#' <> ews) , errFancy (posN 34 s) (nonFlanking "__") ] describe "every block in a list gets its parse error propagated" $ do context "with unordered list" $ @@ -1951,10 +1962,10 @@ eeib :: Ord t => ET t eeib = elabel "end of inline block" --- | Expecting end of URI literal. +-- | Expecting end of URI. euri :: Ord t => ET t -euri = elabel "end of URI literal" +euri = elabel "end of URI" -- | Expecting the rest of path piece. @@ -1965,6 +1976,11 @@ eic :: Ord t => ET t eic = elabel "inline content" + +-- | Expecting white space. + +ews :: Ord t => ET t +ews = elabel "white space" -- | Error component complaining that the given 'Text' is not in left- or -- right- flanking position.