replace-attoparsec 1.0.3.0 → 1.2.0.0
raw patch · 8 files changed
+299/−264 lines, 8 filesdep −criterionPVP ok
version bump matches the API change (PVP)
Dependencies removed: criterion
API changes (from Hackage documentation)
- Replace.Attoparsec.ByteString: getOffset :: Parser Int
- Replace.Attoparsec.Text: getOffset :: Parser Int
Files
- CHANGELOG.md +26/−0
- README.md +16/−23
- bench/BenchUnit.hs +0/−158
- replace-attoparsec.cabal +1/−14
- src/Replace/Attoparsec/ByteString.hs +79/−28
- src/Replace/Attoparsec/Text.hs +103/−22
- tests/TestByteString.hs +33/−10
- tests/TestText.hs +41/−9
CHANGELOG.md view
@@ -1,5 +1,31 @@ # Revision history for replace-attoparsec +## 1.2.0.0 -- 2019-10-31++Benchmark improvements++Specializations of the `sepCap` function, guided by+[replace-benchmark](https://github.com/jamesdbrock/replace-benchmark).++### New benchmarks++| Program | dense | sparse |+| :--- | ---: | ---: |+| `Replace.Attoparsec.ByteString.streamEdit` | 394.12ms | 41.13ms |+| `Replace.Attoparsec.Text.streamEdit` | 515.26ms | 46.10ms |++### Old benchmarks++| Program | dense | sparse |+| :--- | ---: | ---: |+| `Replace.Attoparsec.ByteString.streamEdit` | 537.57ms | 407.33ms |+| `Replace.Attoparsec.Text.streamEdit` | 549.62ms | 280.96ms |++Also don't export `getOffset` anymore. It's too complicated to explain+what it means for `Text`. If users want to know positional parsing information+then they should use Megaparsec.+ ## 1.0.0.0 -- 2019-09-10 * First version.+
README.md view
@@ -7,6 +7,7 @@ * [Usage Examples](#usage-examples) * [In the Shell](#in-the-shell) * [Alternatives](#alternatives)+* [Benchmarks](#benchmarks) * [Hypothetically Asked Questions](#hypothetically-asked-questions) __replace-attoparsec__ is for finding text patterns, and also editing and@@ -37,8 +38,7 @@ See [__replace-megaparsec__](https://hackage.haskell.org/package/replace-megaparsec) for the [__megaparsec__](http://hackage.haskell.org/package/megaparsec)-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? @@ -137,21 +137,6 @@ [Right ("0xA",10),Left " 000 ",Right ("0xFFFF",65535)] ``` -### Pattern match, capture only the locations of the matched patterns--Find all of the sections of the stream which match-a string of whitespace.-Print a list of the offsets of the beginning of every pattern match.--```haskell-import Data.Either-let spaceoffset = getOffset <* some space :: Parser Int-fromRight [] $ parseOnly (return . rights =<< sepCap spaceoffset) " a b "-```-```haskell-[0,2,5]-```- ### Pattern match balanced parentheses Find groups of balanced nested parentheses. This is an example of a@@ -301,6 +286,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`.@@ -322,7 +314,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.@@ -332,10 +325,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 | @@ -349,7 +342,7 @@ [ab]: https://hackage.haskell.org/package/replace-attoparsec/docs/Replace-Attoparsec-ByteString.html#v:streamEdit [at]: https://hackage.haskell.org/package/replace-attoparsec/docs/Replace-Attoparsec-Text.html#v:streamEdit [ra]: http://hackage.haskell.org/package/regex-applicative/docs/Text-Regex-Applicative.html#v:replace-[ph]: http://hackage.haskell.org/package/pcre-heavy/docs/Text-Regex-PCRE-Heavy.html+[ph]: http://hackage.haskell.org/package/pcre-heavy/docs/Text-Regex-PCRE-Heavy.html#v:gsub # Hypothetically Asked Questions
− bench/BenchUnit.hs
@@ -1,158 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}--import Data.Attoparsec.ByteString as AB-import Data.Attoparsec.Text as AT-import Replace.Attoparsec.ByteString as RB-import Replace.Attoparsec.Text as RT-import Criterion.Main-import Criterion.Types-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Builder as B.Builder-import qualified Data.Text as T--- import qualified Data.Text.Lazy as TL-import Data.Void--fooStringM :: String-fooStringM = Prelude.take 1000000 $ cycle " foo" -- a million bytes of foos--- fooString10K :: String--- fooString10K = take 10000 fooStringM--- fooString100K :: String--- fooString100K = take 100000 fooStringM--fooByteStringM :: B.ByteString-fooByteStringM = BL.toStrict fooByteStringLM-fooByteString10K :: B.ByteString-fooByteString10K = B.take 10000 fooByteStringM-fooByteString100K :: B.ByteString-fooByteString100K = B.take 100000 fooByteStringM--fooByteStringLM :: BL.ByteString-fooByteStringLM = B.Builder.toLazyByteString $ B.Builder.string8 fooStringM--- fooByteStringL10K :: BL.ByteString--- fooByteStringL10K = BL.take 10000 fooByteStringLM--- fooByteStringL100K :: BL.ByteString--- fooByteStringL100K = BL.take 100000 fooByteStringLM--fooTextM :: T.Text-fooTextM = T.pack fooStringM-fooText10K :: T.Text-fooText10K = T.take 10000 fooTextM-fooText100K :: T.Text-fooText100K = T.take 100000 fooTextM---- fooTextLM :: TL.Text--- fooTextLM = TL.pack fooStringM--- fooTextL10K :: TL.Text--- fooTextL10K = TL.take 10000 fooTextLM--- fooTextL100K :: TL.Text--- fooTextL100K = TL.take 100000 fooTextLM--main :: IO ()-main = defaultMainWith (defaultConfig- { reportFile = Just "criterion-report.html"- , resamples = 100- })--- [ bgroup "String"--- [ bench "sepCap 10,000" $ whnf--- (parseMaybe (sepCap (chunk "foo" :: Parsec Void String String)))--- fooString10K--- , bench "streamEdit 10,000" $ whnf--- (streamEdit (chunk "foo" :: Parsec Void String String) (const "bar"))--- fooString10K--- , bench "sepCap 100,000" $ whnf--- (parseMaybe (sepCap (chunk "foo" :: Parsec Void String String)))--- fooString100K--- , bench "streamEdit 100,000" $ whnf--- (streamEdit (chunk "foo" :: Parsec Void String String) (const "bar"))--- fooString100K--- , bench "sepCap 1,000,000" $ whnf--- (parseMaybe (sepCap (chunk "foo" :: Parsec Void String String)))--- fooStringM--- , bench "streamEdit 1,000,000" $ whnf--- (streamEdit (chunk "foo" :: Parsec Void String String) (const "bar"))--- fooStringM--- ]- [ bgroup "ByteString.Strict"- [ bench "sepCap 10,000" $ whnf- (AB.parseOnly (RB.sepCap (AB.string "foo" )))- fooByteString10K- , bench "streamEdit 10,000" $ whnf- (RB.streamEdit (AB.string "foo") (const "bar"))- fooByteString10K- , bench "sepCap 100,000" $ whnf- (AB.parseOnly (RB.sepCap (AB.string "foo")))- fooByteString100K- , bench "streamEdit 100,000" $ whnf- (RB.streamEdit (AB.string "foo") (const "bar"))- fooByteString100K- , bench "sepCap 1,000,000" $ whnf- (AB.parseOnly (RB.sepCap (AB.string "foo")))- fooByteStringM- , bench "streamEdit 1,000,000" $ whnf- (RB.streamEdit (AB.string "foo") (const "bar"))- fooByteStringM- ]- -- , bgroup "ByteString.Lazy"- -- [ bench "sepCap 10,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString)))- -- fooByteStringL10K- -- , bench "streamEdit 10,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString) (const "bar"))- -- fooByteStringL10K- -- , bench "sepCap 100,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString)))- -- fooByteStringL100K- -- , bench "streamEdit 100,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString) (const "bar"))- -- fooByteStringL100K- -- , bench "sepCap 1,000,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString)))- -- fooByteStringLM- -- , bench "streamEdit 1,000,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void BL.ByteString BL.ByteString) (const "bar"))- -- fooByteStringLM- -- ]- , bgroup "Text.Strict"- [ bench "sepCap 10,000" $ whnf- (AT.parseOnly (RT.sepCap (AT.string "foo")))- fooText10K- , bench "streamEdit 10,000" $ whnf- (RT.streamEdit (AT.string "foo") (const "bar"))- fooText10K- , bench "sepCap 100,000" $ whnf- (AT.parseOnly (RT.sepCap (AT.string "foo")))- fooText100K- , bench "streamEdit 100,000" $ whnf- (RT.streamEdit (AT.string "foo") (const "bar"))- fooText100K- , bench "sepCap 1,000,000" $ whnf- (AT.parseOnly (RT.sepCap (AT.string "foo")))- fooTextM- , bench "streamEdit 1,000,000" $ whnf- (RT.streamEdit (AT.string "foo") (const "bar"))- fooTextM- ]- --, bgroup "Text.Lazy"- -- [ bench "sepCap 10,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void TL.Text TL.Text)))- -- fooTextL10K- -- , bench "streamEdit 10,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void TL.Text TL.Text) (const "bar"))- -- fooTextL10K- -- , bench "sepCap 100,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void TL.Text TL.Text)))- -- fooTextL100K- -- , bench "streamEdit 100,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void TL.Text TL.Text) (const "bar"))- -- fooTextL100K- -- , bench "sepCap 1,000,000" $ whnf- -- (parseMaybe (sepCap (chunk "foo" :: Parsec Void TL.Text TL.Text)))- -- fooTextLM- -- , bench "streamEdit 1,000,000" $ whnf- -- (streamEdit (chunk "foo" :: Parsec Void TL.Text TL.Text) (const "bar"))- -- fooTextLM- -- ]- ]-
replace-attoparsec.cabal view
@@ -1,5 +1,5 @@ name: replace-attoparsec-version: 1.0.3.0+version: 1.2.0.0 cabal-version: 1.18 synopsis: Find, replace, and edit text patterns with Attoparsec parsers homepage: https://github.com/jamesdbrock/replace-attoparsec@@ -58,17 +58,4 @@ , text , parsers ghc-options: -Wall--benchmark bench-unit- main-is: BenchUnit.hs- hs-source-dirs: bench- type: exitcode-stdio-1.0- default-language: Haskell2010- build-depends: base >= 4.0 && < 5.0- , attoparsec- , replace-attoparsec- , text- , bytestring- , criterion- ghc-options: -O2 -Wall
src/Replace/Attoparsec/ByteString.hs view
@@ -31,6 +31,7 @@ -- See the __[replace-attoparsec](https://hackage.haskell.org/package/replace-attoparsec)__ package README for usage examples. {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BangPatterns #-} module Replace.Attoparsec.ByteString (@@ -42,9 +43,6 @@ -- * Running parser , streamEdit , streamEditT-- -- * Parser- , getOffset ) where @@ -52,9 +50,8 @@ import Data.Bifunctor import Control.Applicative import Control.Monad-import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString as A import qualified Data.ByteString as B-import GHC.Word import qualified Data.Attoparsec.Internal.Types as AT -- |@@ -92,29 +89,81 @@ sepCap :: Parser a -- ^ The pattern matching parser @sep@ -> Parser [Either B.ByteString a]-sepCap sep = (fmap.fmap) (first B.pack)- $ fmap sequenceLeft- $ many $ fmap Right (consumeSome sep) <|> fmap Left anyWord8- -- TODO We might consider accumulating a Builder for Left instead- -- of returning a list of Word8.- -- Would expect faster for sparse patterns, slower for dense- -- patterns.+sepCap sep = getOffset >>= go where- sequenceLeft :: [Either Word8 r] -> [Either [Word8] r]- sequenceLeft = foldr consLeft []- where- consLeft :: Either l r -> [Either [l] r] -> [Either [l] r]- consLeft (Left l) ((Left ls):xs) = (Left (l:ls)):xs- consLeft (Left l) xs = (Left [l]):xs- consLeft (Right r) xs = (Right r):xs- -- If sep succeeds and consumes 0 input tokens, we must force it to fail,- -- otherwise infinite loop- consumeSome p = do- offset1 <- getOffset- x <- p- offset2 <- getOffset- when (offset1 >= offset2) empty- return x+ -- 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.+ -- offsetBegin is the position in the buffer after the last pattern+ -- match.+ go !offsetBegin = do+ !offsetThis <- getOffset+ (<|>)+ ( do+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Internal.html#endOfInput+ _ <- endOfInput+ if offsetThis > offsetBegin+ then+ -- If we're at the end of the input, then return+ -- whatever unmatched string we've got since offsetBegin+ substring offsetBegin offsetThis >>= \s -> pure [Left s]+ else pure []+ )+ ( do+ -- 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+ !offsetAfter <- getOffset+ -- Don't allow a match of a zero-width pattern+ when (offsetAfter <= offsetThis) empty+ return $ Just (x, offsetAfter)+ )+ (advance >> return Nothing)+ case thisiter of+ (Just (x, !offsetAfter)) | offsetThis > offsetBegin -> do+ -- we've got a match with some preceding unmatched string+ unmatched <- substring offsetBegin offsetThis+ (Left unmatched:) <$> (Right x:) <$> go offsetAfter+ (Just (x, !offsetAfter)) -> do+ -- we're got a match with no preceding unmatched string+ (Right x:) <$> go offsetAfter+ Nothing -> go offsetBegin -- no match, try again+ )+ -- Using this advance function instead of 'anyWord8' seems to give us+ -- a 5%-20% performance improvement.+ --+ -- It's safe to use 'advance' because after 'advance' we always check+ -- for 'endOfInput' before trying to read anything from the buffer.+ --+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.ByteString.Internal.html#anyWord8+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.ByteString.Internal.html#advance+ -- advance :: Parser ()+ advance = AT.Parser $ \t pos more _lose succes ->+ succes t (pos + AT.Pos 1) more ()++ -- Extract a substring from part of the buffer that we've already visited.+ -- Does not check bounds.+ --+ -- The idea here is that we go back and run the parser 'take' at the Pos+ -- which we saved from before, and then we continue from the current Pos,+ -- hopefully without messing up the internal parser state.+ --+ -- Should be equivalent to the unexported function+ -- Data.Attoparsec.ByteString.Buffer.substring+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.ByteString.Buffer.html#substring+ --+ -- This is a performance optimization for gathering the unmatched+ -- sections of the input. The alternative is to accumulate unmatched+ -- characters one anyWord8 at a time in a list of [Word8] and then pack+ -- them into a ByteString.+ substring :: Int -> Int -> Parser B.ByteString+ substring !pos1 !pos2 = AT.Parser $ \t pos more lose succes ->+ let succes' _t _pos _more a = succes t pos more a+ in AT.runParser (A.take (pos2 - pos1)) t (AT.Pos pos1) more lose succes' {-# INLINABLE sepCap #-} -- |@@ -233,7 +282,9 @@ (Right r) -> fmap mconcat $ traverse (either return editor) r {-# INLINABLE streamEditT #-} --- | Get the 'Data.Attoparsec.ByteString.Parser' ’s current offset position in the stream.+-- |+-- Get the 'Data.Attoparsec.Internal.Types.Parser' current offset+-- 'Data.Attoparsec.Internal.Types.Pos' in the stream. -- -- [“… you know you're in an uncomfortable state of sin :-)” — bos](https://github.com/bos/attoparsec/issues/101) getOffset :: Parser Int
src/Replace/Attoparsec/Text.hs view
@@ -43,9 +43,6 @@ -- * Running parser , streamEdit , streamEditT-- -- * Parser- , getOffset ) where @@ -53,8 +50,9 @@ import Data.Bifunctor import Control.Applicative import Control.Monad-import Data.Attoparsec.Text+import Data.Attoparsec.Text as A import qualified Data.Text as T+import qualified Data.Text.Internal as TI import qualified Data.Attoparsec.Internal.Types as AT -- |@@ -92,25 +90,101 @@ sepCap :: Parser a -- ^ The pattern matching parser @sep@ -> Parser [Either T.Text a]-sepCap sep = (fmap.fmap) (first T.pack)- $ fmap sequenceLeft- $ many $ fmap Right (consumeSome sep) <|> fmap Left anyChar+sepCap sep = getOffset >>= go where- sequenceLeft :: [Either Char r] -> [Either [Char] r]- sequenceLeft = foldr consLeft []+ -- 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.+ -- offsetBegin is the position in the buffer after the last pattern+ -- match.+ go !offsetBegin = do+ !offsetThis <- getOffset+ (<|>)+ ( do+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Internal.html#endOfInput+ _ <- endOfInput+ if offsetThis > offsetBegin+ then+ -- If we're at the end of the input, then return+ -- whatever unmatched string we've got since offsetBegin+ substring offsetBegin offsetThis >>= \s -> pure [Left s]+ else pure []+ )+ ( do+ -- 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+ !offsetAfter <- getOffset+ -- Don't allow a match of a zero-width pattern+ when (offsetAfter <= offsetThis) empty+ return $ Just (x, offsetAfter)+ )+ (anyChar >> return Nothing)+ case thisiter of+ (Just (x, !offsetAfter)) | offsetThis > offsetBegin -> do+ -- we've got a match with some preceding unmatched string+ unmatched <- substring offsetBegin offsetThis+ (Left unmatched:) <$> (Right x:) <$> go offsetAfter+ (Just (x, !offsetAfter)) -> do+ -- we're got a match with no preceding unmatched string+ (Right x:) <$> go offsetAfter+ Nothing -> go offsetBegin -- no match, try again+ )++ -- Extract a substring from part of the buffer that we've already visited.+ --+ -- The idea here is that we go back and run the parser 'take' at the Pos+ -- which we saved from before, and then we continue from the current Pos,+ -- hopefully without messing up the internal parser state.+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Text.Internal.html#take+ --+ -- Should be equivalent to the unexported function+ -- http://hackage.haskell.org/package/attoparsec-0.13.2.3/docs/src/Data.Attoparsec.Text.Internal.html#substring+ --+ -- This is a performance optimization for gathering the unmatched+ -- sections of the input. The alternative is to accumulate unmatched+ -- characters one anyChar at a time in a list of [Char] and then pack+ -- them into a Text.+ substring :: Int -> Int -> Parser T.Text+ substring !bgn !end = AT.Parser $ \t pos more lose succes ->+ let succes' _t _pos _more a = succes t pos more a+ in+ AT.runParser (takeCheat (end - bgn)) t (AT.Pos bgn) more lose succes' where- consLeft :: Either l r -> [Either [l] r] -> [Either [l] r]- consLeft (Left l) ((Left ls):xs) = {-# SCC consLeft #-} (Left (l:ls)):xs- consLeft (Left l) xs = {-# SCC consLeft #-} (Left [l]):xs- consLeft (Right r) xs = {-# SCC consLeft #-} (Right r):xs- -- If sep succeeds and consumes 0 input tokens, we must force it to fail,- -- otherwise infinite loop- consumeSome p = {-# SCC consumeSome #-} do- offset1 <- getOffset- x <- {-# SCC sep #-} p- offset2 <- getOffset- when (offset1 >= offset2) empty- return x+ -- Dear reader, you deserve an explanation for 'takeCheat'. The+ -- alternative to running 'takeCheat' here would be the following line:+ --+ -- AT.runParser (A.take (end - bgn)) t (AT.Pos bgn) more lose succes'+ --+ -- But 'Attoparsec.take' is not correct, and 'takeCheat' is correct.+ -- It is correct because the Pos which we got from 'getOffset' is an+ -- index into the underlying Data.Text.Array, so (end - bgn) is+ -- in units of the length of the Data.Text.Array, not in units of the+ -- number of Chars.+ --+ -- Furthermore 'takeCheat' is a lot faster because 'A.take' takes a+ -- number of Chars and then iterates over the Text by the number+ -- of Chars, advancing by 4 bytes when it encounters a wide Char.+ -- So, O(N). takeCheat is O(1).+ --+ -- This will be fine as long as we always call 'takeCheat' on the+ -- immutable, already-visited part of the Attoparsec.Text.Buffer's+ -- Data.Text.Array. Which we do.+ --+ -- It's named 'takeCheat' because we're getting access to+ -- the Attoparsec.Text.Buffer through the Data.Text.Internal+ -- interface, even though Attoparsec is extremely vigilant about+ -- not exposing its buffers.+ --+ -- http://hackage.haskell.org/package/text-1.2.3.1/docs/Data-Text-Internal.html+ -- takeCheat :: Int -> Parser T.Text+ takeCheat len = do+ (TI.Text arr off _len) <- A.take 1+ return (TI.Text arr off len) {-# INLINABLE sepCap #-} -- |@@ -226,7 +300,14 @@ (Right r) -> fmap mconcat $ traverse (either return editor) r {-# INLINABLE streamEditT #-} --- | Get the 'Data.Attoparsec.Text.Parser' ’s current offset position in the stream.+-- |+-- Get the 'Data.Attoparsec.Internal.Types.Parser' current offset+-- 'Data.Attoparsec.Internal.Types.Pos' in the stream.+--+-- Note that this is not the number of 'Data.Char's which have been consumed,+-- rather it is an offset into the underlying 'Data.Text.Internal.Text'+-- array buffer, so you cannot use it as an argument to 'Data.Text.index'.+-- But you /can/ use it as an argument to 'Data.Text.Internal.text'. -- -- [“… you know you're in an uncomfortable state of sin :-)” — bos](https://github.com/bos/attoparsec/issues/101) getOffset :: Parser Int
tests/TestByteString.hs view
@@ -1,17 +1,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-}+{-# LANGUAGE CPP #-} module TestByteString ( tests ) where import Distribution.TestSuite as TestSuite-import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString as A import qualified Data.ByteString as B import Data.ByteString.Internal (c2w) import "parsers" Text.Parser.Token import Replace.Attoparsec.ByteString import Control.Applicative-+import Data.Monoid tests :: IO [Test] tests = return@@ -29,19 +30,22 @@ (sepCap scinum) ("1E3") ([Right (1,3)])- , Test $ runParserTest "getOffset"- (sepCap offsetA)- ("xxAxx")- ([Left "xx", Right 2, Left "xx"]) , Test $ runParserTest "monad fail" (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 $ runParserFeed "const string"+ (sepCap (string "aa"))+ (" a") ("a ")+ ([Left " ",Right"aa",Left" "]) , Test $ streamEditTest "x to o" (string "x") (const "o") "x x x" "o o o"+ , Test $ streamEditTest "x to o inner" (string "x") (const "o") " x x x " " o o o " , Test $ streamEditTest "ordering" (string "456") (const "ABC") "123456789" "123ABC789" ] where@@ -54,12 +58,34 @@ then return (Finished Pass) else return (Finished $ TestSuite.Fail $ show output ++ " ≠ " ++ show expected)- , name = nam+ , name = "parseOnly sepCap " <> nam , tags = [] , options = [] , setOption = \_ _ -> Left "no options supported" } + runParserFeed nam p input1 input2 expected = TestInstance+ { run = do+ case parse p input1 of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial cont1 -> case cont1 input2 of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial cont2 -> case cont2 "" of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial _ -> return (Finished $ TestSuite.Fail $ "Should not ask for more input")+ A.Done _i output ->+ if (output == expected)+ then return (Finished Pass)+ else return (Finished $ TestSuite.Fail+ $ show output ++ " ≠ " ++ show expected)+ A.Done _i _output -> return (Finished $ TestSuite.Fail $ "Should ask for more input")+ A.Done _i _output -> return (Finished $ TestSuite.Fail $ "Should ask for more input")+ , name = "parse Partial sepCap " <> nam+ , tags = []+ , options = []+ , setOption = \_ _ -> Left "no options supported"+ }+ streamEditTest nam sep editor input expected = TestInstance { run = do let output = streamEdit sep editor input@@ -81,7 +107,4 @@ return (m, e) upperChar = satisfy $ \c -> c >= c2w 'A' && c <= c2w 'Z'-- offsetA :: Parser Int- offsetA = getOffset <* string "A"
tests/TestText.hs view
@@ -1,15 +1,17 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module TestText ( tests ) where import Distribution.TestSuite as TestSuite import Replace.Attoparsec.Text-import Data.Attoparsec.Text+import Data.Attoparsec.Text as A -- import Data.Attoparsec.Text.Char import qualified Data.Text as T import Text.Parser.Char (upper) import Control.Applicative+import Data.Monoid tests :: IO [Test] tests = return@@ -27,19 +29,30 @@ (sepCap scinum) ("1E3") ([Right (1,3)])- , Test $ runParserTest "getOffset"- (sepCap offsetA)- ("xxAxx")- ([Left "xx", Right 2, Left "xx"]) , Test $ runParserTest "monad fail" (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 ((A.takeWhile (=='𝅘𝅥𝅯') :: Parser T.Text)))+ ("𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥" :: T.Text)+ [Left "𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥", Right "𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯", Left "𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥"]+ , Test $ runParserFeed "const string"+ (sepCap (string "aa"))+ (" a") ("a ")+ ([Left " ",Right"aa",Left" "])+ , Test $ runParserFeed "findAll astral"+ (findAll ((A.takeWhile (=='𝅘𝅥𝅯') :: Parser T.Text)))+ ("𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅯𝅘𝅥𝅯") ("𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥" :: T.Text)+ [Left "𝄞𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥", Right "𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅯", Left "𝅘𝅥𝅘𝅥𝅘𝅥𝅘𝅥"] , Test $ streamEditTest "x to o" (string "x") (const "o") "x x x" "o o o"+ , Test $ streamEditTest "x to o inner" (string "x") (const "o") " x x x " " o o o " , Test $ streamEditTest "ordering" (string "456") (const "ABC") "123456789" "123ABC789" ] where@@ -52,12 +65,34 @@ then return (Finished Pass) else return (Finished $ TestSuite.Fail $ show output ++ " ≠ " ++ show expected)- , name = "sepCap " ++ nam+ , name = "parseOnly sepCap " <> nam , tags = [] , options = [] , setOption = \_ _ -> Left "no options supported" } + runParserFeed nam p input1 input2 expected = TestInstance+ { run = do+ case parse p input1 of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial cont1 -> case cont1 input2 of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial cont2 -> case cont2 "" of+ A.Fail _i _ e -> return (Finished $ TestSuite.Fail $ show e)+ A.Partial _ -> return (Finished $ TestSuite.Fail $ "Should not ask for more input")+ A.Done _i output ->+ if (output == expected)+ then return (Finished Pass)+ else return (Finished $ TestSuite.Fail+ $ show output ++ " ≠ " ++ show expected)+ A.Done _i _output -> return (Finished $ TestSuite.Fail $ "Should ask for more input")+ A.Done _i _output -> return (Finished $ TestSuite.Fail $ "Should ask for more input")+ , name = "parse Partial sepCap " <> nam+ , tags = []+ , options = []+ , setOption = \_ _ -> Left "no options supported"+ }+ streamEditTest nam sep editor input expected = TestInstance { run = do let output = streamEdit sep editor input@@ -78,7 +113,4 @@ e <- decimal return (m, e) -- offsetA :: Parser Int- offsetA = getOffset <* string "A"