diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for replace-attoparsec + +## 1.0.0.0 -- 2019-09-10 + +* First version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2019, James Brock +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,263 @@ +# replace-attoparsec + +[![Hackage](https://img.shields.io/hackage/v/replace-attoparsec.svg?style=flat)](https://hackage.haskell.org/package/replace-attoparsec) +[![Stackage Nightly](http://stackage.org/package/replace-attoparsec/badge/nightly)](http://stackage.org/nightly/package/replace-attoparsec) +[![Stackage LTS](http://stackage.org/package/replace-attoparsec/badge/lts)](http://stackage.org/lts/package/replace-attoparsec) + +__replace-attoparsec__ is for finding text patterns, and also editing and +replacing the found patterns. +This activity is traditionally done with regular expressions, +but __replace-attoparsec__ uses +[__attoparsec__](http://hackage.haskell.org/package/attoparsec) +parsers instead for the pattern matching. + +__replace-attoparsec__ can be used in the same sort of “pattern capture” +or “find all” situations in which one would use Python +[`re.findall`](https://docs.python.org/3/library/re.html#re.findall) +or +Perl [`m//`](https://perldoc.perl.org/functions/m.html), +or +Unix [`grep`](https://www.gnu.org/software/grep/). + +__replace-attoparsec__ can be used in the same sort of “stream editing” +or “search-and-replace” situations in which one would use Python +[`re.sub`](https://docs.python.org/3/library/re.html#re.sub), +or +Perl [`s///`](https://perldoc.perl.org/functions/s.html), +or Unix +[`sed`](https://www.gnu.org/software/sed/manual/html_node/The-_0022s_0022-Command.html), +or +[`awk`](https://www.gnu.org/software/gawk/manual/gawk.html). + +See [__replace-megaparsec__](https://hackage.haskell.org/package/replace-megaparsec) +for the +[__megaparsec__](http://hackage.haskell.org/package/megaparsec) +version. + +## Why would we want to do pattern matching and substitution with parsers instead of regular expressions? + +* Haskell parsers have a nicer syntax than + [regular expressions](https://en.wikipedia.org/wiki/Regular_expression), + which are notoriously + [difficult to read](https://en.wikipedia.org/wiki/Write-only_language). + +* Regular expressions can do “group capture” on sections of the matched + pattern, but they can only return stringy lists of the capture groups. Parsers + can construct typed data structures based on the capture groups, guaranteeing + no disagreement between the pattern rules and the rules that we're using + to build data structures based on the pattern matches. + + For example, consider + scanning a string for numbers. A lot of different things can look like a number, + and can have leading plus or minus signs, or be in scientific notation, or + have commas, or whatever. If we try to parse all of the numbers out of a string + using regular expressions, then we have to make sure that the regular expression + and the string-to-number conversion function agree about exactly what is + and what isn't a numeric string. We can get into an awkward situation in which + the regular expression says it has found a numeric string but the + string-to-number conversion function fails. A typed parser will perform both + the pattern match and the conversion, so it will never be in that situation. + +* Regular expressions are only able to pattern-match + [regular](https://en.wikipedia.org/wiki/Chomsky_hierarchy#The_hierarchy) + grammers. + Parsers are able pattern-match with context-free grammers, and + even context-sensitive grammers, if needed. See below for + an example of lifting a `Parser` into a `State` monad for context-sensitive + pattern-matching. + +* The replacement expression for a traditional regular expression-based + substitution command is usually just a string template in which + the *Nth* “capture group” can be inserted with the syntax `\N`. With + this library, instead of a template, we get + an `editor` function which can perform any computation, including IO. + +## Examples + +Try the examples in `ghci` by +running `cabal v2-repl` in the `replace-attoparsec/` +root directory. + +The examples depend on these imports and `LANGUAGE OverloadedStrings`. + +```haskell +:set -XOverloadedStrings +import Replace.Attoparsec.Text +import Data.Attoparsec.Text as AT +import qualified Data.Text as T +import Data.Either +import Data.Char +``` + +### Parsing with `sepCap` family of parser combinators + +The following examples show how to match a pattern to a string of text +and deconstruct the string of text by separating it into sections +which match the pattern, and sections which don't match. + +#### Pattern match, capture only the parsed result with `sepCap` + +Separate the input string into sections which can be parsed as a hexadecimal +number with a prefix `"0x"`, and sections which can't. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parser Integer +fromRight [] $ parseOnly (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 = string "0x" >> hexadecimal :: Parser Integer +fromRight [] $ parseOnly (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 :: Parser Integer +fromRight [] $ parseOnly (findAllCap hexparser) "0xA 000 0xFFFF" +``` +```haskell +[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 the outer parentheses of all balanced nested parentheses. +Here's an example of matching a pattern that can't be expressed by a regular +expression. We can express the pattern with a recursive parser. + +```haskell +let parens :: Parser () + parens = do + char '(' + manyTill + (void (satisfy $ notInClass "()") <|> void parens) + (char ')') + return () + +fromRight [] $ parseOnly (findAll parens) "(()) (()())" +``` +```haskell +[Right "(())",Left " ",Right "(()())"] +``` + +### Edit text strings by running parsers 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 +for the matched patterns. + +#### Pattern match and replace with a constant + +Replace all carriage-return-newline instances with newline. + +```haskell +streamEdit (string "\r\n") (const "\n") "1\r\n2\r\n" +``` +```haskell +"1\n2\n" +``` + +#### Pattern match and edit the matches + +Replace alphabetic characters with the next character in the alphabet. + +```haskell +streamEdit (AT.takeWhile isLetter) (T.map succ) "HAL 9000" +``` +```haskell +"IBM 9000" +``` + +#### Pattern match and maybe edit the matches, or maybe leave them alone + +Find all of the string sections *`s`* which can be parsed as a +hexadecimal number *`r`*, +and if *`r≤16`*, then replace *`s`* with a decimal number. Uses the +[`match`](https://hackage.haskell.org/package/attoparsec/docs/Data-Attoparsec-Text.html#v:match) +combinator. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parser Integer +streamEdit (match hexparser) (\(s,r) -> if r <= 16 then T.pack (show r) else s) "0xA 000 0xFFFF" +``` +```haskell +"10 000 0xFFFF" +``` + +#### Pattern match and edit the matches with IO + +```haskell +import System.Environment +streamEditT (char '{' *> manyTill anyChar (char '}')) (fmap T.pack . getEnv) "- {HOME} -" +``` +```haskell +"- /home/jbrock -" +``` + +## Alternatives + + + + + + + + + + + + + + + + + + + +## Hypothetically Asked Questions + +1. *Is it fast?* + + lol not really. `sepCap` is fundamentally about consuming the stream one + token at a time while we try and fail to run a parser and then + backtrack each time. That's + [a slow activity](https://markkarpov.com/megaparsec/megaparsec.html#writing-efficient-parsers). + +2. *Could we write this library for __parsec__?* + + No, because the + [`match`](https://hackage.haskell.org/package/attoparsec/docs/Data-Attoparsec-Text.html#v:match) + combinator doesn't exist for __parsec__. (I can't find it anywhere. + [Can it be written?](http://www.serpentine.com/blog/2014/05/31/attoparsec/#from-strings-to-buffers-and-cursors)) + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/BenchUnit.hs b/bench/BenchUnit.hs new file mode 100644 --- /dev/null +++ b/bench/BenchUnit.hs @@ -0,0 +1,158 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/replace-attoparsec.cabal @@ -0,0 +1,74 @@ +name: replace-attoparsec +version: 1.0.0.0 +cabal-version: >=1.18 +synopsis: Stream editing with Attoparsec +homepage: https://github.com/jamesdbrock/replace-attoparsec +bug-reports: https://github.com/jamesdbrock/replace-attoparsec/issues +license: BSD2 +license-file: LICENSE +author: James Brock +maintainer: jamesbrock@gmail.com +build-type: Simple +category: Parsing +description: + + Stream editing and find-and-replace with Attoparsec monadic parser + combinators. + +extra-doc-files: README.md + , CHANGELOG.md + +source-repository head + type: git + location: https://github.com/jamesdbrock/replace-attoparsec.git + +library + hs-source-dirs: src + build-depends: base >=4.0 && <5.0 + , attoparsec + , bytestring + , text + default-language: Haskell2010 + exposed-modules: Replace.Attoparsec.Text + , Replace.Attoparsec.ByteString + ghc-options: -O2 -Wall + +test-suite test-bytestring + type: detailed-0.9 + test-module: TestByteString + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: base >= 4.0 && < 5.0 + , replace-attoparsec + , attoparsec + , Cabal + , bytestring + , parsers + ghc-options: -Wall + +test-suite test-text + type: detailed-0.9 + test-module: TestText + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: base >= 4.0 && < 5.0 + , replace-attoparsec + , attoparsec + , Cabal + , 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 new file mode 100644 --- /dev/null +++ b/src/Replace/Attoparsec/ByteString.hs @@ -0,0 +1,241 @@ +-- | +-- Module : Replace.Attoparsec.ByteString +-- +-- __Replace.Attoparsec__ is for finding text patterns, and also editing and +-- replacing the found patterns. +-- This activity is traditionally done with regular expressions, +-- but __Replace.Attoparsec__ uses "Data.Attoparsec" parsers instead for +-- the pattern matching. +-- +-- __Replace.Attoparsec__ can be used in the same sort of “pattern capture” +-- or “find all” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- . +-- +-- __Replace.Attoparsec__ can be used in the same sort of “stream editing” +-- or “search-and-replace” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- , +-- or +-- . +-- +-- See the __[replace-attoparsec](https://hackage.haskell.org/package/replace-attoparsec)__ package README for usage examples. + +{-# LANGUAGE LambdaCase #-} + +module Replace.Attoparsec.ByteString + ( + -- * Parser combinator + sepCap + , findAll + , findAllCap + + -- * Running parser + , streamEdit + , streamEditT + + -- * Parser + , getOffset + ) +where + +-- import Control.Exception (SomeException, throw) +import Data.Functor.Identity +import Data.Bifunctor +import Control.Applicative +import Control.Monad +import Data.Attoparsec.ByteString +import qualified Data.ByteString as B +import GHC.Word +import qualified Data.Attoparsec.Internal.Types as AT + +-- | +-- == Separate and capture +-- +-- Parser combinator to find all of the non-overlapping ocurrences +-- of the pattern @sep@ in a text stream. Separate the stream into sections: +-- +-- * sections which can parsed by the pattern @sep@ will be captured as +-- matching sections in 'Right' +-- * non-matching sections of the stream will be captured in 'Left'. +-- +-- This parser will always consume its entire input and can never fail. +-- If there are no pattern matches, then the entire input stream will be +-- returned as a non-matching 'Left' section. +-- +-- The pattern matching parser @sep@ will not be allowed to succeed without +-- consuming any input. If we allow the parser to match a zero-width pattern, +-- 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. So, for example, the +-- pattern @many digit@, which can match zero occurences of a digit, +-- will be treated by @sepCap@ as @many1 digit@, and required to match +-- at least one digit. +-- +-- 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. +-- +{-# INLINABLE sepCap #-} +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. + 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 + +-- | +-- == Find all occurences, parse and capture pattern matches +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Data.Attoparsec.ByteString.match' combinator so that +-- the text which matched the pattern parser @sep@ will be returned in +-- the 'Right' sections, along with the result of the parse of @sep@. +-- +-- Definition: +-- +-- @ +-- findAllCap sep = 'sepCap' ('Data.Attoparsec.ByteString.match' sep) +-- @ +{-# INLINABLE findAllCap #-} +findAllCap + :: Parser a -- ^ The pattern matching parser @sep@ + -> Parser [Either B.ByteString (B.ByteString, a)] +findAllCap sep = sepCap (match sep) + + +-- | +-- == Find all occurences +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Data.Attoparsec.ByteString.match' combinator and +-- return the text which matched the pattern parser @sep@ in +-- the 'Right' sections. +-- +-- Definition: +-- +-- @ +-- findAll sep = (fmap.fmap) ('Data.Bifunctor.second' fst) $ 'sepCap' ('Data.Attoparsec.ByteString.match' sep) +-- @ +{-# INLINABLE findAll #-} +findAll + :: Parser a -- ^ The pattern matching parser @sep@ + -> Parser [Either B.ByteString B.ByteString] +findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep) + + +-- | +-- == 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 'Data.Attoparsec.ByteString.parse' +-- or 'Data.Attoparsec.ByteString.parseOnly'. +-- +-- === 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 'Data.Attoparsec.ByteString.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 +-- always returns the first item in the tuple, then @streamEdit@ changes +-- nothing. +-- +-- So, for all @sep@: +-- +-- @ +-- streamEdit ('Data.Attoparsec.ByteString.match' sep) 'Data.Tuple.fst' ≡ 'Data.Function.id' +-- @ +{-# INLINABLE streamEdit #-} +streamEdit + -- :: forall s a. (Stream s, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) + :: Parser a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> B.ByteString) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> B.ByteString + -- ^ The input stream of text to be edited. + -> B.ByteString +streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor) + + +-- | +-- == Stream editor transformer +-- +-- Monad transformer version of 'streamEdit'. +-- +-- The @editor@ function will run in the underlying monad context. +-- +-- If you want to do 'IO' operations in the @editor@ function then +-- run this in 'IO'. +-- +-- If you want the @editor@ function to remember some state, +-- then run this in a stateful monad. +{-# INLINABLE streamEditT #-} +streamEditT + :: (Monad m) + => Parser a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> m B.ByteString) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> B.ByteString + -- ^ The input stream of text to be edited. + -> m B.ByteString +streamEditT sep editor input = do + case parseOnly (sepCap sep) input of + (Left err) -> error err + -- this function should never error, because it only errors + -- when the 'sepCap' parser fails, and the 'sepCap' parser + -- can never fail. If this function ever throws an error, please + -- report that as a bug. + -- (We don't use MonadFail because Identity is not a MonadFail.) + (Right r) -> fmap mconcat $ traverse (either return editor) r + + +-- | Get the 'Data.Attoparsec.ByteString.Parser' ’s current offset position in the stream. +-- +-- [“… you know you're in an uncomfortable state of sin :-)” — bos](https://github.com/bos/attoparsec/issues/101) +getOffset :: Parser Int +getOffset = AT.Parser $ \t pos more _ succ' -> succ' t pos more (AT.fromPos pos) + diff --git a/src/Replace/Attoparsec/Text.hs b/src/Replace/Attoparsec/Text.hs new file mode 100644 --- /dev/null +++ b/src/Replace/Attoparsec/Text.hs @@ -0,0 +1,237 @@ +-- | +-- Module : Replace.Attoparsec.Text +-- +-- __Replace.Attoparsec__ is for finding text patterns, and also editing and +-- replacing the found patterns. +-- This activity is traditionally done with regular expressions, +-- but __Replace.Attoparsec__ uses "Data.Attoparsec" parsers instead for +-- the pattern matching. +-- +-- __Replace.Attoparsec__ can be used in the same sort of “pattern capture” +-- or “find all” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- . +-- +-- __Replace.Attoparsec__ can be used in the same sort of “stream editing” +-- or “search-and-replace” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- , +-- or +-- . +-- +-- See the __[replace-attoparsec](https://hackage.haskell.org/package/replace-attoparsec)__ package README for usage examples. + +{-# LANGUAGE LambdaCase #-} + +module Replace.Attoparsec.Text + ( + -- * Parser combinator + sepCap + , findAll + , findAllCap + + -- * Running parser + , streamEdit + , streamEditT + + -- * Parser + , getOffset + ) +where + +-- import Control.Exception (SomeException, throw) +import Data.Functor.Identity +import Data.Bifunctor +-- import Data.Char +import Control.Applicative +import Control.Monad +import Data.Attoparsec.Text +import qualified Data.Text as T +import qualified Data.Attoparsec.Internal.Types as AT + +-- | +-- == Separate and capture +-- +-- Parser combinator to find all of the non-overlapping ocurrences +-- of the pattern @sep@ in a text stream. Separate the stream into sections: +-- +-- * sections which can parsed by the pattern @sep@ will be captured as +-- matching sections in 'Right' +-- * non-matching sections of the stream will be captured in 'Left'. +-- +-- This parser will always consume its entire input and can never fail. +-- If there are no pattern matches, then the entire input stream will be +-- returned as a non-matching 'Left' section. +-- +-- The pattern matching parser @sep@ will not be allowed to succeed without +-- consuming any input. If we allow the parser to match a zero-width pattern, +-- 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. So, for example, the +-- pattern @many digit@, which can match zero occurences of a digit, +-- will be treated by @sepCap@ as @many1 digit@, and required to match +-- at least one digit. +-- +-- 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. +-- +{-# INLINABLE sepCap #-} +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 + where + sequenceLeft :: [Either Char r] -> [Either [Char] 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 + +-- | +-- == Find all occurences, parse and capture pattern matches +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Data.Attoparsec.Text.match' combinator so that +-- the text which matched the pattern parser @sep@ will be returned in +-- the 'Right' sections, along with the result of the parse of @sep@. +-- +-- Definition: +-- +-- @ +-- findAllCap sep = 'sepCap' ('Data.Attoparsec.Text.match' sep) +-- @ +{-# INLINABLE findAllCap #-} +findAllCap + :: Parser a -- ^ The pattern matching parser @sep@ + -> Parser [Either T.Text (T.Text, a)] +findAllCap sep = sepCap (match sep) + + +-- | +-- == Find all occurences +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Data.Attoparsec.Text.match' combinator and +-- return the text which matched the pattern parser @sep@ in +-- the 'Right' sections. +-- +-- Definition: +-- +-- @ +-- findAll sep = (fmap.fmap) ('Data.Bifunctor.second' fst) $ 'sepCap' ('Data.Attoparsec.Text.match' sep) +-- @ +{-# INLINABLE findAll #-} +findAll + :: Parser a -- ^ The pattern matching parser @sep@ + -> Parser [Either T.Text T.Text] +findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep) + + +-- | +-- == 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 'Data.Attoparsec.Text.parse' +-- or 'Data.Attoparsec.Text.parseOnly'. +-- +-- === 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 'Data.Attoparsec.Text.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 +-- always returns the first item in the tuple, then @streamEdit@ changes +-- nothing. +-- +-- So, for all @sep@: +-- +-- @ +-- streamEdit ('Data.Attoparsec.Text.match' sep) 'Data.Tuple.fst' ≡ 'Data.Function.id' +-- @ +{-# INLINABLE streamEdit #-} +streamEdit + -- :: forall s a. (Stream s, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) + :: Parser a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> T.Text) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> T.Text + -- ^ The input stream of text to be edited. + -> T.Text +streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor) + + +-- | +-- == Stream editor transformer +-- +-- Monad transformer version of 'streamEdit'. +-- +-- The @editor@ function will run in the underlying monad context. +-- +-- If you want to do 'IO' operations in the @editor@ function then +-- run this in 'IO'. +-- +-- If you want the @editor@ function to remember some state, +-- then run this in a stateful monad. +{-# INLINABLE streamEditT #-} +streamEditT + :: (Monad m) + => Parser a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> m T.Text) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> T.Text + -- ^ The input stream of text to be edited. + -> m T.Text +streamEditT sep editor input = do + case parseOnly (sepCap sep) input of + (Left err) -> error err + -- this function should never error, because it only errors + -- when the 'sepCap' parser fails, and the 'sepCap' parser + -- can never fail. If this function ever throws an error, please + -- report that as a bug. + -- (We don't use MonadFail because Identity is not a MonadFail.) + (Right r) -> fmap mconcat $ traverse (either return editor) r + + +-- | Get the 'Data.Attoparsec.Text.Parser' ’s current offset position in the stream. +-- +-- [“… you know you're in an uncomfortable state of sin :-)” — bos](https://github.com/bos/attoparsec/issues/101) +getOffset :: Parser Int +getOffset = AT.Parser $ \t pos more _ succ' -> succ' t pos more (AT.fromPos pos) + diff --git a/tests/TestByteString.hs b/tests/TestByteString.hs new file mode 100644 --- /dev/null +++ b/tests/TestByteString.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} + +module TestByteString ( tests ) where + +import Distribution.TestSuite as TestSuite +import Data.Attoparsec.ByteString +import qualified Data.ByteString as B +import Data.ByteString.Internal (c2w) +import "parsers" Text.Parser.Token +import Replace.Attoparsec.ByteString +import Control.Applicative + + +tests :: IO [Test] +tests = return + [ Test $ runParserTest "findAll upperChar" + (findAllCap upperChar) + ("aBcD" :: B.ByteString) + [Left "a", Right ("B", c2w 'B'), Left "c", Right ("D", c2w 'D')] + -- check that sepCap can progress even when parser consumes nothing + -- and succeeds. + , Test $ runParserTest "zero-consumption parser" + (sepCap (many upperChar)) + ("aBcD" :: B.ByteString) + [Left "a", Right [c2w 'B'], Left "c", Right [c2w 'D']] + , Test $ runParserTest "scinum" + (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"]) + , Test $ runParserTest "read fail" + (sepCap (return (read "a" :: Int) :: Parser Int)) + ("a") + ([Left "a"]) + ] + where + runParserTest nam p input expected = TestInstance + { run = do + case parseOnly p input of + Left e -> return (Finished $ TestSuite.Fail $ show e) + Right output -> + if (output == expected) + then return (Finished Pass) + else return (Finished $ TestSuite.Fail + $ show output ++ " ≠ " ++ show expected) + , name = nam + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + + scinum :: Parser (Double, Integer) + scinum = do + m <- (fromIntegral :: Integer -> Double) <$> decimal + _ <- string "E" + e <- decimal + 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 new file mode 100644 --- /dev/null +++ b/tests/TestText.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module TestText ( tests ) where + +import Distribution.TestSuite as TestSuite +import Replace.Attoparsec.Text +import Data.Attoparsec.Text +-- import Data.Attoparsec.Text.Char +import qualified Data.Text as T +import Text.Parser.Char (upper) +import Control.Applicative + +tests :: IO [Test] +tests = return + [ Test $ runParserTest "findAll upperChar" + (findAllCap (upper :: Parser Char)) + ("aBcD" :: T.Text) + [Left "a", Right ("B", 'B'), Left "c", Right ("D", 'D')] + -- check that sepCap can progress even when parser consumes nothing + -- and succeeds. + , Test $ runParserTest "zero-consumption parser" + (sepCap (many (upper :: Parser Char))) + ("aBcD" :: T.Text) + [Left "a", Right "B", Left "c", Right "D"] + , Test $ runParserTest "scinum" + (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"]) + , Test $ runParserTest "read fail" + (sepCap (return (read "a" :: Int) :: Parser Int)) + ("a") + ([Left "a"]) + ] + where + runParserTest nam p input expected = TestInstance + { run = do + case parseOnly p input of + Left e -> return (Finished $ TestSuite.Fail $ show e) + Right output -> + if (output == expected) + then return (Finished Pass) + else return (Finished $ TestSuite.Fail + $ show output ++ " ≠ " ++ show expected) + , name = nam + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + + scinum :: Parser (Double, Integer) + scinum = do + m <- (fromIntegral :: Integer -> Double) <$> decimal + _ <- string "E" + e <- decimal + return (m, e) + + + offsetA :: Parser Int + offsetA = getOffset <* string "A" +