diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/bench/BenchUnit.hs b/bench/BenchUnit.hs deleted file mode 100644 --- a/bench/BenchUnit.hs +++ /dev/null @@ -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 - -- ] - ] - diff --git a/replace-attoparsec.cabal b/replace-attoparsec.cabal --- a/replace-attoparsec.cabal +++ b/replace-attoparsec.cabal @@ -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 diff --git a/src/Replace/Attoparsec/ByteString.hs b/src/Replace/Attoparsec/ByteString.hs --- a/src/Replace/Attoparsec/ByteString.hs +++ b/src/Replace/Attoparsec/ByteString.hs @@ -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 diff --git a/src/Replace/Attoparsec/Text.hs b/src/Replace/Attoparsec/Text.hs --- a/src/Replace/Attoparsec/Text.hs +++ b/src/Replace/Attoparsec/Text.hs @@ -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 diff --git a/tests/TestByteString.hs b/tests/TestByteString.hs --- a/tests/TestByteString.hs +++ b/tests/TestByteString.hs @@ -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" diff --git a/tests/TestText.hs b/tests/TestText.hs --- a/tests/TestText.hs +++ b/tests/TestText.hs @@ -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"