mmark 0.0.3.1 → 0.0.3.2
raw patch · 8 files changed
+155/−158 lines, 8 filesdep +dlistPVP ok
version bump matches the API change (PVP)
Dependencies added: dlist
API changes (from Hackage documentation)
Files
- CHANGELOG.md +16/−2
- README.md +3/−2
- Text/MMark/Extension.hs +0/−2
- Text/MMark/Internal.hs +0/−2
- Text/MMark/Parser.hs +63/−76
- Text/MMark/Parser/Internal.hs +22/−40
- mmark.cabal +2/−1
- tests/Text/MMarkSpec.hs +49/−33
CHANGELOG.md view
@@ -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
README.md view
@@ -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 `<uri>` 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
Text/MMark/Extension.hs view
@@ -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 #-}
Text/MMark/Internal.hs view
@@ -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
Text/MMark/Parser.hs view
@@ -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
Text/MMark/Parser/Internal.hs view
@@ -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
mmark.cabal view
@@ -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
tests/Text/MMarkSpec.hs view
@@ -122,12 +122,12 @@ "<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 (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" ==-> "<p>## foo</p>\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 @@ "<p><a href=\"/url\" title=\"the title\">foo</a></p>\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<my%20url>\n'title'\n\n[Foo bar]" ==-> "<p><a href=\"my%20url\" title=\"title\">Foo bar</a></p>\n"@@ -405,12 +406,14 @@ "[foo]:\n/url\n\n[foo]" ==-> "<p><a href=\"/url\">foo</a></p>\n" it "CM166" $- "[foo]:\n\n[foo]" ==->- "<p><a href>foo</a></p>\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" ==-> "<p><a href=\"url\">foo</a></p>\n"@@ -431,12 +434,10 @@ "<p>bar</p>\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\"" ==-> "<pre><code>[foo]: /url "title"\n</code></pre>\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```" ==-> "<pre><code class=\"language-foo+bar\">foo\n</code></pre>\n"@@ -1296,15 +1299,16 @@ "[link](/uri)" ==-> "<p><a href=\"/uri\">link</a></p>\n" it "CM461" $- "[link]()" ==->- "<p><a href>link</a></p>\n"+ let s = "[link]()"+ in s ~-> err (posN 7 s)+ (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 (posN 11 s)- (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> elabel "white space")+ (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) it "CM464" $ let s = "[link](</my uri>)\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](<foo\nbar>)\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" ==-> "<p><a href=\"foo(and(bar\">link</a>))</p>\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))" ==-> "<p><a href=\"/url\" title=\"title\">link</a>\n<a href=\"/url\" title=\"title\">link</a>\n<a href=\"/url\" title=\"title\">link</a></p>\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')" ==-> "<p><a href=\"/url\" title=\"title "and" title\">link</a></p>\n"@@ -1547,12 +1552,12 @@ "[foo][]\n\n[foo]: /url1" ==-> "<p><a href=\"/url1\">foo</a></p>\n" it "CM538" $- "[foo]()\n\n[foo]: /url1" ==->- "<p><a href>foo</a></p>\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 @@ "<p><foo+@bar.example.com></p>\n" it "CM578" $ "<>" ==->- "<p><></p>\n"+ "<p><a href></a></p>\n" it "CM579" $ "< http://foo.bar >" ==-> "<p>< http://foo.bar ></p>\n"@@ -1789,6 +1794,12 @@ 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 "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.