commonmark-extensions 0.2.5.1 → 0.2.5.2
raw patch · 5 files changed
+133/−39 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- changelog.md +14/−0
- commonmark-extensions.cabal +1/−1
- src/Commonmark/Extensions/Autolink.hs +43/−25
- src/Commonmark/Extensions/PipeTable.hs +39/−3
- test/autolinks.md +36/−10
changelog.md view
@@ -1,5 +1,19 @@ # Changelog for commonmark-extensions +## 0.2.5.2++ * Improve autolinks extension (#147).+ The autolinks extension was interacting badly with explicit links,+ To fix this we had to make autolink parsing a bit stricter than+ the GFM spec does. They allow unbalanced `)` except at the end+ of a URL (which is defined as: followed by optional final punctuation+ then whitespace or eof). With this change, we don't allow unbalanced+ `)` at all in raw URLs. This should not be a big problem in practice.++ * Protect against quadratic generated table size explosion (Michael Howell).+ This commit adds a limit to the number of auto-completed cells+ around 200,000. The result is, in these original samples:+ ## 0.2.5.1 * Add `test/alerts.md` to extra-source-files in cabal file.
commonmark-extensions.cabal view
@@ -1,5 +1,5 @@ name: commonmark-extensions-version: 0.2.5.1+version: 0.2.5.2 synopsis: Pure Haskell commonmark parser. description: This library provides some useful extensions to core commonmark
src/Commonmark/Extensions/Autolink.hs view
@@ -32,7 +32,7 @@ wwwAutolink = try $ do lookAhead $ satisfyWord (== "www") validDomain- linkSuffix+ linkPath 0 return "http://" validDomain :: Monad m => InlineParser m ()@@ -47,30 +47,48 @@ domainPart skipMany1 $ try (symbol '.' >> domainPart) -linkSuffix :: Monad m => InlineParser m ()-linkSuffix = try $ do- toks <- getInput- let possibleSuffixTok (Tok (Symbol c) _ _) =- c `notElem` ['<','>','{','}','|','\\','^','[',']','`']- possibleSuffixTok (Tok WordChars _ _) = True- possibleSuffixTok _ = False- let isDroppable (Tok (Symbol c) _ _) =- c `elem` ['?','!','.',',',':','*','_','~']- isDroppable _ = False- let numToks = case dropWhile isDroppable $- reverse (takeWhile possibleSuffixTok toks) of- (Tok (Symbol ')') _ _ : xs)- | length [t | t@(Tok (Symbol '(') _ _) <- xs] <=- length [t | t@(Tok (Symbol ')') _ _) <- xs]- -> length xs- (Tok (Symbol ';') _ _- : Tok WordChars _ _- : Tok (Symbol '&') _ _- : xs) -> length xs- xs -> length xs- count numToks anyTok- return ()+linkPath :: Monad m => Int -> InlineParser m ()+linkPath openParens =+ try (symbol '&' *>+ notFollowedBy+ (try (satisfyWord (const True) *> symbol ';' *> linkEnd)) *>+ linkPath openParens)+ <|> (pathPunctuation *> linkPath openParens)+ <|> (symbol '(' *> linkPath (openParens + 1))+ <|> (guard (openParens > 0) *> symbol ')' *> linkPath (openParens - 1))+ -- the following clause is needed to implement the GFM spec, which allows+ -- unbalanced ) except at link end. However, leaving this in causes+ -- problematic interaction with explicit link syntax in certain odd cases (see #147).+ -- <|> (notFollowedBy linkEnd *> symbol ')' *> linkPath (openParens - 1))+ <|> (satisfyTok (\t -> case tokType t of+ LineEnd -> False+ Spaces -> False+ Symbol c -> not (isTrailingPunctuation c || c == '&' || c == ')')+ _ -> True) *> linkPath openParens)+ <|> pure () +linkEnd :: Monad m => InlineParser m ()+linkEnd = try $ skipMany trailingPunctuation *> (void whitespace <|> eof)++trailingPunctuation :: Monad m => InlineParser m ()+trailingPunctuation = void $+ satisfyTok (\t -> case tokType t of+ Symbol c -> isTrailingPunctuation c+ _ -> False)++isTrailingPunctuation :: Char -> Bool+isTrailingPunctuation =+ (`elem` ['!', '"', '\'', ')', '*', ',', '.', ':', ';', '?', '_', '~', '<'])++pathPunctuation :: Monad m => InlineParser m ()+pathPunctuation = try $ do+ satisfyTok (\t -> case tokType t of+ Symbol c -> isTrailingPunctuation c && c /= ')' && c /= '<'+ _ -> False)+ void $ lookAhead (satisfyTok (\t -> case tokType t of+ WordChars -> True+ _ -> False))+ urlAutolink :: Monad m => InlineParser m Text urlAutolink = try $ do satisfyWord (`elem` ["http", "https", "ftp"])@@ -78,7 +96,7 @@ symbol '/' symbol '/' validDomain- linkSuffix+ linkPath 0 return "" emailAutolink :: Monad m => InlineParser m Text
src/Commonmark/Extensions/PipeTable.hs view
@@ -34,6 +34,9 @@ data PipeTableData = PipeTableData { pipeTableAlignments :: [ColAlignment]+ , pipeTableColCount :: !Int+ , pipeTableRowCount :: !Int+ , pipeTableCellCount :: !Int , pipeTableHeaders :: [[Tok]] , pipeTableRows :: [[[Tok]]] -- in reverse order } deriving (Show, Eq, Data, Typeable)@@ -136,6 +139,14 @@ { syntaxBlockSpecs = [pipeTableBlockSpec] } +getAutoCompletedCellCount :: PipeTableData -> Int+getAutoCompletedCellCount tabledata =+ (numrows * numcols) - numcells+ where+ numrows = pipeTableRowCount tabledata+ numcols = pipeTableColCount tabledata+ numcells = pipeTableCellCount tabledata+ -- This parser is structured as a system that parses the *second* line first, -- then parses the first line. That is, if it detects a delimiter row as the -- second line of a paragraph, it converts the paragraph into a table. This seems@@ -173,6 +184,9 @@ updateState $ \st' -> st'{ nodeStack = rest } let tabledata = PipeTableData { pipeTableAlignments = aligns+ , pipeTableColCount = length cells+ , pipeTableRowCount = 0+ , pipeTableCellCount = 0 , pipeTableHeaders = cells , pipeTableRows = [] }@@ -194,23 +208,45 @@ let tabledata = fromDyn (blockData ndata) PipeTableData{ pipeTableAlignments = []+ , pipeTableColCount = 0+ , pipeTableRowCount = 0+ , pipeTableCellCount = 0 , pipeTableHeaders = [] , pipeTableRows = [] } pos <- getPosition cells <- pCells- let tabledata' = tabledata{ pipeTableRows =- cells : pipeTableRows tabledata }+ let cells' = take (pipeTableColCount tabledata) cells+ let tabledata' =+ tabledata{ pipeTableRows = cells' : pipeTableRows tabledata+ , pipeTableRowCount = 1 + pipeTableRowCount tabledata+ , pipeTableCellCount = length cells' + pipeTableCellCount tabledata+ }+ -- Protect against quadratic output size explosion.+ --+ -- Because the table extension fills in missing table cells,+ -- you can, theoretically, force the output to grows as the+ -- square of the input by adding one column and one row.+ -- This is a side-effect of the extension as specified in GFM,+ -- and follows from the geometric definition of "squaring."+ --+ -- To prevent this, we track the number of Real Cells,+ -- and if the number of autocompleted cells exceeds 200,000,+ -- stop parsing.+ guard $ getAutoCompletedCellCount tabledata <= 200000 return $! (pos, Node ndata{ blockData = toDyn tabledata' } children) , blockConstructor = \(Node ndata _) -> do let tabledata = fromDyn (blockData ndata) PipeTableData{ pipeTableAlignments = []+ , pipeTableColCount = 0+ , pipeTableRowCount = 0+ , pipeTableCellCount = 0 , pipeTableHeaders = [] , pipeTableRows = [] } let aligns = pipeTableAlignments tabledata headers <- mapM runInlineParser (pipeTableHeaders tabledata)- let numcols = length headers+ let numcols = pipeTableColCount tabledata rows <- mapM (mapM runInlineParser . take numcols . (++ (repeat []))) (reverse $ pipeTableRows tabledata) return $! (pipeTable aligns headers rows)
test/autolinks.md view
@@ -49,11 +49,38 @@ <p>Visit <a href="http://www.commonmark.org/~jm/foo/bar.pdf">www.commonmark.org/~jm/foo/bar.pdf</a>.</p> ```````````````````````````````` -When an autolink ends in `)`, we scan the entire autolink for the total number-of parentheses. If there is a greater number of closing parentheses than-opening ones, we don't consider the last character part of the autolink, in-order to facilitate including an autolink inside a parenthesis:+((commonmark-hs: We depart from the GFM spec here. Alternative spec and tests+can be found after these commented-out ones. For motivation for this departure from+the GFM spec, see #147.)) +> When an autolink ends in `)`, we scan the entire autolink for the total number+> of parentheses. If there is a greater number of closing parentheses than+> opening ones, we don't consider the last character part of the autolink, in+> order to facilitate including an autolink inside a parenthesis:+>+> ```````````````````````````````` example+> www.google.com/search?q=Markup+(business)+>+> (www.google.com/search?q=Markup+(business))+> .+> <p><a href="http://www.google.com/search?q=Markup+(business)">www.google.com/search?q=Markup+(business)</a></p>+> <p>(<a href="http://www.google.com/search?q=Markup+(business)">www.google.com/search?q=Markup+(business)</a>)</p>+> ````````````````````````````````+>+> This check is only done when the link ends in a closing parentheses `)`, so if+> the only parentheses are in the interior of the autolink, no special rules are+> applied:+>+> ```````````````````````````````` example+> www.google.com/search?q=(business))+ok+> .+> <p><a href="http://www.google.com/search?q=(business))+ok">www.google.com/search?q=(business))+ok</a></p>+> ````````````````````````````````++Autolinks can contain balanced pairs of parentheses, or unbalanced `)`.+We don't allow unbalanced `)`, in order to facilitate including+an autolink inside a parenthesis:+ ```````````````````````````````` example www.google.com/search?q=Markup+(business) @@ -63,15 +90,14 @@ <p>(<a href="http://www.google.com/search?q=Markup+(business)">www.google.com/search?q=Markup+(business)</a>)</p> ```````````````````````````````` -This check is only done when the link ends in a closing parentheses `)`, so if-the only parentheses are in the interior of the autolink, no special rules are-applied:-+Issue #147: ```````````````````````````````` example-www.google.com/search?q=(business))+ok+[link](https://baidu.com)aaa<span></span>bbb .-<p><a href="http://www.google.com/search?q=(business))+ok">www.google.com/search?q=(business))+ok</a></p>+<p><a href="https://baidu.com">link</a>aaa<span></span>bbb</p> ````````````````````````````````++((End of diverging section.)) If an autolink ends in a semicolon (`;`), we check to see if it appears to resemble an [entity reference][entity references]; if the preceding text is `&`