replace-megaparsec 1.1.5.0 → 1.2.0.0

raw patch · 9 files changed

+321/−20 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +31/−7
• README.md +14/−6
• replace-megaparsec.cabal +5/−1
• src/Replace/Megaparsec.hs +35/−5
• src/Replace/Megaparsec/Internal/ByteString.hs +73/−0
• src/Replace/Megaparsec/Internal/Text.hs +74/−0
• tests/TestByteString.hs +27/−1
• tests/TestString.hs +31/−0
• tests/TestText.hs +31/−0

@@ -1,20 +1,44 @@ # Revision history for replace-megaparsec -## 1.0.0.0 -- 2019-08-24+## 1.2.0.0 -- 2019-10-31 -* First version.+Benchmark improvements -## 1.0.1.0 -- 2019-08-28+Specializations of the `sepCap` function, guided by+[replace-benchmark](https://github.com/jamesdbrock/replace-benchmark). -* Add test suite.-* `sepCap` will treats `sep` as failing if it succeeds but consumes no input.+### New benchmarks +| Program                                           | dense     | sparse   |+| :---                                              |      ---: |     ---: |+| `Replace.Megaparsec.streamEdit` `String`          | 454.95ms  | 375.04ms |+| `Replace.Megaparsec.streamEdit` `ByteString`      | 529.99ms  | 73.76ms  |+| `Replace.Megaparsec.streamEdit` `Text`            | 547.47ms  | 139.21ms |++### Old benchmarks++| Program                                           | dense     | sparse   |+| :---                                              |      ---: |     ---: |+|  `Replace.Megaparsec.streamEdit`     `String`     | 454.95ms  | 375.04ms |+|  `Replace.Megaparsec.streamEdit`     `ByteString` | 611.98ms  | 433.26ms |+|  `Replace.Megaparsec.streamEdit`     `Text`       | 592.66ms  | 353.32ms |++## 1.1.5.0 -- 2019-10-08++* Move benchmarks to [__replace-benchmark__](https://github.com/jamesdbrock/replace-benchmark)+ ## 1.1.0.0 -- 2019-09-01  * Add benchmark suite. * In `streamEditT`, replace `fold` with `mconcat`. The benchmarks now show   linear scaling instead of quadratic. -## 1.1.5.0 -- 2019-10-08+## 1.0.1.0 -- 2019-08-28 -* Move benchmarks to [__replace-benchmark__](https://github.com/jamesdbrock/replace-benchmark)+* Add test suite.+* `sepCap` will treats `sep` as failing if it succeeds but consumes no input.++## 1.0.0.0 -- 2019-08-24++* First version.+

@@ -38,7 +38,7 @@ See [__replace-attoparsec__](https://hackage.haskell.org/package/replace-attoparsec) for the [__attoparsec__](http://hackage.haskell.org/package/attoparsec)-version. ([__megaparsec__ is as fast as __attoparsec__.](https://github.com/mrkkrp/megaparsec#performance))+version.  ## Why would we want to do pattern matching and substitution with parsers instead of regular expressions? @@ -320,6 +320,13 @@  # Benchmarks +These benchmarks are intended to measure the wall-clock speed+of *everything except the actual pattern-matching*. Speed of the+pattern-matching is the responsibility of the+[__megaparsec__](http://hackage.haskell.org/package/megaparsec) and+[__attoparsec__](http://hackage.haskell.org/package/attoparsec)+libraries.+ The benchmark task is to find all of the one-character patterns `x` in a text stream and replace them by a function which returns the constant string `oo`. So, like the regex `s/x/oo/g`.@@ -341,7 +348,8 @@ ```  Each benchmark program reads the input from `stdin`, replaces `x` with `oo`,-and writes the result to `stdout`. The time elapsed is measured by `perf stat`.+and writes the result to `stdout`. The time elapsed is measured by `perf stat`,+and the best observed time is recorded.  See [replace-benchmark](https://github.com/jamesdbrock/replace-benchmark) for details.@@ -351,10 +359,10 @@ | Python `re.sub`¹                                  | 89.23ms   | 23.98ms  | | Perl `s///ge`²                                    | 180.65ms  | 5.60ms   | | [`Replace.Megaparsec.streamEdit`][m] `String`     | 454.95ms  | 375.04ms |-| [`Replace.Megaparsec.streamEdit`][m] `ByteString` | 611.98ms  | 433.26ms |-| [`Replace.Megaparsec.streamEdit`][m] `Text`       | 592.66ms  | 353.32ms |-| [`Replace.Attoparsec.ByteString.streamEdit`][ab]  | 537.57ms  | 407.33ms |-| [`Replace.Attoparsec.Text.streamEdit`][at]        | 549.62ms  | 280.96ms |+| [`Replace.Megaparsec.streamEdit`][m] `ByteString` | 529.99ms  | 73.76ms  |+| [`Replace.Megaparsec.streamEdit`][m] `Text`       | 547.47ms  | 139.21ms |+| [`Replace.Attoparsec.ByteString.streamEdit`][ab]  | 394.12ms  | 41.13ms  |+| [`Replace.Attoparsec.Text.streamEdit`][at]        | 515.26ms  | 46.10ms  | | [`Text.Regex.Applicative.replace`][ra] `String`   | 1083.98ms | 646.40ms | | [`Text.Regex.PCRE.Heavy.gsub`][ph] `Text`         | ⊥³        | 14.76ms  | 

@@ -1,5 +1,5 @@ name:                replace-megaparsec-version:             1.1.5.0+version:             1.2.0.0 cabal-version:       1.18 synopsis:            Find, replace, and edit text patterns with Megaparsec parsers homepage:            https://github.com/jamesdbrock/replace-megaparsec@@ -26,8 +26,12 @@   hs-source-dirs:      src   build-depends:       base >= 4.0 && < 5.0                      , megaparsec+                     , bytestring+                     , text   default-language:    Haskell2010   exposed-modules:     Replace.Megaparsec+                     , Replace.Megaparsec.Internal.ByteString+                     , Replace.Megaparsec.Internal.Text   ghc-options:         -O2 -Wall  test-suite test-string

@@ -35,6 +35,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE CPP #-}  module Replace.Megaparsec   (@@ -57,7 +59,11 @@ import Control.Exception (throw) import Data.Typeable import Control.Monad+import qualified Data.ByteString as B+import qualified Data.Text as T import Text.Megaparsec+import Replace.Megaparsec.Internal.ByteString+import Replace.Megaparsec.Internal.Text  -- | -- == Separate and capture@@ -91,7 +97,6 @@ -- but, importantly, it returns the parsed result of the @sep@ parser instead -- of throwing it away. ---{-# INLINABLE sepCap #-} sepCap     :: forall e s m a. (MonadParsec e s m)     => m a -- ^ The pattern matching parser @sep@@@ -115,7 +120,31 @@         offset2 <- getOffset         when (offset1 >= offset2) empty         return x+{-# INLINE [1] sepCap #-}+-- https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#specialisation+-- What we're missing here is a rule that can pick up non-ParsecT instances+-- of MonadParsec for GHC < 8.8.+#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)+{-# RULES "sepCap/ByteString" [2]+ forall e. forall.+ sepCap           @e @B.ByteString =+ sepCapByteString @e @B.ByteString #-}+{-# RULES "sepCap/Text" [2]+ forall e. forall.+ sepCap     @e @T.Text =+ sepCapText @e @T.Text #-}+#elif MIN_VERSION_GLASGOW_HASKELL(8,0,2,0)+{-# RULES "sepCap/ByteString" [2]+ forall (pa :: ParsecT e B.ByteString m a).+ sepCap           @e @B.ByteString @(ParsecT e B.ByteString m) @a pa =+ sepCapByteString @e @B.ByteString @(ParsecT e B.ByteString m) @a pa #-}+{-# RULES "sepCap/Text" [2]+ forall (pa :: ParsecT e T.Text m a).+ sepCap     @e @T.Text @(ParsecT e T.Text m) @a pa =+ sepCapText @e @T.Text @(ParsecT e T.Text m) @a pa #-}+#endif + -- | -- == Find all occurences, parse and capture pattern matches --@@ -130,13 +159,14 @@ -- @ -- findAllCap sep = 'sepCap' ('Text.Megaparsec.match' sep) -- @-{-# INLINABLE findAllCap #-} findAllCap     :: MonadParsec e s m     => m a -- ^ The pattern matching parser @sep@     -> m [Either (Tokens s) (Tokens s, a)] findAllCap sep = sepCap (match sep)+{-# INLINABLE findAllCap #-} + -- | -- == Find all occurences --@@ -151,12 +181,12 @@ -- @ -- findAll sep = (fmap.fmap) ('Data.Bifunctor.second' fst) $ 'sepCap' ('Text.Megaparsec.match' sep) -- @-{-# INLINABLE findAll #-} findAll     :: MonadParsec e s m     => m a -- ^ The pattern matching parser @sep@     -> m [Either (Tokens s) (Tokens s)] findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep)+{-# INLINABLE findAll #-}   -- |@@ -208,7 +238,6 @@ -- this function should never throw an exception, because it only throws -- when the 'sepCap' parser fails, and the 'sepCap' parser -- can never fail. If this function ever throws, please report that as a bug.-{-# INLINABLE streamEdit #-} streamEdit     :: forall s a. (Stream s, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s)     => Parsec Void s a@@ -220,6 +249,7 @@         -- ^ The input stream of text to be edited.     -> s streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor)+{-# INLINABLE streamEdit #-}  -- | -- == Stream editor transformer@@ -234,7 +264,6 @@ -- -- If you want the @editor@ function or the parser @sep@ to remember some state, -- then run this in a stateful monad.-{-# INLINABLE streamEditT #-} streamEditT     :: forall s m a. (Stream s, Monad m, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s)     => ParsecT Void s m a@@ -251,4 +280,5 @@         -- sepCap can never fail, but if it does, throw.         -- Don't use MonadFail because Identity is not a MonadFail.         (Right r) -> fmap mconcat $ traverse (either return editor) r+{-# INLINABLE streamEditT #-} 

@@ -0,0 +1,73 @@+-- |+-- Module    : Replace.Megaparsec.Internal.ByteString+-- Copyright : ©2019 James Brock+-- License   : BSD2+-- Maintainer: James Brock <jamesbrock@gmail.com>+--+-- This internal module is for 'Data.ByteString.ByteString' specializations.+--+-- The functions in this module are supposed to be chosen automatically+-- by rewrite rules in the "Replace.Megaparsec" module, so you should never+-- need to import this module.++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++module Replace.Megaparsec.Internal.ByteString+  (+    -- * Parser combinator+    sepCapByteString+  )+where++import Control.Monad+import qualified Data.ByteString as B+import Text.Megaparsec++{-# INLINE [1] sepCapByteString #-}+sepCapByteString+    :: forall e s m a. (MonadParsec e s m, s ~ B.ByteString)+    => m a -- ^ The pattern matching parser @sep@+    -> m [Either (Tokens s) a]+sepCapByteString sep = getInput >>= go+  where+    -- the go function will search for the first pattern match,+    -- and then capture the pattern match along with the preceding+    -- unmatched string, and then recurse.+    -- restBegin is the rest of the buffer after the last pattern+    -- match.+    go restBegin = do+        (<|>)+            ( do+                restThis <- getInput+                -- About 'thisiter':+                -- It looks stupid and introduces a completely unnecessary+                -- Maybe, but when I refactor to eliminate 'thisiter' and+                -- the Maybe then the benchmarks get dramatically worse.+                thisiter <- (<|>)+                    ( do+                        x <- sep+                        restAfter <- getInput+                        -- Don't allow a match of a zero-width pattern+                        when (B.length restAfter >= B.length restThis) empty+                        pure $ Just (x, restAfter)+                    )+                    (anySingle >> pure Nothing)+                case thisiter of+                    (Just (x, restAfter)) | B.length restThis < B.length restBegin -> do+                        -- we've got a match with some preceding unmatched string+                        let unmatched = B.take (B.length restBegin - B.length restThis) restBegin+                        (Left unmatched:) <$> (Right x:) <$> go restAfter+                    (Just (x, restAfter)) -> do+                        -- we're got a match with no preceding unmatched string+                        (Right x:) <$> go restAfter+                    Nothing -> go restBegin -- no match, try again+            )+            ( do+                -- We're at the end of the input, so return+                -- whatever unmatched string we've got since offsetBegin+                if B.length restBegin > 0 then+                    pure [Left restBegin]+                else pure []+            )+

@@ -0,0 +1,74 @@+-- |+-- Module    : Replace.Megaparsec.Internal.Text+-- Copyright : ©2019 James Brock+-- License   : BSD2+-- Maintainer: James Brock <jamesbrock@gmail.com>+--+-- This internal module is for 'Data.Text.Text' specializations.+--+-- The functions in this module are supposed to be chosen automatically+-- by rewrite rules in the "Replace.Megaparsec" module, so you should never+-- need to import this module.++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++module Replace.Megaparsec.Internal.Text+  (+    -- * Parser combinator+    sepCapText+  )+where++import Control.Monad+import qualified Data.Text as T+import Data.Text.Internal (Text(..))+import Text.Megaparsec++{-# INLINE [1] sepCapText #-}+sepCapText+    :: forall e s m a. (MonadParsec e s m, s ~ T.Text)+    => m a -- ^ The pattern matching parser @sep@+    -> m [Either (Tokens s) a]+sepCapText sep = getInput >>= go+  where+    -- the go function will search for the first pattern match,+    -- and then capture the pattern match along with the preceding+    -- unmatched string, and then recurse.+    -- restBegin is the rest of the buffer after the last pattern+    -- match.+    go restBegin@(Text tarray beginIndx beginLen) = do+        (<|>)+            ( do+                (Text _ _ thisLen) <- getInput+                -- About 'thisiter':+                -- It looks stupid and introduces a completely unnecessary+                -- Maybe, but when I refactor to eliminate 'thisiter' and+                -- the Maybe then the benchmarks get dramatically worse.+                thisiter <- (<|>)+                    ( do+                        x <- sep+                        restAfter@(Text _ _ afterLen) <- getInput+                        -- Don't allow a match of a zero-width pattern+                        when (afterLen >= thisLen) empty+                        pure $ Just (x, restAfter)+                    )+                    (anySingle >> pure Nothing)+                case thisiter of+                    (Just (x, restAfter)) | thisLen < beginLen -> do+                        -- we've got a match with some preceding unmatched string+                        let unmatched = Text tarray beginIndx (beginLen - thisLen)+                        (Left unmatched:) <$> (Right x:) <$> go restAfter+                    (Just (x, restAfter)) -> do+                        -- we're got a match with no preceding unmatched string+                        (Right x:) <$> go restAfter+                    Nothing -> go restBegin -- no match, try again+            )+            ( do+                    -- We're at the end of the input, so return+                    -- whatever unmatched string we've got since offsetBegin+                if beginLen > 0 then+                    pure [Left restBegin]+                else pure []+            )+

@@ -1,9 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}  module TestByteString ( tests ) where -import Distribution.TestSuite+import Distribution.TestSuite as TestSuite import Replace.Megaparsec import Text.Megaparsec import Text.Megaparsec.Byte@@ -39,10 +41,21 @@         (sepCap (fail "" :: Parser ()))         ("xxx")         ([Left "xxx"])+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)     , Test $ runParserTest "read fail"         (sepCap (return (read "a" :: Int) :: Parser Int))         ("a")         ([Left "a"])+#endif+    , Test $ streamEditTest "x to o"+        (string "x" :: Parser B.ByteString) (const "o")+        "x x x" "o o o"+    , Test $ streamEditTest "x to o inner"+        (string "x" :: Parser B.ByteString) (const "o")+        " x x x " " o o o "+    , Test $ streamEditTest "ordering"+        (string "456" :: Parser B.ByteString) (const "ABC")+        "123456789" "123ABC789"     ]   where     runParserTest nam p input expected = TestInstance@@ -55,6 +68,19 @@                             else return (Finished $ Fail                                         $ show output ++ " ≠ " ++ show expected)             , name = nam+            , tags = []+            , options = []+            , setOption = \_ _ -> Left "no options supported"+            }++    streamEditTest nam sep editor input expected = TestInstance+            { run = do+                let output = streamEdit sep editor input+                if (output == expected)+                    then return (Finished Pass)+                    else return (Finished $ TestSuite.Fail+                                $ show output ++ " ≠ " ++ show expected)+            , name = "streamEdit " ++ nam             , tags = []             , options = []             , setOption = \_ _ -> Left "no options supported"

@@ -1,8 +1,11 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}  module TestString ( tests ) where  import Distribution.TestSuite+import Distribution.TestSuite as TestSuite import Replace.Megaparsec import Text.Megaparsec import Text.Megaparsec.Char@@ -34,10 +37,25 @@         (sepCap (fail "" :: Parser ()))         ("xxx")         ([Left "xxx"])+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)     , Test $ runParserTest "read fail"         (sepCap (return (read "a" :: Int) :: Parser Int))         ("a")         ([Left "a"])+#endif+    , Test $ runParserTest "findAll astral"+        (findAll ((takeWhileP Nothing (=='𝅘𝅥𝅯') :: Parser String)))+        ("𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥")+        [Left "𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥", Right "𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯", Left "𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥"]+    , Test $ streamEditTest "x to o"+        (string "x" :: Parser String) (const "o")+        "x x x" "o o o"+    , Test $ streamEditTest "x to o inner"+        (string "x" :: Parser String) (const "o")+        " x x x " " o o o "+    , Test $ streamEditTest "ordering"+        (string "456" :: Parser String) (const "ABC")+        "123456789" "123ABC789"     ]   where     runParserTest nam p input expected = TestInstance@@ -50,6 +68,19 @@                             else return (Finished $ Fail                                         $ show output ++ " ≠ " ++ show expected)             , name = nam+            , tags = []+            , options = []+            , setOption = \_ _ -> Left "no options supported"+            }++    streamEditTest nam sep editor input expected = TestInstance+            { run = do+                let output = streamEdit sep editor input+                if (output == expected)+                    then return (Finished Pass)+                    else return (Finished $ TestSuite.Fail+                                $ show output ++ " ≠ " ++ show expected)+            , name = "streamEdit " ++ nam             , tags = []             , options = []             , setOption = \_ _ -> Left "no options supported"

@@ -1,9 +1,12 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}  module TestText ( tests ) where  import Distribution.TestSuite+import Distribution.TestSuite as TestSuite import Replace.Megaparsec import Text.Megaparsec import Text.Megaparsec.Char@@ -36,10 +39,25 @@         (sepCap (fail "" :: Parser ()))         ("xxx")         ([Left "xxx"])+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)     , Test $ runParserTest "read fail"         (sepCap (return (read "a" :: Int) :: Parser Int))         ("a")         ([Left "a"])+#endif+    , Test $ runParserTest "findAll astral"+        (findAll ((takeWhileP Nothing (=='𝅘𝅥𝅯') :: Parser T.Text)))+        ("𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥" :: T.Text)+        [Left "𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥", Right "𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯", Left "𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥"]+    , Test $ streamEditTest "x to o"+        (string "x" :: Parser T.Text) (const "o")+        "x x x" "o o o"+    , Test $ streamEditTest "x to o inner"+        (string "x" :: Parser T.Text) (const "o")+        " x x x " " o o o "+    , Test $ streamEditTest "ordering"+        (string "456" :: Parser T.Text) (const "ABC")+        "123456789" "123ABC789"     ]   where     runParserTest nam p input expected = TestInstance@@ -52,6 +70,19 @@                             else return (Finished $ Fail                                         $ show output ++ " ≠ " ++ show expected)             , name = nam+            , tags = []+            , options = []+            , setOption = \_ _ -> Left "no options supported"+            }++    streamEditTest nam sep editor input expected = TestInstance+            { run = do+                let output = streamEdit sep editor input+                if (output == expected)+                    then return (Finished Pass)+                    else return (Finished $ TestSuite.Fail+                                $ show output ++ " ≠ " ++ show expected)+            , name = "streamEdit " ++ nam             , tags = []             , options = []             , setOption = \_ _ -> Left "no options supported"