diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## MMark 0.0.4.1 + +* This version uses `megaparsec-6.4.0` and `parser-combinators-0.4.0` and + has improved performance. + ## MMark 0.0.4.0 * Added support for pipe tables (like on GitHub). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -44,8 +44,8 @@ It's easy to start using MMark if you're used to GitHub-flavored markdown. There are three main differences: -1. URIs are not automatically recognized, you must to enclose them in `<` - and `>`. +1. URIs are not automatically recognized, you must enclose them in `<` and + `>`. 2. Block quotes require only one `>` and they continue as long as long the inner content is indented. @@ -258,17 +258,17 @@ ## Performance -I have compared speed and memory consumption of various Haskell markdown -libraries by running them on an identical, big-enough markdown document and -by rendering it as HTML: +I [have compared](https://github.com/mrkkrp/md-bench) speed and memory +consumption of various Haskell markdown libraries by running them on an +identical, big-enough markdown document and by rendering it as HTML: -Library | Execution time | Allocated | Max residency | Parsing library ---------------------|----------------|-------------|---------------|---------------- -`cmark-0.5.6` | 325.5 μs | 228,440 | 9,608 | Custom C code -`mmark-0.0.4.0` | 8.526 ms | 36,282,776 | 313,632 | Megaparsec -`cheapskate-0.1.1` | 10.84 ms | 44,686,272 | 799,200 | Custom Haskell code -`markdown-0.1.16` † | 14.14 ms | 69,261,816 | 699,656 | Attoparsec -`pandoc-2.0.5` | 38.32 ms | 141,868,840 | 1,471,080 | Parsec +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 +`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 *Results are ordered from fastest to slowest.* diff --git a/Text/MMark/Parser.hs b/Text/MMark/Parser.hs --- a/Text/MMark/Parser.hs +++ b/Text/MMark/Parser.hs @@ -23,7 +23,7 @@ , parse ) where -import Control.Applicative +import Control.Applicative (Alternative, liftA2) import Control.Monad import Data.Bifunctor (Bifunctor (..)) import Data.Bool (bool) @@ -41,7 +41,7 @@ import Text.Megaparsec hiding (parse, State (..)) import Text.Megaparsec.Char hiding (eol) import Text.URI (URI) -import qualified Control.Applicative.Combinators.NonEmpty as NE +import qualified Control.Monad.Combinators.NonEmpty as NE import qualified Data.Char as Char import qualified Data.DList as DList import qualified Data.HashMap.Strict as HM @@ -456,8 +456,8 @@ where cell = do startPos <- getPosition - txt <- fmap (T.stripEnd . bakeText) . foldMany . choice $ - [ (++) . reverse . T.unpack <$> hidden (string "\\|") + txt <- fmap (T.stripEnd . T.pack) . foldMany' . choice $ + [ (++) . T.unpack <$> hidden (string "\\|") , (:) <$> label "inline content" (satisfy cellChar) ] return (IspSpan startPos txt) cellChar x = x /= '|' && notNewline x @@ -542,7 +542,7 @@ pInlines :: IParser (NonEmpty Inline) pInlines = do - done <- hidden atEnd + done <- atEnd allowsEmpty <- isEmptyAllowed if done then @@ -865,10 +865,21 @@ Nothing -> pure g Just h -> go (h . g) +foldMany' :: MonadPlus m => m ([a] -> [a]) -> m [a] +foldMany' f = ($ []) <$> go id + where + go g = + optional f >>= \case + Nothing -> pure g + Just h -> go (g . h) + foldSome :: MonadPlus m => m (a -> a) -> m (a -> a) foldSome f = liftA2 (flip (.)) f (foldMany f) -sepByCount :: Applicative f => Int -> f a -> f sep -> f [a] +foldSome' :: MonadPlus m => m ([a] -> [a]) -> m [a] +foldSome' f = liftA2 ($) f (foldMany' f) + +sepByCount :: MonadPlus m => Int -> m a -> m sep -> m [a] sepByCount 0 _ _ = pure [] sepByCount n p sep = liftA2 (:) p (count (n - 1) (sep *> p)) @@ -879,7 +890,7 @@ => (Char -> Bool) -> String -> m Text -manyEscapedWith f l = fmap bakeText . foldMany . choice $ +manyEscapedWith f l = fmap T.pack . foldMany' . choice $ [ (:) <$> escapedChar , (:) <$> numRef , (++) . reverse <$> entityRef @@ -888,7 +899,7 @@ someEscapedWith :: MonadParsec MMarkErr Text m => (Char -> Bool) -> m Text -someEscapedWith f = fmap bakeText . foldSome . choice $ +someEscapedWith f = fmap T.pack . foldSome' . choice $ [ (:) <$> escapedChar , (:) <$> numRef , (++) . reverse <$> entityRef diff --git a/mmark.cabal b/mmark.cabal --- a/mmark.cabal +++ b/mmark.cabal @@ -1,5 +1,5 @@ name: mmark -version: 0.0.4.0 +version: 0.0.4.1 cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license: BSD3 @@ -39,12 +39,12 @@ , hashable >= 1.0.1.1 && < 1.3 , html-entity-map >= 0.1 && < 0.2 , lucid >= 2.6 && < 3.0 - , megaparsec >= 6.3 && < 7.0 + , megaparsec >= 6.4 && < 7.0 , microlens >= 0.4 && < 0.5 , microlens-th >= 0.4 && < 0.5 - , modern-uri >= 0.1.1 && < 0.2 + , modern-uri >= 0.1.2.1 && < 0.2 , mtl >= 2.0 && < 3.0 - , parser-combinators >= 0.2 && < 1.0 + , parser-combinators >= 0.4 && < 1.0 , text >= 0.2 && < 1.3 , text-metrics >= 0.3 && < 0.4 , unordered-containers >= 0.2.5 && < 0.3 @@ -80,9 +80,9 @@ , hspec >= 2.0 && < 3.0 , hspec-megaparsec >= 1.0 && < 2.0 , lucid >= 2.6 && < 3.0 - , megaparsec >= 6.3 && < 7.0 + , megaparsec >= 6.4 && < 7.0 , mmark - , modern-uri >= 0.1.1 && < 0.2 + , modern-uri >= 0.1.2.1 && < 0.2 , text >= 0.2 && < 1.3 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*