commonmark 0.2.6 → 0.2.6.1

raw patch · 5 files changed

+97/−26 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• commonmark.cabal +1/−1
• src/Commonmark/Inlines.hs +57/−24
• test/regression.md +32/−0
• test/test-commonmark.hs +1/−1

@@ -1,5 +1,11 @@ # Changelog for commonmark +## 0.2.6.1++  * Fix parsing of link destinations that look like `code` or+    HTML (#136, Michael Howell).  This affects parsing of things+    like `` [link](`)`x` ``.+ ## 0.2.6    * Make list tightness match the reference implementation closer (#150,

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           commonmark-version:        0.2.6+version:        0.2.6.1 synopsis:       Pure Haskell commonmark parser. description:    This library provides the core data types and functions

@@ -54,7 +54,7 @@ import           Unicode.Char               (isAscii, isAlpha) import qualified Data.IntMap.Strict         as IntMap import qualified Data.Map.Strict            as M-import           Data.Maybe                 (isJust, mapMaybe, listToMaybe)+import           Data.Maybe                 (isJust, mapMaybe, listToMaybe, maybeToList) import qualified Data.Set                   as Set import           Data.Text                  (Text) import qualified Data.Text                  as T@@ -74,18 +74,31 @@ mkInlineParser bracketedSpecs formattingSpecs ilParsers attrParsers rm toks = do   let iswhite t = hasType Spaces t || hasType LineEnd t   let attrParser = choice attrParsers-  let toks' = dropWhile iswhite . reverse . dropWhile iswhite . reverse $ toks-  res <- {-# SCC parseChunks #-} evalStateT-          (parseChunks bracketedSpecs formattingSpecs ilParsers-           attrParser rm toks') defaultEnders+  let go chunksAlreadyParsed toks' bottoms = do+        chunks' <- {-# SCC parseChunks #-} evalStateT+                (parseChunks bracketedSpecs formattingSpecs ilParsers+                 attrParser rm toks') defaultEnders+        case chunks' of+           -- If parseChunks fails, it just fails+           Left err -> return $ Left err+           Right chunks'' ->+              case (processBrackets bracketedSpecs rm (chunksAlreadyParsed ++ chunks'') bottoms) of+                  -- If processBrackets fails, it means a chunk straddled a link.+                  -- To fix this, re-chunk everything after the link and parse again.+                  Left st ->+                      let+                      chunksSuccessfullyParsed = (reverse . befores . rightCursor) st+                      chunksRemainingToParse = (maybeToList . center $ rightCursor st) ++ (afters $ rightCursor st)+                      toksRemainingToParse = (mconcat . map chunkToks) chunksRemainingToParse+                      in go chunksSuccessfullyParsed toksRemainingToParse (stackBottoms st)+                  Right chunks''' -> return $ Right chunks'''+  let toksToParse = (dropWhile iswhite . reverse . dropWhile iswhite . reverse) toks+  res <- go [] toksToParse mempty   return $!-    case res of-       Left err     -> Left err-       Right chunks ->-         (Right .-          unChunks .-          processEmphasis .-          processBrackets bracketedSpecs rm) chunks+      case res of+         Left err     -> Left err+         Right chunks ->+           (Right . unChunks . processEmphasis) chunks  defaultInlineParser :: (Monad m, IsInline a) => InlineParser m a defaultInlineParser =@@ -695,20 +708,36 @@ bracketMatchedCount :: [Chunk a] -> Int bracketMatchedCount chunksinside = sum $ map bracketChunkToNumber chunksinside +-- | Process square brackets: links, images, and the span extension.+--+-- DState tracks the current position and backtracking limits.+--+-- If this function succeeds, returning `Right`, it will return a list of+-- chunks, now annotated with bracket information.+--+-- If this function fails, it will return `Left DState`. This can happen if a+-- chunk straddles a link destination, like this+--+--     [link text](https://link/`) looks like code`+--                              ^-----------------^+--+-- To recover, the caller must re-Chunk everything after the end paren.+-- The `bottoms` parameter, in particular, is `DState`'s `stackBottoms`,+-- and is used to prevent things before the paren from being re-parsed. processBrackets :: IsInline a-                => [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> [Chunk a]-processBrackets bracketedSpecs rm xs =+                => [BracketedSpec a] -> ReferenceMap -> [Chunk a] -> M.Map Text SourcePos -> Either (DState a) [Chunk a]+processBrackets bracketedSpecs rm xs bottoms =   case break (\case                (Chunk Delim{ delimType = '[' } _ _) -> True                _ -> False) xs of-       (_,[]) -> xs+       (_,[]) -> Right xs        (ys,z:zs) ->           let  startcursor = Cursor (Just z) (reverse ys) zs           in   processBs bracketedSpecs                  DState{ leftCursor = startcursor                        , rightCursor = startcursor                        , refmap = rm-                       , stackBottoms = mempty+                       , stackBottoms = bottoms                        , absoluteBottom = chunkPos z                        } @@ -733,8 +762,10 @@ moveRight (Cursor (Just x) zs (y:ys)) = Cursor (Just y) (x:zs) ys {-# INLINE moveRight #-} +-- Internal helper function for processBrackets,+-- See its comment for an explanation of what Left and Right mean. processBs :: IsInline a-          => [BracketedSpec a] -> DState a -> [Chunk a]+          => [BracketedSpec a] -> DState a -> Either (DState a) [Chunk a] processBs bracketedSpecs st =   let left = leftCursor st       right = rightCursor st@@ -742,7 +773,7 @@       bottom = absoluteBottom st   -- trace (prettyCursors left right) $ return $! ()   in  {-# SCC processBs #-} case (center left, center right) of-       (_, Nothing) -> reverse $+       (_, Nothing) -> Right $ reverse $                          case center (rightCursor st) of                             Nothing -> befores (rightCursor st)                             Just c  -> c : befores (rightCursor st)@@ -829,8 +860,8 @@                          firstAfterTokPos = tokPos <$> listToMaybe                                         (concatMap chunkToks afterchunks)                          -- in the event that newpos is not at the-                         -- beginning of a chunk, we need to add-                         -- some tokens from that chunk...+                         -- beginning of a chunk, we need to re-chunk+                         -- with those tokens and everything after them                          missingtoks =                            [t | t <- suffixToks                               , tokPos t >= newpos@@ -843,13 +874,12 @@                                        (str (untokenize missingtoks))))                                     newpos missingtoks :) -                     in case addMissing afterchunks of-                           []     -> processBs bracketedSpecs-                                      st{ rightCursor = Cursor Nothing+                         st' = case addMissing afterchunks of+                           []     -> st{ rightCursor = Cursor Nothing                                           (eltchunk : befores left') [] }                            (y:ys) ->                              let lbs = befores left'-                             in processBs bracketedSpecs st{+                             in st{                                   leftCursor =                                     Cursor (Just eltchunk) lbs (y:ys)                                 , rightCursor = fixSingleQuote $@@ -863,6 +893,9 @@                                             (chunkPos opener)                                             $ stackBottoms st                                 }+                     in if null missingtoks+                        then processBs bracketedSpecs st'+                        else Left st'                   -- Bracket matched count /= 0                   --                   -- Links § 6.3 ¶ 2 • 2

@@ -450,3 +450,35 @@ </li> </ul> ````````````````````````````````+++Issue #136+```````````````````````````````` example+[link](`) `x`+.+<p><a href="%60">link</a> <code>x</code></p>+````````````````````````````````++```````````````````````````````` example+[link](`)[link](`) `x`+.+<p><a href="%60">link</a><a href="%60">link</a> <code>x</code></p>+````````````````````````````````++```````````````````````````````` example+[link](<foo bar=">)">) `x`+.+<p><a href="foo%20bar=%22">link</a>&quot;&gt;) <code>x</code></p>+````````````````````````````````++```````````````````````````````` example+[![image](<foo bar=">)">)![image](<foo bar=">)">)](v) `x`+.+<p><a href="v"><img src="foo%20bar=%22" alt="image" />&quot;&gt;)<img src="foo%20bar=%22" alt="image" />&quot;&gt;)</a> <code>x</code></p>+````````````````````````````````++```````````````````````````````` example+[x](`) <a href="`">+.+<p><a href="%60">x</a> <a href="`"></p>+````````````````````````````````

@@ -59,7 +59,7 @@   spectests <- getSpecTests fp   let spectestgroups = groupBy (\t1 t2 -> section t1 == section t2)                           spectests-  let spectestsecs = [(section (head xs), xs) | xs <- spectestgroups]+  let spectestsecs = [(section x, xs) | xs@(x:_) <- spectestgroups]   let parser = runIdentity . parseCommonmarkWith                    (syntaxspec <> defaultSyntaxSpec)   return $ testGroup fp $