mmark 0.0.4.1 → 0.0.4.2
raw patch · 13 files changed
+156/−159 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- LICENSE.md +1/−1
- README.md +48/−44
- Text/MMark.hs +1/−1
- Text/MMark/Extension.hs +1/−1
- Text/MMark/Parser.hs +61/−62
- Text/MMark/Parser/Internal.hs +12/−24
- Text/MMark/Parser/Internal/Type.hs +3/−2
- Text/MMark/Render.hs +1/−1
- Text/MMark/Type.hs +1/−1
- Text/MMark/Util.hs +1/−1
- mmark.cabal +1/−1
- tests/Text/MMarkSpec.hs +20/−20
CHANGELOG.md view
@@ -1,3 +1,8 @@+## MMark 0.0.4.2++* Made parsing of emphasis-like markup more flexible and forgiving, see+ `README.md` for more information.+ ## MMark 0.0.4.1 * This version uses `megaparsec-6.4.0` and `parser-combinators-0.4.0` and
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2017 Mark Karpov+Copyright © 2017–2018 Mark Karpov All rights reserved.
README.md view
@@ -126,38 +126,58 @@ I decided to make parsing of emphasis, strong emphasis, and similar constructs like strikethrough, subscript, and superscript more symmetric and-less ad-hoc. This is a work in progress and I'm not fully satisfied with the-current approach as it does not allow to express some combinations of-characters and markup, but in 99% of practical cases it is identical to-Common Mark, and normal markdown intuitions will work OK for the users.+less ad-hoc. In 99% of practical cases it is identical to Common Mark, and+normal markdown intuitions will work OK for the users. -Let's start by dividing all characters into three groups:+Let's start by dividing all characters into four groups: +* **Space characters**, including space, tab, newline, carriage return, and+ other characters like non-breaking space.+ * **Markup characters**, including the following: `*`, `~`, `_`, `` ` ``, `^`, `[`, `]`. These are used for markup and whenever they appear in a document, they must form valid markup constructions. To be used as ordinary punctuation characters they must be backslash escaped. -* **Space characters**, including space, tab, newline and carriage return.+* **Punctuation characters**, which include all punctuation characters that+ are not **markup characters**. * **Other characters**, which include all characters not falling into the- two groups described above.+ three groups described above. -**Markup characters** can be “converted” to **other characters** via-backslash escaping. We'll see how this is useful in a few moments.+Next, let's assign *levels* to all groups but **markup characters**: -We'll call **markdown characters** placed between **space characters** and-**other characters** *left-flanking delimiter run*. These markup characters-sort of hang on the left hand side of a word.+* **Space characters**—level 0+* **Punctuation characters**—level 1+* **Other characters**—level 2 -Similarly we'll call **markdown characters** placed between **other-characters** and **space characters** *right-flanking delimiter run*. These-hang on the right hand side of a word.+When **markup characters** or **punctuation characters** are escaped with+backslash they become **other characters**. -Emphasis markup (and other similar things like strikethrough, which we won't-mention explicitly anymore for brevity) can start only as left-flanking-delimiter run and end only as right-flanking delimiter run.+We'll call **markdown characters** placed between a character of level `L`+and a character of level `R` *left-flanking delimiter run* if and only if: +```+level(L) < level(R)+```++These **markup characters** sort of hang on the left hand side of a word.++Similarly we'll call **markdown characters** placed between a character of+level `L` and a character of level `R` *right-flanking delimiter run* if and+only if:++```+level(L) > level (R)+```++These **markup characters** hang on the right hand side of a word.++*Emphasis markup* (and other similar things like strikethrough, which we+won't mention explicitly anymore for brevity) can start only as+*left-flanking delimiter run* and end only as *right-flanking delimiter+run*.+ This produces a parse error: ```@@ -171,40 +191,24 @@ __foo__bar ``` -This means that inter-word emphasis is not supported by this approach. (This-is a pity, maybe I should adjust something to allow it.)+This means that inter-word emphasis is not supported by this approach. -There is one more tricky thing. In some cases we want to end emphasis and-have full stop or other punctuation right after it:+The next example is OK because `s` is an **other character** and `.` is a+**punctuation character**, so `level('s') > level('.')`. ``` Here it *goes*. ``` -You can see that the closing `*` is not in right-flanking position here, and-so it's a parse error. To avoid this, some punctuation characters that-normally appear outside of markup were made “transparent” and thus they are-regarded as white space, so the example above parses correctly and works as-expected. To put a transparent character inside emphasis, backslash escaping-is necessary:--```-We *\(can\)* have it.-```--Here `(` and `)` are transparent punctuation characters, just like `.`, so-they must be turned into **other characters** to go inside the emphasis.-This is a corner case and should not be common in practice.--So far the main limitation of this approach is the pains with inter-word-markup, as in this example:+In some rare cases backslash escaping can help get the right result: ```-**We started to work on the *issue*.**+Here goes *(something\)*. ``` -Should we escape `.` here? On one hand we should, to close `**`. But if we-do, the closing `*` won't be in right-flanking position anymore. God dammit.+We escaped the closing parenthesis `)` so it becomes an **other character**+with level 2 and so its level is greater than the level of plain punctuation+character `.`. ### Other differences @@ -265,7 +269,7 @@ Library | Parsing library | Execution time | Allocated | Max residency --------------------|---------------------|---------------:|------------:|-------------: `cmark-0.5.6` | Custom C code | 311.8 μs | 228,440 | 9,608-`mmark-0.0.4.1` | Megaparsec | 7.169 ms | 32,203,304 | 37,856+`mmark-0.0.4.2` | Megaparsec | 7.757 ms | 32,207,640 | 37,856 `cheapskate-0.1.1` | Custom Haskell code | 10.22 ms | 44,686,272 | 799,200 `markdown-0.1.16` † | Attoparsec | 13.51 ms | 69,261,816 | 699,656 `pandoc-2.0.5` | Parsec | 36.01 ms | 141,868,840 | 1,471,080@@ -288,6 +292,6 @@ ## License -Copyright © 2017 Mark Karpov+Copyright © 2017–2018 Mark Karpov Distributed under BSD 3 clause license.
Text/MMark.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/MMark/Extension.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Extension--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/MMark/Parser.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Parser--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -591,7 +591,7 @@ takeWhile1P Nothing (== '`') <|> takeWhile1P Nothing (/= '`')) finalizer- r <$ lastOther+ r <$ lastChar OtherChar -- | Parse a link. @@ -602,7 +602,7 @@ txt <- disallowLinks (disallowEmpty pInlines) void (char ']') (dest, mtitle) <- pLocation pos txt- Link txt dest mtitle <$ lastOther+ Link txt dest mtitle <$ lastChar OtherChar -- | Parse an image. @@ -610,7 +610,7 @@ pImage = do (pos, alt) <- emptyAlt <|> nonEmptyAlt (src, mtitle) <- pLocation pos alt- Image alt src mtitle <$ lastOther+ Image alt src mtitle <$ lastChar OtherChar where emptyAlt = do pos <- getPosition@@ -638,7 +638,7 @@ Just email -> ( nes (Plain email) , URI.makeAbsolute mailtoScheme uri' )- Link txt uri Nothing <$ lastOther+ Link txt uri Nothing <$ lastChar OtherChar -- | Parse inline content inside an enclosing construction such as emphasis, -- strikeout, superscript, and\/or subscript markup.@@ -668,7 +668,7 @@ eol notFollowedBy eof sc'- lastSpace+ lastChar SpaceChar return LineBreak -- | Parse plain text.@@ -677,37 +677,36 @@ pPlain = fmap (Plain . bakeText) . foldSome $ do ch <- lookAhead (anyChar <?> "inline content") let newline' =- (('\n':) . dropWhile isSpace) <$ eol <* sc' <* lastSpace+ (('\n':) . dropWhile isSpace) <$ eol <* sc' <* lastChar SpaceChar case ch of '\\' -> (:) <$>- ((escapedChar <* lastOther) <|>- try (char '\\' <* notFollowedBy eol <* lastOther))+ ((escapedChar <* lastChar OtherChar) <|>+ try (char '\\' <* notFollowedBy eol <* lastChar OtherChar)) '\n' -> newline' '\r' -> newline' '!' -> do notFollowedBy (string "![")- (:) <$> char '!'+ (:) <$> char '!' <* lastChar PunctChar '<' -> do notFollowedBy pAutolink- (:) <$> char '<'+ (:) <$> char '<' <* lastChar PunctChar '&' -> choice [ (:) <$> numRef , (++) . reverse <$> entityRef- , (:) <$> char '&' ]+ , (:) <$> char '&' ] <* lastChar PunctChar _ ->- (:) <$> pOther ch- where- pOther ch- | isSpace ch = char ch <* lastSpace- | isTrans ch = char ch <* lastSpace- | isOther ch = char ch <* lastOther- | otherwise = failure- (Just . Tokens . nes $ ch)- (E.singleton . Label . NE.fromList $ "inline content")- isTrans x = isTransparentPunctuation x && x /= '!'- isOther x = not (isMarkupChar x) && x /= '\\' && x /= '!' && x /= '<'+ (:) <$>+ if Char.isSpace ch+ then char ch <* lastChar SpaceChar+ else if isSpecialChar ch+ then failure+ (Just . Tokens . nes $ ch)+ (E.singleton . Label . NE.fromList $ "inline content")+ else if Char.isPunctuation ch+ then char ch <* lastChar PunctChar+ else char ch <* lastChar OtherChar ---------------------------------------------------------------------------- -- Auxiliary inline-level parsers@@ -823,9 +822,9 @@ failNow = do setPosition pos (customFailure . NonFlankingDelimiterRun . toNesTokens) dels- isLastOther >>= flip when failNow- rch <- lookAhead (optional anyChar)- when (maybe True isTransparent rch) failNow+ lch <- getLastChar+ rch <- getNextChar OtherChar+ when (lch >= rch) failNow return st -- | Parse a closing markup sequence corresponding to given 'InlineFrame'.@@ -842,13 +841,25 @@ let failNow = do setPosition pos (customFailure . NonFlankingDelimiterRun . toNesTokens) dels- goodAfter x =- isTransparent x || isMarkupChar x- isLastSpace >>= flip when failNow- rch <- lookAhead (optional anyChar)- unless (maybe True goodAfter rch) failNow+ lch <- getLastChar+ rch <- getNextChar SpaceChar+ when (lch <= rch) failNow return frame +-- | Get 'CharType' of the next char in the input stream.++getNextChar+ :: CharType -- ^ What we should consider frame constituent characters+ -> IParser CharType+getNextChar frameType = lookAhead (option SpaceChar (charType <$> anyChar))+ where+ charType ch+ | isFrameConstituent ch = frameType+ | Char.isSpace ch = SpaceChar+ | ch == '\\' = OtherChar+ | Char.isPunctuation ch = PunctChar+ | otherwise = OtherChar+ ---------------------------------------------------------------------------- -- Parsing helpers @@ -959,25 +970,19 @@ eol' = option False (True <$ eol) ------------------------------------------------------------------------------- Other helpers--slevel :: Pos -> Pos -> Pos-slevel a l = if l >= ilevel a then a else l--ilevel :: Pos -> Pos-ilevel = (<> mkPos 4)+-- Char classification isSpace :: Char -> Bool isSpace x = x == ' ' || x == '\t' isSpaceN :: Char -> Bool-isSpaceN x = isSpace x || x == '\n' || x == '\r'+isSpaceN x = isSpace x || isNewline x -notNewline :: Char -> Bool-notNewline x = x /= '\n' && x /= '\r'+isNewline :: Char -> Bool+isNewline x = x == '\n' || x == '\r' -isBlank :: Text -> Bool-isBlank = T.all isSpace+notNewline :: Char -> Bool+notNewline = not . isNewline isFrameConstituent :: Char -> Bool isFrameConstituent = \case@@ -996,6 +1001,9 @@ '`' -> True _ -> False +isSpecialChar :: Char -> Bool+isSpecialChar x = isMarkupChar x || x == '\\' || x == '!' || x == '<'+ isAsciiPunctuation :: Char -> Bool isAsciiPunctuation x = (x >= '!' && x <= '/') ||@@ -1003,26 +1011,17 @@ (x >= '[' && x <= '`') || (x >= '{' && x <= '~') -isTransparentPunctuation :: Char -> Bool-isTransparentPunctuation = \case- '!' -> True- '"' -> True- '(' -> True- ')' -> True- ',' -> True- '-' -> True- '.' -> True- ':' -> True- ';' -> True- '?' -> True- '{' -> True- '}' -> True- '–' -> True- '—' -> True- _ -> False+----------------------------------------------------------------------------+-- Other helpers -isTransparent :: Char -> Bool-isTransparent x = Char.isSpace x || isTransparentPunctuation x+slevel :: Pos -> Pos -> Pos+slevel a l = if l >= ilevel a then a else l++ilevel :: Pos -> Pos+ilevel = (<> mkPos 4)++isBlank :: Text -> Bool+isBlank = T.all isSpace assembleCodeBlock :: Pos -> [Text] -> Text assembleCodeBlock indent ls = T.unlines (stripIndent indent <$> ls)
Text/MMark/Parser/Internal.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Parser.Internal--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -29,12 +29,11 @@ , isLinksAllowed , disallowImages , isImagesAllowed- , isLastSpace- , isLastOther- , lastSpace- , lastOther+ , getLastChar+ , lastChar , lookupReference , Isp (..)+ , CharType (..) -- * Reference and footnote definitions , Defs -- * Other@@ -49,7 +48,7 @@ import Data.Ratio ((%)) import Data.Text (Text) import Data.Text.Metrics (damerauLevenshteinNorm)-import Lens.Micro (Lens', (^.), (.~), set, over, to)+import Lens.Micro (Lens', (^.), (.~), set, over) import Lens.Micro.Extras (view) import Text.MMark.Parser.Internal.Type import Text.Megaparsec hiding (State)@@ -186,27 +185,16 @@ isImagesAllowed :: IParser Bool isImagesAllowed = gets (view istAllowImages) --- | Ask whether the last seen char type was space.--isLastSpace :: IParser Bool-isLastSpace = gets $ view (istLastChar . to (== SpaceChar))---- | Ask whether the last seen char type was “other” (not space).--isLastOther :: IParser Bool-isLastOther = gets $ view (istLastChar . to (== OtherChar))---- | Register that the last seen char type is space.+-- | Get type of the last parsed character. -lastSpace :: IParser ()-lastSpace = modify' $ set istLastChar SpaceChar-{-# INLINE lastSpace #-}+getLastChar :: IParser CharType+getLastChar = gets (view istLastChar) --- | Register that the last seen char type is “other” (not space).+-- | Register type of the last parsed character. -lastOther :: IParser ()-lastOther = modify' $ set istLastChar OtherChar-{-# INLINE lastOther #-}+lastChar :: CharType -> IParser ()+lastChar = modify' . set istLastChar+{-# INLINE lastChar #-} -- | Lookup a link\/image reference definition.
Text/MMark/Parser/Internal/Type.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Parser.Internal.Type--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -124,8 +124,9 @@ data CharType = SpaceChar -- ^ White space or a transparent character+ | PunctChar -- ^ Punctuation character | OtherChar -- ^ Other character- deriving (Eq)+ deriving (Eq, Ord, Show) ---------------------------------------------------------------------------- -- Reference and footnote definitions
Text/MMark/Render.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Render--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/MMark/Type.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Type--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/MMark/Util.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Util--- Copyright : © 2017 Mark Karpov+-- Copyright : © 2017–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
mmark.cabal view
@@ -1,5 +1,5 @@ name: mmark-version: 0.0.4.1+version: 0.0.4.2 cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license: BSD3
tests/Text/MMarkSpec.hs view
@@ -100,7 +100,7 @@ let s = "_ _ _ _ a\n\na------\n\n---a---\n" in s ~-> errFancy posI (nonFlanking "_") it "CM26" $- " *\\-*" ==-> "<p><em>-</em></p>\n"+ " *-*" ==-> "<p><em>-</em></p>\n" it "CM27" $ "- foo\n***\n- bar" ==-> "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"@@ -983,10 +983,10 @@ in s ~-> err (posN 8 s) (ueib <> etok '*' <> eic) it "CM348" $ let s = "*(*foo)\n"- in s ~-> errFancy posI (nonFlanking "*")+ in s ~-> err (posN 7 s) (ueib <> etok '*' <> eic) it "CM349" $- let s = "*(*foo*)*\n"- in s ~-> errFancy posI (nonFlanking "*")+ "*(*foo*)*" ==->+ "<p><em>(<em>foo</em>)</em></p>\n" it "CM350" $ let s = "*foo*bar\n" in s ~-> errFancy (posN 4 s) (nonFlanking "*")@@ -994,11 +994,11 @@ let s = "_foo bar _\n" in s ~-> errFancy (posN 9 s) (nonFlanking "_") it "CM352" $- let s = "_(_foo)\n"- in s ~-> errFancy posI (nonFlanking "_")+ let s = "_(_foo)"+ in s ~-> err (posN 7 s) (ueib <> etok '_' <> eic) it "CM353" $- let s = "_(_foo_)_\n"- in s ~-> errFancy posI (nonFlanking "_")+ "_(_foo_)_" ==->+ "<p><em>(<em>foo</em>)</em></p>\n" it "CM354" $ let s = "_foo_bar\n" in s ~-> errFancy (posN 4 s) (nonFlanking "_")@@ -1009,7 +1009,7 @@ let s = "_foo_bar_baz_\n" in s ~-> errFancy (posN 4 s) (nonFlanking "_") it "CM357" $- "_\\(bar\\)_.\n" ==-> "<p><em>(bar)</em>.</p>\n"+ "_(bar\\)_.\n" ==-> "<p><em>(bar)</em>.</p>\n" it "CM358" $ "**foo bar**\n" ==-> "<p><strong>foo bar</strong></p>\n" it "CM359" $@@ -1045,19 +1045,19 @@ "__foo, __bar__, baz__" ==-> "<p><strong>foo, <strong>bar</strong>, baz</strong></p>\n" it "CM370" $- "foo-__\\(bar\\)__" ==-> "<p>foo-<strong>(bar)</strong></p>\n"+ "foo-__\\(bar)__" ==-> "<p>foo-<strong>(bar)</strong></p>\n" it "CM371" $ let s = "**foo bar **\n" in s ~-> errFancy (posN 10 s) (nonFlanking "**") it "CM372" $ let s = "**(**foo)\n"- in s ~-> errFancy posI (nonFlanking "**")+ in s ~-> err (posN 9 s) (ueib <> etoks "**" <> eic) it "CM373" $- let s = "*(**foo**)*\n"- in s ~-> errFancy posI (nonFlanking "*")- xit "CM374" $ -- FIXME doesn't pass with current approach+ "*(**foo**)*" ==->+ "<p><em>(<strong>foo</strong>)</em></p>\n"+ it "CM374" $ "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**" ==->- "<p><strong>Gomphocarpus (<em>Gomphocarpus physocarpus</em>, syn.\n<em>Asclepias physocarpa</em>)</strong></p>\n"+ "<p><strong>Gomphocarpus (<em>Gomphocarpus physocarpus</em>, syn.\n<em>Asclepias physocarpa</em>)</strong></p>\n" it "CM375" $ "**foo \"*bar*\" foo**" ==-> "<p><strong>foo "<em>bar</em>" foo</strong></p>\n"@@ -1069,10 +1069,10 @@ in s ~-> errFancy (posN 10 s) (nonFlanking "__") it "CM378" $ let s = "__(__foo)\n"- in s ~-> errFancy posI (nonFlanking "__")+ in s ~-> err (posN 9 s) (ueib <> etoks "__" <> eic) it "CM379" $- let s = "_(__foo__)_\n"- in s ~-> errFancy posI (nonFlanking "_")+ "_(__foo__)_" ==->+ "<p><em>(<strong>foo</strong>)</em></p>\n" it "CM380" $ let s = "__foo__bar\n" in s ~-> errFancy (posN 5 s) (nonFlanking "__")@@ -1083,7 +1083,7 @@ "__foo\\_\\_bar\\_\\_baz__" ==-> "<p><strong>foo__bar__baz</strong></p>\n" it "CM383" $- "__\\(bar\\)__." ==->+ "__(bar\\)__." ==-> "<p><strong>(bar)</strong>.</p>\n" it "CM384" $ "*foo [bar](/url)*" ==->@@ -1862,7 +1862,7 @@ let s = "#My header\n\nSomething goes __here __.\n" s ~~-> [ err (posN 1 s) (utok 'M' <> etok '#' <> ews)- , errFancy (posN 34 s) (nonFlanking "__") ]+ , err (posN 37 s) (ueib <> etoks "__" <> eic) ] describe "every block in a list gets its parse error propagated" $ do context "with unordered list" $ it "works" $ do