commonmark-extensions 0.2.7.1 → 0.2.7.2
raw patch · 13 files changed
+266/−50 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- changelog.md +23/−0
- commonmark-extensions.cabal +1/−1
- src/Commonmark/Extensions/Attributes.hs +1/−2
- src/Commonmark/Extensions/Autolink.hs +19/−1
- src/Commonmark/Extensions/DefinitionList.hs +2/−2
- src/Commonmark/Extensions/FancyList.hs +2/−2
- src/Commonmark/Extensions/Footnote.hs +90/−25
- src/Commonmark/Extensions/Math.hs +17/−10
- src/Commonmark/Extensions/TaskList.hs +12/−7
- test/autolinks.md +33/−0
- test/fancy_lists.md +18/−0
- test/math.md +9/−0
- test/task_lists.md +39/−0
changelog.md view
@@ -1,5 +1,28 @@ # Changelog for commonmark-extensions +## 0.2.7.2++ * Footnotes: memoize note rendering and detect reference cycles.++ * TaskList: re-sync forked list finalizers with the core versions.+ Task lists now get the same tight/loose classification as+ identically shaped plain lists.++ * FancyList: require whole word to be a valid roman numeral.+ Previously "vv. item" parsed as a roman list with start="5".++ * Math: allow an unbraced `$` inside display math.++ * Use `renderChildren` in definition list and footnote constructors.+ Both called blockConstructor directly on child nodes, bypassing+ renderChildren, so child blocks lost their attributes and source ranges.++ * Autolink: implement GFM preceding-character restriction.+ GFM recognizes extended www/url autolinks only when preceded by the+ beginning of a line, whitespace, or one of `(`, `*`, `_`, `~`, `[`.++ * Autolink: fix ']' guard to test bracket counter, not paren counter.+ ## 0.2.7.1 * Task list extension: andle empty task list items correctly (#174,
commonmark-extensions.cabal view
@@ -1,5 +1,5 @@ name: commonmark-extensions-version: 0.2.7.1+version: 0.2.7.2 synopsis: Pure Haskell commonmark parser. description: This library provides some useful extensions to core commonmark
src/Commonmark/Extensions/Attributes.hs view
@@ -27,7 +27,7 @@ import Commonmark.Html import Data.Dynamic import Data.Tree-import Control.Monad (mzero, guard, void)+import Control.Monad (guard, void) import Text.Parsec class HasDiv bl where@@ -282,6 +282,5 @@ Symbol '}']) let val' = case val of Tok (Symbol '"') _ _:_:_ -> drop 1 $ init $ val- Tok (Symbol '\'') _ _:_:_ -> mzero _ -> val return $! (untokenize name, unEntity val')
src/Commonmark/Extensions/Autolink.hs view
@@ -28,8 +28,25 @@ (prefix, linktext) <- withRaw $ wwwAutolink <|> urlAutolink <|> emailAutolink return $! link (prefix <> untokenize linktext) "" (str . untokenize $ linktext) +-- GFM: extended www and url autolinks are recognized only when+-- preceded by the beginning of a line, whitespace, or one of the+-- characters (, *, _, ~. We additionally allow [, since+-- commonmark-hs recognizes autolinks inside square brackets+-- (see test/autolinks.md).+guardPreceded :: Monad m => InlineParser m ()+guardPreceded = do+ mbty <- getPrecedingTokType+ guard $ case mbty of+ Nothing -> True+ Just Spaces -> True+ Just UnicodeSpace -> True+ Just LineEnd -> True+ Just (Symbol c) -> c `elem` ['(', '*', '_', '~', '[']+ Just WordChars -> False+ wwwAutolink :: Monad m => InlineParser m Text wwwAutolink = try $ do+ guardPreceded lookAhead $ satisfyWord (== "www") validDomain linkPath 0 0@@ -59,7 +76,7 @@ Symbol '(' -> symbol '(' *> linkPath (openParens + 1) openBrackets Symbol ')' -> optional $ guard (openParens > 0) *> symbol ')' *> linkPath (openParens - 1) openBrackets Symbol '[' -> symbol '[' *> linkPath openParens (openBrackets + 1)- Symbol ']' -> optional $ guard (openParens > 0) *> symbol ']' *> linkPath openParens (openBrackets - 1)+ Symbol ']' -> optional $ guard (openBrackets > 0) *> symbol ']' *> linkPath openParens (openBrackets - 1) Symbol '<' -> pure () Symbol c | isTrailingPunctuation c -> optional $ try (do skipMany1 trailingPunctuation@@ -86,6 +103,7 @@ urlAutolink :: Monad m => InlineParser m Text urlAutolink = try $ do+ guardPreceded satisfyWord (`elem` ["http", "https", "ftp"]) symbol ':' symbol '/'
src/Commonmark/Extensions/DefinitionList.hs view
@@ -38,9 +38,9 @@ , blockContinue = \n -> (,n) <$> getPosition , blockConstructor = \(Node bdata items) -> do let listType = fromDyn (blockData bdata) LooseList- let getItem item@(Node _ ds) = do+ let getItem item = do term <- runInlineParser (getBlockText item)- defs <- mapM (\c -> blockConstructor (bspec c) c) ds+ defs <- renderChildren item return $! (term, defs) definitionList listType <$> mapM getItem items , blockFinalize = \(Node cdata children) parent -> do
src/Commonmark/Extensions/FancyList.hs view
@@ -103,7 +103,7 @@ Tok WordChars _ ds <- satisfyWord (\t -> T.length t < 10 && T.all isLowerRoman t)- case parse (romanNumeral False) "" ds of+ case parse (romanNumeral False <* eof) "" ds of Left _ -> mzero Right x -> return $! (x, LowerRoman) @@ -111,7 +111,7 @@ Tok WordChars _ ds <- satisfyWord (\t -> T.length t < 10 && T.all isUpperRoman t)- case parse (romanNumeral True) "" ds of+ case parse (romanNumeral True <* eof) "" ds of Left _ -> mzero Right x -> return $! (x, UpperRoman)
src/Commonmark/Extensions/Footnote.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Commonmark.Extensions.Footnote ( footnoteSpec , HasFootnote(..)@@ -19,9 +20,10 @@ import Commonmark.TokParsers import Commonmark.ReferenceMap import Control.Monad.Trans.Class (lift)-import Control.Monad (mzero)+import Control.Monad (mzero, foldM)+import Data.Graph (stronglyConnComp, flattenSCC) import Data.List-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe, mapMaybe, catMaybes) import Data.Dynamic import Data.Tree import Text.Parsec@@ -30,17 +32,34 @@ import qualified Data.Map as M data FootnoteDef bl m =- FootnoteDef Int Text (ReferenceMap -> m (Either ParseError bl))+ FootnoteDef Int Text [Text] (ReferenceMap -> m (Either ParseError bl))+ -- ^ number, label, labels of footnote references in the body+ -- (conservative approximation, used only for ordering the+ -- memoization pass in addFootnoteList), parser for contents deriving Typeable instance Eq (FootnoteDef bl m) where- FootnoteDef num1 lab1 _ == FootnoteDef num2 lab2 _+ FootnoteDef num1 lab1 _ _ == FootnoteDef num2 lab2 _ _ = num1 == num2 && lab1 == lab2 instance Ord (FootnoteDef bl m) where- (FootnoteDef num1 lab1 _) `compare` (FootnoteDef num2 lab2 _) =+ (FootnoteDef num1 lab1 _ _) `compare` (FootnoteDef num2 lab2 _ _) = (num1, lab1) `compare` (num2, lab2) +-- | Memoized rendered contents of a footnote, stored in the reference+-- map (alongside the FootnoteDef) once the note has been rendered, so+-- that each note body is parsed only once no matter how many times it+-- is referenced.+data FootnoteRendered bl = FootnoteRendered Int Text bl+ deriving Typeable++-- | Marker inserted into the reference map passed to a note body's+-- parser while that note is being rendered. A reference to an+-- in-progress note is a cycle; pFootnoteRef treats it as unresolved,+-- so it falls back to literal text instead of looping forever.+data FootnoteInProgress = FootnoteInProgress+ deriving Typeable+ footnoteSpec :: (Monad m, Typeable m, IsBlock il bl, IsInline il, Typeable il, Typeable bl, HasFootnote il bl) => SyntaxSpec m il bl@@ -79,10 +98,7 @@ <|> (skipWhile (hasType Spaces) >> () <$ lookAhead lineEnd) pos <- getPosition return $! (pos, n)- , blockConstructor = \node ->- mconcat <$> mapM (\n ->- blockConstructor (blockSpec (rootLabel n)) n)- (subForest (reverseSubforests node))+ , blockConstructor = fmap mconcat . renderChildren . reverseSubforests , blockFinalize = \(Node root children) parent -> do let (num, lab') = fromDyn (blockData root) (1, mempty) st <- getState@@ -91,14 +107,29 @@ (blockConstructor (blockSpec root) (Node root children)) st{ referenceMap = refmap } "source" []+ let bodytoks = concatMap (concat . reverse . blockLines)+ (flatten (Node root children)) updateState $ \s -> s{ referenceMap = insertReference lab'- (FootnoteDef num lab' mkNoteContents)+ (FootnoteDef num lab' (extractNoteRefs bodytoks)+ mkNoteContents) (referenceMap s) } return $! parent } +-- Conservatively extract the labels of footnote references occurring+-- in a note body. These are used only to order the rendering of+-- notes in addFootnoteList so that referenced notes are rendered (and+-- memoized) before the notes that reference them; inaccuracies affect+-- only performance, not correctness.+extractNoteRefs :: [Tok] -> [Text]+extractNoteRefs toks =+ case parse (catMaybes <$> many ((Just <$> try pFootnoteLabel)+ <|> (Nothing <$ anyTok))) "" toks of+ Left _ -> []+ Right labs -> labs+ pFootnoteLabel :: Monad m => ParsecT [Tok] u m Text pFootnoteLabel = try $ do lab <- untokenize@@ -110,36 +141,70 @@ -> return $! t' _ -> mzero -pFootnoteRef :: (Monad m, Typeable m, Typeable a,+pFootnoteRef :: forall m a b. (Monad m, Typeable m, Typeable a, Typeable b, IsInline a, IsBlock a b, HasFootnote a b) => InlineParser m a pFootnoteRef = try $ do lab <- pFootnoteLabel rm <- getReferenceMap- case lookupReference lab rm of- Just (FootnoteDef num _ mkContents) -> do- res <- lift . lift $ mkContents rm- case res of- Left err -> mkPT (\_ -> return (Empty (return (Error err))))- Right contents -> return $!- footnoteRef (T.pack (show num)) lab contents- Nothing -> mzero+ case lookupReference lab rm :: Maybe FootnoteInProgress of+ Just _ -> mzero -- cyclic reference: leave it as literal text+ Nothing ->+ case lookupReference lab rm :: Maybe (FootnoteRendered b) of+ -- memoized contents (notes are pre-rendered in addFootnoteList,+ -- which runs before inline parsing of the main document):+ Just (FootnoteRendered num _ contents) -> return $!+ footnoteRef (T.pack (show num)) lab contents+ Nothing ->+ case lookupReference lab rm :: Maybe (FootnoteDef b m) of+ -- not yet rendered (only happens while another note that+ -- references this one is itself being rendered):+ Just (FootnoteDef num _ _ mkContents) -> do+ res <- lift . lift $ mkContents+ (insertReference lab FootnoteInProgress rm)+ case res of+ Left err -> mkPT (\_ -> return (Empty (return (Error err))))+ Right contents -> return $!+ footnoteRef (T.pack (show num)) lab contents+ Nothing -> mzero -addFootnoteList :: (Monad m, Typeable m, Typeable bl, HasFootnote il bl,+addFootnoteList :: forall m il bl.+ (Monad m, Typeable m, Typeable bl, HasFootnote il bl, IsBlock il bl) => BlockParser m il bl bl addFootnoteList = do rm <- referenceMap <$> getState let keys = M.keys . unReferenceMap $ rm- let getNote key = lookupReference key rm+ let getNote key = lookupReference key rm :: Maybe (FootnoteDef bl m) let notes = sort $ mapMaybe getNote keys- let renderNote (FootnoteDef num lab mkContents) = do- res <- lift $ mkContents rm+ -- Render each note's contents exactly once, in dependency order+ -- (so that notes referenced by other notes are rendered, and+ -- memoized, first), caching the results in the reference map.+ -- Since final parsers run before inline parsing of the main+ -- document, every footnote reference outside of a note body will+ -- find the memoized contents. Cyclic references are cut off by+ -- the FootnoteInProgress marker (see pFootnoteRef).+ let sccs = stronglyConnComp+ [ (def, normalizeLabel lab, map normalizeLabel refs)+ | def@(FootnoteDef _ lab refs _) <- notes ]+ let renderNote rm' (FootnoteDef num lab _ mkContents) = do+ res <- lift $ mkContents (insertReference lab FootnoteInProgress rm') case res of Left err -> mkPT (\_ -> return (Empty (return (Error err))))- Right contents -> return $! footnote num lab contents+ Right contents -> return $!+ insertReference lab (FootnoteRendered num lab contents) rm'+ rm' <- foldM renderNote rm (concatMap flattenSCC sccs)+ updateState $ \s -> s{ referenceMap = rm' }+ let renderedNote (FootnoteDef num lab _ _) = do+ FootnoteRendered _ _ contents <- lookupReference lab rm'+ return $! footnote num lab contents if null notes then return mempty- else footnoteList <$> mapM renderNote notes+ else return $! footnoteList $ mapMaybe renderedNote notes++-- Must match the label normalization performed by insertReference+-- and lookupReference (see Commonmark.ReferenceMap).+normalizeLabel :: Text -> Text+normalizeLabel = T.toCaseFold . T.unwords . T.words class IsBlock il bl => HasFootnote il bl | il -> bl where footnote :: Int -> Text -> bl -> bl
src/Commonmark/Extensions/Math.hs view
@@ -41,10 +41,10 @@ parseMath = try $ do symbol '$' display <- (True <$ symbol '$') <|> (False <$ notFollowedBy whitespace)- contents <- try $ untokenize <$> pDollarsMath 0+ contents <- try $ untokenize <$> pDollarsMath display 0 let isWs c = c == ' ' || c == '\t' || c == '\r' || c == '\n' if display- then displayMath contents <$ symbol '$'+ then pure $ displayMath contents else do -- don't allow empty inline math guard $ not $ T.null contents@@ -55,18 +55,25 @@ notFollowedBy $ satisfyWord startsWithDigit pure $ inlineMath contents --- Int is number of embedded groupings-pDollarsMath :: Monad m => Int -> InlineParser m [Tok]-pDollarsMath n = do+-- Bool is display math (closed by $$); Int is number of embedded groupings.+-- Consumes the closing $ (or $$) but does not include it in the result.+pDollarsMath :: Monad m => Bool -> Int -> InlineParser m [Tok]+pDollarsMath display n = do guard (n <= 1000) -- bail on pathological inputs tk@(Tok toktype _ _) <- anyTok case toktype of Symbol '$'- | n == 0 -> return []+ | n == 0 ->+ if display+ -- an unbraced single $ is ordinary content in+ -- display math; only $$ closes it+ then ([] <$ symbol '$')+ <|> ((tk :) <$> pDollarsMath display n)+ else return [] Symbol '\\' -> do tk' <- anyTok- (tk :) . (tk' :) <$> pDollarsMath n- Symbol '{' -> (tk :) <$> pDollarsMath (n+1)- Symbol '}' | n > 0 -> (tk :) <$> pDollarsMath (n-1)+ (tk :) . (tk' :) <$> pDollarsMath display n+ Symbol '{' -> (tk :) <$> pDollarsMath display (n+1)+ Symbol '}' | n > 0 -> (tk :) <$> pDollarsMath display (n-1) | otherwise -> mzero- _ -> (tk :) <$> pDollarsMath n+ _ -> (tk :) <$> pDollarsMath display n
src/Commonmark/Extensions/TaskList.hs view
@@ -78,7 +78,11 @@ blockBlanks' <- case childrenData of c:_ | listItemBlanksAtEnd c -> do curline <- sourceLine <$> getPosition- return $! curline - 1 : blockBlanks cdata+ return $! case blockBlanks cdata of+ lb:b | lb == curline - 1 ->+ lb:b+ b ->+ curline - 1 : b _ -> return $! blockBlanks cdata let ldata' = toDyn (ListData lt ls) -- need to transform paragraphs on tight lists@@ -165,16 +169,17 @@ let lidata = fromDyn (blockData cdata) (ListItemData (BulletList '*') False 0 False False)- let blanks = removeConsecutive $ sort $- concat $ blockBlanks cdata :+ let allblanks = reverse . sort . concat $ blockBlanks cdata : map (blockBlanks . rootLabel)- (filter ((== "List") . blockType .- blockSpec . rootLabel) children)+ (filter ((\t -> t == "List" ||+ t == "TaskList") .+ blockType . blockSpec . rootLabel)+ children) curline <- sourceLine <$> getPosition- let blanksAtEnd = case blanks of+ let blanksAtEnd = case allblanks of (l:_) -> l >= curline - 1 _ -> False- let blanksInside = case length blanks of+ let blanksInside = case length (removeConsecutive allblanks) of n | n > 1 -> True | n == 1 -> not blanksAtEnd | otherwise -> False
test/autolinks.md view
@@ -23,6 +23,20 @@ <p><a href="http://www.commonmark.org">www.commonmark.org</a></p> ```````````````````````````````` +An autolink preceded by any other character is not recognized:++```````````````````````````````` example+a-www.foo.com++foo(www.foo.com)++see:http://example.com+.+<p>a-www.foo.com</p>+<p>foo(<a href="http://www.foo.com">www.foo.com</a>)</p>+<p>see:http://example.com</p>+````````````````````````````````+ After a [valid domain], zero or more non-space non-`<` characters may follow: ```````````````````````````````` example@@ -88,6 +102,25 @@ . <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>+````````````````````````````````++The same applies to square brackets: balanced pairs may be included,+but an unbalanced `]` ends the autolink (and open parentheses don't+affect this):++```````````````````````````````` example+www.example.com/a[b]c++www.example.com/a]b++www.example.com/a(b]c++[www.example.com/a]+.+<p><a href="http://www.example.com/a%5Bb%5Dc">www.example.com/a[b]c</a></p>+<p><a href="http://www.example.com/a">www.example.com/a</a>]b</p>+<p><a href="http://www.example.com/a(b">www.example.com/a(b</a>]c</p>+<p>[<a href="http://www.example.com/a">www.example.com/a</a>]</p> ```````````````````````````````` Issue #147:
test/fancy_lists.md view
@@ -278,3 +278,21 @@ <li>one</li> </ol> ````````````````````````````````++A word made of Roman-numeral letters is a list marker only if the+*whole* word is a valid Roman numeral; a valid prefix with leftover+letters (`vv`) or a malformed subtractive form (`il`) is not:++```````````````````````````````` example+vv. not a list++il. not a list++iv. a list+.+<p>vv. not a list</p>+<p>il. not a list</p>+<ol start="4" type="i">+<li>a list</li>+</ol>+````````````````````````````````
test/math.md view
@@ -62,6 +62,15 @@ ```````````````````````````````` +Display math may contain an unbraced single `$`;+only `$$` closes it:++```````````````````````````````` example+$$a $ b$$+.+<p><span class="math display">\[a $ b\]</span></p>+````````````````````````````````+ To avoid treating currency signs as math delimiters, one may occasionally have to backslash-escape them:
test/task_lists.md view
@@ -101,3 +101,42 @@ <li><input type="checkbox" disabled="" />b</li> </ul> ````````````````````````````````++Tight/loose classification should match plain lists. Blank lines+after a list don't make it loose:++```````````````````````````````` example+- [ ] a+- [ ] b+++x+.+<ul class="task-list">+<li><input type="checkbox" disabled="" />a</li>+<li><input type="checkbox" disabled="" />b</li>+</ul>+<p>x</p>+````````````````````````````````++A blank line after a nested task list makes the outer list loose,+just as with plain lists:++```````````````````````````````` example+- [ ] a+ - [ ] b++- [ ] c+.+<ul class="task-list">+<li>+<input type="checkbox" disabled="" /><p>a</p>+<ul class="task-list">+<li><input type="checkbox" disabled="" />b</li>+</ul>+</li>+<li>+<input type="checkbox" disabled="" /><p>c</p>+</li>+</ul>+````````````````````````````````