diff --git a/CHANGELOG.md b/CHANGELOG.md index 8f258cf..0a222ff 100644 --- 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/Text/MMark/Parser.hs b/Text/MMark/Parser.hs index 4607914..fd936a8 100644 --- a/Text/MMark/Parser.hs +++ b/Text/MMark/Parser.hs @@ -23,7 +23,7 @@ module Text.MMark.Parser , 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.MMark.Util 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 @@ pTable = do 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 @@ pInlinesTop = do pInlines :: IParser (NonEmpty Inline) pInlines = do - done <- hidden atEnd + done <- atEnd allowsEmpty <- isEmptyAllowed if done then @@ -865,10 +865,21 @@ foldMany f = go id 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 @@ manyEscapedWith :: MonadParsec MMarkErr Text m => (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 @@ manyEscapedWith f l = fmap bakeText . foldMany . choice $ 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 index eb9716a..7f380aa 100644 --- a/mmark.cabal +++ b/mmark.cabal @@ -39,12 +39,12 @@ library , 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 @@ test-suite tests , 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.* diff --git a/stack.yaml b/stack.yaml index d3afca8..15b5853 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,7 @@ resolver: lts-10.0 packages: - '.' +extra-deps: +- megaparsec-6.4.0 +- modern-uri-0.1.2.1 +- parser-combinators-0.4.0