diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for replace-megaparsec +## 1.4.0.0 -- 2020-05-06 + +__Running Parsers__: Add `splitCap` and `breakCap`. + +__Parser Combinators__: Add `anyTill`. + +Remove `Show` and `Typeable` constraints on `streamEditT`. + ## 1.3.0.0 -- 2020-03-06 `sepCap` won't throw. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,6 +3,7 @@ [![Hackage](https://img.shields.io/hackage/v/replace-megaparsec.svg?style=flat)](https://hackage.haskell.org/package/replace-megaparsec) [![Stackage Nightly](http://stackage.org/package/replace-megaparsec/badge/nightly)](http://stackage.org/nightly/package/replace-megaparsec) [![Stackage LTS](http://stackage.org/package/replace-megaparsec/badge/lts)](http://stackage.org/lts/package/replace-megaparsec) +[![Binder](https://mybinder.org/badge_logo.svg)](https://mybinder.org/v2/gh/jamesdbrock/replace-megaparsec/master?urlpath=lab/tree/work/ReplaceMegaparsecUsage.ipynb) * [Usage Examples](#usage-examples) * [In the Shell](#in-the-shell) @@ -10,8 +11,8 @@ * [Benchmarks](#benchmarks) * [Hypothetically Asked Questions](#hypothetically-asked-questions) -__replace-megaparsec__ is for finding text patterns, and also editing and -replacing the found patterns. +__replace-megaparsec__ is for finding text patterns, and also +replacing or splitting on the found patterns. This activity is traditionally done with regular expressions, but __replace-megaparsec__ uses [__megaparsec__](http://hackage.haskell.org/package/megaparsec) @@ -35,6 +36,12 @@ or [`awk`](https://www.gnu.org/software/gawk/manual/gawk.html). +__replace-megaparsec__ can be used in the same sort of “string splitting” +situations in which one would use Python +[`re.split`](https://docs.python.org/3/library/re.html#re.split) +or Perl +[`split`](https://perldoc.perl.org/functions/split.html). + See [__replace-attoparsec__](https://hackage.haskell.org/package/replace-attoparsec) for the [__attoparsec__](http://hackage.haskell.org/package/attoparsec) @@ -81,6 +88,10 @@ # Usage Examples +These usage examples can be run in a live Jupyter notebook hosted +by [mybinder.org](https://mybinder.org/). Click the badge to launch: +[![Binder](https://mybinder.org/badge_logo.svg)](https://mybinder.org/v2/gh/jamesdbrock/replace-megaparsec/master?urlpath=lab/tree/work/ReplaceMegaparsecUsage.ipynb) + Try the examples in `ghci` by running `cabal v2-repl` in the `replace-megaparsec/` root directory. @@ -95,66 +106,34 @@ import Text.Megaparsec.Char.Lexer ``` -## Parsing with `sepCap` family of parser combinators - -The following examples show how to match a pattern to a string of text -and separate it into sections -which match the pattern, and sections which don't match. +## Split strings with `splitCap` -### Pattern match, capture only the parsed result with `sepCap` +### Find all pattern matches, capture the matched text and the parsed result Separate the input string into sections which can be parsed as a hexadecimal number with a prefix `"0x"`, and sections which can't. Parse the numbers. ```haskell let hexparser = chunk "0x" *> hexadecimal :: Parsec Void String Integer -parseTest (sepCap hexparser) "0xA 000 0xFFFF" -``` -```haskell -[Right 10,Left " 000 ",Right 65535] -``` - -### Pattern match, capture only the matched text with `findAll` - -Just get the strings sections which match the hexadecimal parser, throw away -the parsed number. - -```haskell -let hexparser = chunk "0x" *> hexadecimal :: Parsec Void String Integer -parseTest (findAll hexparser) "0xA 000 0xFFFF" -``` -```haskell -[Right "0xA",Left " 000 ",Right "0xFFFF"] -``` - -### Pattern match, capture the matched text and the parsed result with `findAllCap` - -Capture the parsed hexadecimal number, as well as the string section which -parses as a hexadecimal number. - -```haskell -let hexparser = chunk "0x" *> hexadecimal :: Parsec Void String Integer -parseTest (findAllCap hexparser) "0xA 000 0xFFFF" +splitCap (match hexparser) "0xA 000 0xFFFF" ``` ```haskell -[Right ("0xA",10),Left " 000 ",Right ("0xFFFF",65535)] +[Right ("0xA",10), Left " 000 ", Right ("0xFFFF",65535)] ``` -### Pattern match, capture only the locations of the matched patterns +### Find all pattern matches, capture only the locations of the matched patterns -Find all of the sections of the stream which match -a string of spaces. -Print a list of the offsets of the beginning of every pattern match. +Find all of the sections of the stream which are letters. Capture a list of +the offsets of the beginning of every pattern match. ```haskell import Data.Either -let spaceoffset = getOffset <* space1 :: Parsec Void String Int -parseTest (pure . rights =<< sepCap spaceoffset) " a b " +let letterOffset = getOffset <* some letterChar :: Parsec Void String Int +rights $ splitCap letterOffset " a bc " ``` ```haskell -[0,2,5] +[1,4] ``` - ### Pattern match balanced parentheses Find groups of balanced nested parentheses. This is an example of a @@ -162,7 +141,8 @@ expression. We can express the pattern with a recursive parser. ```haskell -import Data.Functor +import Data.Functor (void) +import Data.Bifunctor (second) let parens :: Parsec Void String () parens = do char '(' @@ -171,13 +151,13 @@ (char ')') pure () -parseTest (findAll parens) "(()) (()())" +second fst <$> splitCap (match parens) "(()) (()())" ``` ```haskell [Right "(())",Left " ",Right "(()())"] ``` -## Edit text strings by running parsers with `streamEdit` +## Edit strings with `streamEdit` The following examples show how to search for a pattern in a string of text and then edit the string of text to substitute in some replacement text @@ -185,7 +165,7 @@ ### Pattern match and replace with a constant -Replace all carriage-return-newline instances with newline. +Replace all carriage-return-newline occurances with newline. ```haskell let crnl = chunk "\r\n" :: Parsec Void String String @@ -223,13 +203,13 @@ "10 000 0xFFFF" ``` -### Pattern match and edit the matches with IO +### Pattern match and edit the matches with IO with [`streamEditT`](https://hackage.haskell.org/package/replace-megaparsec/docs/Replace-Megaparsec.html#v:streamEditT) Find an environment variable in curly braces and replace it with its value from the environment. ```haskell -import System.Environment +import System.Environment (getEnv) let bracevar = char '{' *> manyTill anySingle (char '}') :: ParsecT Void String IO String streamEditT bracevar getEnv "- {HOME} -" ``` @@ -237,9 +217,9 @@ "- /home/jbrock -" ``` -### Context-sensitive pattern match and edit the matches +### Context-sensitive pattern match and edit the matches with [`streamEditT`](https://hackage.haskell.org/package/replace-megaparsec/docs/Replace-Megaparsec.html#v:streamEditT) -Capitalize the third letter in a string. The `capthird` parser searches for +Capitalize the third letter in a string. The `capThird` parser searches for individual letters, and it needs to remember how many times it has run so that it can match successfully only on the third time that it finds a letter. To enable the parser to remember how many times it has run, we'll @@ -252,18 +232,50 @@ import Control.Monad.State.Strict (get, put, evalState) import Data.Char (toUpper) -let capthird :: ParsecT Void String (MTL.State Int) String - capthird = do +let capThird :: ParsecT Void String (MTL.State Int) String + capThird = do x <- letterChar i <- get - put (i+1) - if i==3 then return [x] else empty + let i' = i+1 + put i' + if i'==3 then pure [x] else empty -flip evalState 1 $ streamEditT capthird (return . fmap toUpper) "a a a a a" +flip evalState 0 $ streamEditT capThird (pure . fmap toUpper) "a a a a a" ``` ```haskell "a a A a a" ``` + +### Pattern match, edit the matches, and count the edits with [`streamEditT`](https://hackage.haskell.org/package/replace-megaparsec/docs/Replace-Megaparsec.html#v:streamEditT) + +Find and capitalize no more than three letters in a string, and return the +edited string along with the number of letters capitalized. To enable the +editor function to remember how many letters it has capitalized, we'll +run `streamEditT` in the `State` monad from the `mtl` package. Use this +technique to get the same functionality as Python +[`re.subn`](https://docs.python.org/3/library/re.html#re.subn). + +```haskell +import qualified Control.Monad.State.Strict as MTL +import Control.Monad.State.Strict (get, put, runState) +import Data.Char (toUpper) + +let editThree :: Char -> MTL.State Int String + editThree x = do + i <- get + let i' = i+1 + if i'<=3 + then do + put i' + pure [toUpper x] + else pure [x] + +flip runState 0 $ streamEditT letterChar editThree "a a a a a" +``` +```haskell +("A A A a a",3) +``` + # In the Shell diff --git a/replace-megaparsec.cabal b/replace-megaparsec.cabal --- a/replace-megaparsec.cabal +++ b/replace-megaparsec.cabal @@ -1,7 +1,7 @@ name: replace-megaparsec -version: 1.3.2.0 +version: 1.4.0.0 cabal-version: 1.18 -synopsis: Find, replace, and edit text patterns with Megaparsec parsers (instead of regex) +synopsis: Find, replace, and split string patterns with Megaparsec parsers (instead of regex) homepage: https://github.com/jamesdbrock/replace-megaparsec bug-reports: https://github.com/jamesdbrock/replace-megaparsec/issues license: BSD2 @@ -12,7 +12,7 @@ category: Parsing description: - Find text patterns, and also edit or replace the found patterns. Use + Find text patterns, replace the patterns, split on the patterns. Use Megaparsec monadic parsers instead of regular expressions for pattern matching. extra-doc-files: README.md diff --git a/src/Replace/Megaparsec.hs b/src/Replace/Megaparsec.hs --- a/src/Replace/Megaparsec.hs +++ b/src/Replace/Megaparsec.hs @@ -4,8 +4,8 @@ -- License : BSD2 -- Maintainer: James Brock -- --- __Replace.Megaparsec__ is for finding text patterns, and also editing and --- replacing the found patterns. +-- __Replace.Megaparsec__ is for finding text patterns, and also +-- replacing or splitting on the found patterns. -- This activity is traditionally done with regular expressions, -- but __Replace.Megaparsec__ uses "Text.Megaparsec" parsers instead for -- the pattern matching. @@ -28,7 +28,41 @@ -- or -- . -- +-- __Replace.Megaparsec__ can be used in the same sort of “string splitting” +-- situations in which one would use Python +-- +-- or Perl +-- . +-- -- See the __replace-megaparsec__ package README for usage examples. +-- +-- == Special accelerated inputs +-- +-- There are specialization re-write rules to speed up all functions in this +-- module when the input stream type @s@ is "Data.Text" or "Data.ByteString". +-- +-- == Type constraints +-- +-- All functions in the __Running Parser__ section require the type of the +-- stream of text that is input to be +-- @'Text.Megaparsec.Stream.Stream' s@ +-- such that +-- @'Text.Megaparsec.Stream.Tokens' s ~ s@, +-- because we want to output the same type of stream that was input. +-- That requirement is satisfied for all the 'Text.Megaparsec.Stream' instances +-- included with "Text.Megaparsec": +-- +-- * "Data.String" +-- * "Data.Text" +-- * "Data.Text.Lazy" +-- * "Data.ByteString" +-- * "Data.ByteString.Lazy" +-- +-- Megaparsec parsers have an error type parameter @e@. When writing parsers +-- to be used by this module, the error type parameter @e@ should usually +-- be 'Data.Void', because every function in this module expects a parser +-- failure to occur on every token in a non-matching section of the input +-- stream, so parser failure error descriptions are not returned. {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -37,17 +71,28 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} module Replace.Megaparsec ( - -- * Parser combinator - sepCap - , findAll - , findAllCap - -- * Running parser + -- + -- | Functions in this section are ways to run parsers. They take + -- as arguments a @sep@ parser and some input, run the parser on the input, + -- and return a result. + breakCap + , splitCap , streamEdit , streamEditT + -- * Parser combinator + -- + -- | Functions in this section are parser combinators. They take + -- a @sep@ parser for an argument, combine @sep@ with another parser, + -- and return a new parser. + , anyTill + , sepCap + , findAll + , findAllCap ) where @@ -55,7 +100,6 @@ import Data.Bifunctor import Data.Functor.Identity import Data.Proxy -import Data.Typeable import Control.Monad import qualified Data.ByteString as B import qualified Data.Text as T @@ -63,15 +107,240 @@ import Replace.Megaparsec.Internal.ByteString import Replace.Megaparsec.Internal.Text + -- | --- == Separate and capture +-- === Break on and capture one pattern -- --- Parser combinator to find all of the non-overlapping ocurrences +-- Find the first occurence of a pattern in a text stream, capture the found +-- pattern, and break the input text stream on the found pattern. +-- +-- The 'breakCap' function is like 'Data.List.takeWhile', but can be predicated +-- beyond more than just the next one token. It's also like 'Data.Text.breakOn', +-- but the @needle@ can be a pattern instead of a constant string. +-- +-- Be careful not to look too far +-- ahead; if the @sep@ parser looks to the end of the input then 'breakCap' +-- could be /O(n²)/. +-- +-- The pattern parser @sep@ may match a zero-width pattern (a pattern which +-- consumes no parser input on success). +-- +-- ==== Output +-- +-- * @Nothing@ when no pattern match was found. +-- * @Just (prefix, parse_result, suffix)@ for the result of parsing the +-- pattern match, and the @prefix@ string before and the @suffix@ string +-- after the pattern match. @prefix@ and @suffix@ may be zero-length strings. +-- +-- ==== Access the matched section of text +-- +-- If you want to capture the matched string, then combine the pattern +-- parser @sep@ with 'Text.Megaparsec.match'. +-- +-- With the matched string, we can reconstruct in input string. +-- For all @input@, @sep@, if +-- +-- @ +-- let ('Just' (prefix, (infix, _), suffix)) = breakCap ('Text.Megaparsec.match' sep) input +-- @ +-- +-- then +-- +-- @ +-- input == prefix '<>' infix '<>' suffix +-- @ +breakCap + :: forall e s a. (Ord e, Stream s, Tokens s ~ s) + => Parsec e s a + -- ^ The pattern matching parser @sep@ + -> s + -- ^ The input stream of text + -> Maybe (s, a, s) + -- ^ Maybe (prefix, parse_result, suffix) +breakCap sep input = + case runParser pser "" input of + (Left _) -> Nothing + (Right x) -> Just x + where + pser = do + (prefix, cap) <- anyTill sep + suffix <- takeRest + pure (prefix, cap, suffix) +{-# INLINABLE breakCap #-} + +-- | +-- === Split on and capture all patterns +-- +-- Find all occurences of the pattern @sep@, split the input string, capture +-- all the patterns and the splits. +-- +-- The input string will be split on every leftmost non-overlapping occurence +-- of the pattern @sep@. The output list will contain +-- the parsed result of input string sections which match the @sep@ pattern +-- in 'Right', and non-matching sections in 'Left'. +-- +-- 'splitCap' depends on 'sepCap', see 'sepCap' for more details. +-- +-- ==== Access the matched section of text +-- +-- If you want to capture the matched strings, then combine the pattern +-- parser @sep@ with 'Text.Megaparsec.match'. +-- +-- With the matched strings, we can reconstruct in input string. +-- For all @input@, @sep@, if +-- +-- @ +-- let output = splitCap ('Text.Megaparsec.match' sep) input +-- @ +-- +-- then +-- +-- @ +-- input == 'Data.Monoid.mconcat' ('Data.Bifunctor.second' 'Data.Tuple.fst' '<$>' output) +-- @ +splitCap + :: forall e s a. (Ord e, Stream s, Tokens s ~ s) + => Parsec e s a + -- ^ The pattern matching parser @sep@ + -> s + -- ^ The input stream of text + -> [Either s a] + -- ^ List of matching and non-matching input sections. +splitCap sep input = do + case runParser (sepCap sep) "" input of + (Left _) -> undefined -- sepCap can never fail + (Right r) -> r +{-# INLINABLE splitCap #-} + +-- | +-- === Stream editor +-- +-- Also known as “find-and-replace”, or “match-and-substitute”. Finds all +-- non-overlapping sections of the stream which match the pattern @sep@, +-- and replaces them with the result of the @editor@ function. +-- +-- ==== Access the matched section of text in the @editor@ +-- +-- If you want access to the matched string in the @editor@ function, +-- then combine the pattern parser @sep@ with 'Text.Megaparsec.match'. +-- This will effectively change the type of the @editor@ function +-- to @(s,a) -> s@. +-- +-- This allows us to write an @editor@ function which can choose to not +-- edit the match and just leave it as it is. If the @editor@ function +-- returns the first item in the tuple, then @streamEdit@ will not change +-- the matched string. +-- +-- So, for all @sep@: +-- +-- @ +-- streamEdit ('Text.Megaparsec.match' sep) 'Data.Tuple.fst' ≡ 'Data.Function.id' +-- @ +streamEdit + :: forall e s a. (Ord e, Stream s, Monoid s, Tokens s ~ s) + => Parsec e s a + -- ^ The pattern matching parser @sep@ + -> (a -> s) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> s + -- ^ The input stream of text to be edited + -> s + -- ^ The edited input stream +streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor) +{-# INLINABLE streamEdit #-} + +-- | +-- === Stream editor transformer +-- +-- Monad transformer version of 'streamEdit'. +-- +-- Both the parser @sep@ and the @editor@ function run in the underlying +-- monad context. +-- +-- If you want to do 'IO' operations in the @editor@ function or the +-- parser @sep@, then run this in 'IO'. +-- +-- If you want the @editor@ function or the parser @sep@ to remember some state, +-- then run this in a stateful monad. +streamEditT + :: forall e s m a. (Ord e, Stream s, Monad m, Monoid s, Tokens s ~ s) + => ParsecT e s m a + -- ^ The pattern matching parser @sep@ + -> (a -> m s) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> s + -- ^ The input stream of text to be edited + -> m s + -- ^ The edited input stream +streamEditT sep editor input = do + runParserT (sepCap sep) "" input >>= \case + (Left _) -> undefined -- sepCap can never fail + (Right r) -> fmap mconcat $ traverse (either return editor) r +{-# INLINABLE streamEditT #-} + +-- | +-- === Specialized +-- +-- Parser combinator to consume input until the @sep@ pattern matches, +-- equivalent to +-- @'Control.Monad.Combinators.manyTill_' 'Text.Megaparsec.anySingle' sep@. +-- On success, returns the prefix before the pattern match and the parsed match. +-- +-- @sep@ may be a zero-width parser, it may succeed without consuming any +-- input. +-- +-- This combinator will produce a parser which +-- acts like 'Text.Megaparsec.takeWhileP' but is predicated beyond more than +-- just the next one token. 'anyTill' is also like 'Text.Megaparsec.takeWhileP' +-- in that it will be “fast” when applied to an input stream type @s@ +-- for which there are specialization re-write rules. +anyTill + :: forall e s m a. (MonadParsec e s m) + => m a -- ^ The pattern matching parser @sep@ + -> m (Tokens s, a) -- ^ parser +anyTill sep = do + (as, end) <- manyTill_ anySingle sep + pure (tokensToChunk (Proxy::Proxy s) as, end) +{-# INLINE [1] anyTill #-} +#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0) +{-# RULES "anyTill/ByteString" [2] + forall e. forall. + anyTill @e @B.ByteString = + anyTillByteString @e @B.ByteString #-} +{-# RULES "anyTill/Text" [2] + forall e. forall. + anyTill @e @T.Text = + anyTillText @e @T.Text #-} +#elif MIN_VERSION_GLASGOW_HASKELL(8,0,2,0) +{-# RULES "anyTill/ByteString" [2] + forall (pa :: ParsecT e B.ByteString m a). + anyTill @e @B.ByteString @(ParsecT e B.ByteString m) @a pa = + anyTillByteString @e @B.ByteString @(ParsecT e B.ByteString m) @a pa #-} +{-# RULES "anyTill/Text" [2] + forall (pa :: ParsecT e T.Text m a). + anyTill @e @T.Text @(ParsecT e T.Text m) @a pa = + anyTillText @e @T.Text @(ParsecT e T.Text m) @a pa #-} +#endif + +-- | +-- === Separate and capture +-- +-- Parser combinator to find all of the leftmost non-overlapping occurrences -- of the pattern parser @sep@ in a text stream. -- The 'sepCap' parser will always consume its entire input and can never fail. -- --- === Output +-- @sepCap@ is similar to the @sep*@ family of parser combinators +-- found in +-- +-- and +-- , +-- but it returns the parsed result of the @sep@ parser instead +-- of throwing it away. -- +-- ==== Output +-- -- The input stream is separated and output into a list of sections: -- -- * Sections which can parsed by the pattern @sep@ will be parsed and captured @@ -85,7 +354,7 @@ -- the entire input stream will be returned as one non-matching 'Left' section. -- * The output list will not contain two consecutive 'Left' sections. -- --- === Zero-width matches forbidden +-- ==== Zero-width matches forbidden -- -- If the pattern matching parser @sep@ would succeed without consuming any -- input then 'sepCap' will force it to fail. @@ -93,38 +362,13 @@ -- then it can match the same zero-width pattern again at the same position -- on the next iteration, which would result in an infinite number of -- overlapping pattern matches. --- --- === Special accelerated inputs --- --- There are specialization re-write rules to speed up this function when --- the input type is "Data.Text" or "Data.ByteString". --- --- === Error parameter --- --- The error type parameter @e@ for @sep@ should usually be 'Data.Void', --- because @sep@ fails on every token in a non-matching 'Left' section, --- so parser failures will not be reported. --- --- === Notes --- --- This @sepCap@ parser combinator is the basis for all of the other --- features of this module. --- --- It is similar to the @sep*@ family of functions --- found in --- --- and --- --- but, importantly, it returns the parsed result of the @sep@ parser instead --- of throwing it away, like --- . sepCap :: forall e s m a. (MonadParsec e s m) => m a -- ^ The pattern matching parser @sep@ - -> m [Either (Tokens s) a] + -> m [Either (Tokens s) a] -- ^ parser sepCap sep = (fmap.fmap) (first $ tokensToChunk (Proxy::Proxy s)) $ fmap sequenceLeft - $ many $ fmap Right (try $ consumeSome sep) <|> fmap Left anySingle + $ many $ fmap Right (try nonZeroSep) <|> fmap Left anySingle where sequenceLeft :: [Either l r] -> [Either [l] r] sequenceLeft = {-# SCC sequenceLeft #-} foldr consLeft [] @@ -135,9 +379,9 @@ 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 + nonZeroSep = {-# SCC nonZeroSep #-} do offset1 <- getOffset - x <- {-# SCC sep #-} p + x <- {-# SCC sep #-} sep offset2 <- getOffset when (offset1 >= offset2) empty return x @@ -167,7 +411,7 @@ -- | --- == Find all occurences, parse and capture pattern matches +-- === Find all occurences, parse and capture pattern matches -- -- Parser combinator for finding all occurences of a pattern in a stream. -- @@ -183,13 +427,13 @@ findAllCap :: MonadParsec e s m => m a -- ^ The pattern matching parser @sep@ - -> m [Either (Tokens s) (Tokens s, a)] + -> m [Either (Tokens s) (Tokens s, a)] -- ^ parser findAllCap sep = sepCap (match sep) {-# INLINABLE findAllCap #-} -- | --- == Find all occurences +-- === Find all occurences -- -- Parser combinator for finding all occurences of a pattern in a stream. -- @@ -205,96 +449,6 @@ findAll :: MonadParsec e s m => m a -- ^ The pattern matching parser @sep@ - -> m [Either (Tokens s) (Tokens s)] + -> m [Either (Tokens s) (Tokens s)] -- ^ parser findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep) {-# INLINABLE findAll #-} - - --- | --- == Stream editor --- --- Also known as “find-and-replace”, or “match-and-substitute”. Finds all --- of the sections of the stream which match the pattern @sep@, and replaces --- them with the result of the @editor@ function. --- --- This function is not a “parser combinator,” it is --- a “way to run a parser”, like 'Text.Megaparsec.parse' --- or 'Text.Megaparsec.runParserT'. --- --- === Access the matched section of text in the @editor@ --- --- If you want access to the matched string in the @editor@ function, --- then combine the pattern parser @sep@ with 'Text.Megaparsec.match'. --- This will effectively change the type of the @editor@ function --- to @(s,a) -> s@. --- --- This allows us to write an @editor@ function which can choose to not --- edit the match and just leave it as it is. If the @editor@ function --- returns the first item in the tuple, then @streamEdit@ will not change --- the matched string. --- --- So, for all @sep@: --- --- @ --- streamEdit ('Text.Megaparsec.match' sep) 'Data.Tuple.fst' ≡ 'Data.Function.id' --- @ --- --- === Type constraints --- --- The type of the stream of text that is input must --- be @Stream s@ such that @Tokens s ~ s@, because we want --- to output the same type of stream that was input. That requirement is --- satisfied for all the 'Text.Megaparsec.Stream' instances included --- with "Text.Megaparsec": --- "Data.Text", --- "Data.Text.Lazy", --- "Data.ByteString", --- "Data.ByteString.Lazy", --- and "Data.String". --- --- We need the @Monoid s@ instance so that we can 'Data.Monoid.mconcat' the output --- stream. --- --- The error type parameter @e@ should usually be 'Data.Void'. -streamEdit - :: forall e s a. (Ord e, Stream s, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) - => Parsec e s a - -- ^ The parser @sep@ for the pattern of interest. - -> (a -> s) - -- ^ The @editor@ function. Takes a parsed result of @sep@ - -- and returns a new stream section for the replacement. - -> s - -- ^ The input stream of text to be edited. - -> s -streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor) -{-# INLINABLE streamEdit #-} - --- | --- == Stream editor transformer --- --- Monad transformer version of 'streamEdit'. --- --- Both the parser @sep@ and the @editor@ function run in the underlying --- monad context. --- --- If you want to do 'IO' operations in the @editor@ function or the --- parser @sep@, then run this in 'IO'. --- --- If you want the @editor@ function or the parser @sep@ to remember some state, --- then run this in a stateful monad. -streamEditT - :: forall e s m a. (Ord e, Stream s, Monad m, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) - => ParsecT e s m a - -- ^ The parser @sep@ for the pattern of interest. - -> (a -> m s) - -- ^ The @editor@ function. Takes a parsed result of @sep@ - -- and returns a new stream section for the replacement. - -> s - -- ^ The input stream of text to be edited. - -> m s -streamEditT sep editor input = do - runParserT (sepCap sep) "" input >>= \case - (Left _) -> undefined -- sepCap can never fail - (Right r) -> fmap mconcat $ traverse (either return editor) r -{-# INLINABLE streamEditT #-} - diff --git a/src/Replace/Megaparsec/Internal/ByteString.hs b/src/Replace/Megaparsec/Internal/ByteString.hs --- a/src/Replace/Megaparsec/Internal/ByteString.hs +++ b/src/Replace/Megaparsec/Internal/ByteString.hs @@ -6,9 +6,11 @@ -- -- This internal module is for 'Data.ByteString.ByteString' specializations. -- --- The functions in this module are supposed to be chosen automatically +-- The functions in this module are intended to be chosen automatically -- by rewrite rules in the "Replace.Megaparsec" module, so you should never -- need to import this module. +-- +-- Names in this module may change without a major version increment. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -17,6 +19,7 @@ ( -- * Parser combinator sepCapByteString + , anyTillByteString ) where @@ -71,3 +74,19 @@ else pure [] ) +{-# INLINE [1] anyTillByteString #-} +anyTillByteString + :: forall e s m a. (MonadParsec e s m, s ~ B.ByteString) + => m a -- ^ The pattern matching parser @sep@ + -> m (Tokens s, a) +anyTillByteString sep = do + begin <- getInput + (end, x) <- go + pure (B.take (B.length begin - B.length end) begin, x) + where + go = do + end <- getInput + r <- optional sep + case r of + Nothing -> anySingle >> go + Just x -> pure (end, x) diff --git a/src/Replace/Megaparsec/Internal/Text.hs b/src/Replace/Megaparsec/Internal/Text.hs --- a/src/Replace/Megaparsec/Internal/Text.hs +++ b/src/Replace/Megaparsec/Internal/Text.hs @@ -6,9 +6,11 @@ -- -- This internal module is for 'Data.Text.Text' specializations. -- --- The functions in this module are supposed to be chosen automatically +-- The functions in this module are intended to be chosen automatically -- by rewrite rules in the "Replace.Megaparsec" module, so you should never -- need to import this module. +-- +-- Names in this module may change without a major version increment. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -17,6 +19,7 @@ ( -- * Parser combinator sepCapText + , anyTillText ) where @@ -71,4 +74,21 @@ pure [Left restBegin] else pure [] ) + +{-# INLINE [1] anyTillText #-} +anyTillText + :: forall e s m a. (MonadParsec e s m, s ~ T.Text) + => m a -- ^ The pattern matching parser @sep@ + -> m (Tokens s, a) +anyTillText sep = do + (Text tarray beginIndx beginLen) <- getInput + (thisLen, x) <- go + pure (Text tarray beginIndx (beginLen - thisLen), x) + where + go = do + (Text _ _ thisLen) <- getInput + r <- optional sep + case r of + Nothing -> anySingle >> go + Just x -> pure (thisLen, x) diff --git a/tests/TestByteString.hs b/tests/TestByteString.hs --- a/tests/TestByteString.hs +++ b/tests/TestByteString.hs @@ -58,6 +58,14 @@ (string "456" :: Parser B.ByteString) (const "ABC") "123456789" "123ABC789" , Test $ streamEditTest "empty input" (match (fail "" :: Parser ())) (fst) "" "" + , Test $ breakCapTest "basic" (upperChar :: Parser Word8) "aAa" (Just ("a", c2w 'A', "a")) + , Test $ breakCapTest "first" (upperChar :: Parser Word8) "Aa" (Just ("", c2w 'A', "a")) + , Test $ breakCapTest "last" (upperChar :: Parser Word8) "aA" (Just ("a", c2w 'A', "")) + , Test $ breakCapTest "fail" (upperChar :: Parser Word8) "aaa" Nothing + , Test $ breakCapTest "match" (match (upperChar :: Parser Word8)) "aAa" (Just ("a", ("A",c2w 'A'), "a")) + , Test $ breakCapTest "zero-width" (lookAhead (upperChar :: Parser Word8)) "aAa" (Just ("a", c2w 'A', "Aa")) + , Test $ breakCapTest "empty input" (upperChar :: Parser Word8) "" Nothing + , Test $ breakCapTest "empty input zero-width" (return () :: Parser ()) "" (Just ("", (), "")) ] where runParserTest nam p input expected = TestInstance @@ -68,7 +76,7 @@ if (output == expected) then return (Finished Pass) else return (Finished $ Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = nam , tags = [] , options = [] @@ -81,13 +89,26 @@ if (output == expected) then return (Finished Pass) else return (Finished $ TestSuite.Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = "streamEdit " ++ nam , tags = [] , options = [] , setOption = \_ _ -> Left "no options supported" } + breakCapTest nam sep input expected = TestInstance + { run = do + let output = breakCap sep input + if (output == expected) + then return (Finished Pass) + else return (Finished $ TestSuite.Fail + $ "got " <> show output <> " expected " <> show expected) + , name = "breakCap " ++ nam + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + scinum :: Parser (Double, Integer) scinum = do -- This won't parse mantissas that contain a decimal point, @@ -97,7 +118,6 @@ _ <- chunk "E" e <- decimal return (m, e) - offsetA :: Parser Int offsetA = getOffset <* chunk "A" diff --git a/tests/TestString.hs b/tests/TestString.hs --- a/tests/TestString.hs +++ b/tests/TestString.hs @@ -58,6 +58,14 @@ (string "456" :: Parser String) (const "ABC") "123456789" "123ABC789" , Test $ streamEditTest "empty input" (match (fail "" :: Parser ())) (fst) "" "" + , Test $ breakCapTest "basic" (upperChar :: Parser Char) "aAa" (Just ("a", 'A', "a")) + , Test $ breakCapTest "first" (upperChar :: Parser Char) "Aa" (Just ("", 'A', "a")) + , Test $ breakCapTest "last" (upperChar :: Parser Char) "aA" (Just ("a", 'A', "")) + , Test $ breakCapTest "fail" (upperChar :: Parser Char) "aaa" Nothing + , Test $ breakCapTest "match" (match (upperChar :: Parser Char)) "aAa" (Just ("a", ("A",'A'), "a")) + , Test $ breakCapTest "zero-width" (lookAhead (upperChar :: Parser Char)) "aAa" (Just ("a", 'A', "Aa")) + , Test $ breakCapTest "empty input" (upperChar :: Parser Char) "" Nothing + , Test $ breakCapTest "empty input zero-width" (return () :: Parser ()) "" (Just ("", (), "")) ] where runParserTest nam p input expected = TestInstance @@ -68,7 +76,7 @@ if (output == expected) then return (Finished Pass) else return (Finished $ Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = nam , tags = [] , options = [] @@ -81,8 +89,21 @@ if (output == expected) then return (Finished Pass) else return (Finished $ TestSuite.Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = "streamEdit " ++ nam + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + + breakCapTest nam sep input expected = TestInstance + { run = do + let output = breakCap sep input + if (output == expected) + then return (Finished Pass) + else return (Finished $ TestSuite.Fail + $ "got " <> show output <> " expected " <> show expected) + , name = "breakCap " ++ nam , tags = [] , options = [] , setOption = \_ _ -> Left "no options supported" diff --git a/tests/TestText.hs b/tests/TestText.hs --- a/tests/TestText.hs +++ b/tests/TestText.hs @@ -60,6 +60,14 @@ (string "456" :: Parser T.Text) (const "ABC") "123456789" "123ABC789" , Test $ streamEditTest "empty input" (match (fail "" :: Parser ())) (fst) "" "" + , Test $ breakCapTest "basic" (upperChar :: Parser Char) "aAa" (Just ("a", 'A', "a")) + , Test $ breakCapTest "first" (upperChar :: Parser Char) "Aa" (Just ("", 'A', "a")) + , Test $ breakCapTest "last" (upperChar :: Parser Char) "aA" (Just ("a", 'A', "")) + , Test $ breakCapTest "fail" (upperChar :: Parser Char) "aaa" Nothing + , Test $ breakCapTest "match" (match (upperChar :: Parser Char)) "aAa" (Just ("a", ("A",'A'), "a")) + , Test $ breakCapTest "zero-width" (lookAhead (upperChar :: Parser Char)) "aAa" (Just ("a", 'A', "Aa")) + , Test $ breakCapTest "empty input" (upperChar :: Parser Char) "" Nothing + , Test $ breakCapTest "empty input zero-width" (return () :: Parser ()) "" (Just ("", (), "")) ] where runParserTest nam p input expected = TestInstance @@ -70,7 +78,7 @@ if (output == expected) then return (Finished Pass) else return (Finished $ Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = nam , tags = [] , options = [] @@ -83,8 +91,21 @@ if (output == expected) then return (Finished Pass) else return (Finished $ TestSuite.Fail - $ show output ++ " ≠ " ++ show expected) + $ "got " <> show output <> " expected " <> show expected) , name = "streamEdit " ++ nam + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + + breakCapTest nam sep input expected = TestInstance + { run = do + let output = breakCap sep input + if (output == expected) + then return (Finished Pass) + else return (Finished $ TestSuite.Fail + $ "got " <> show output <> " expected " <> show expected) + , name = "breakCap " ++ nam , tags = [] , options = [] , setOption = \_ _ -> Left "no options supported"