diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog and Acknowledgements +## 1.1.0 +* Added global matching. + * New functions `matchAll`, `matchAllOpt`, `capturesAll`, `capturesAllOpt`. + * Changed all traversals from affine to non-affine. +* Changed `capturesOptA` to `capturesAOpt` for naming consistency. + ## 1.0.2 * Fixed [#4](https://github.com/sjshuck/pcre2/4), where multiple named captures were not type-indexed correctly. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -53,7 +53,6 @@ 10.35), with a complete, exposed Haskell binding. ## TODO -* Global matching. (We already have global substitution.) * Many performance optimizations. Currently we are 2–3× slower than other libraries doing most things (order of a few μs). * Make use of DFA and JIT compilation. diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -68,12 +68,21 @@ in capture @"bar" cs], bgroup "substitutions" [ - bench "PCRE2-native" $ flip nf textSubject $ - sub (Text.pack "(?<=foo )bar(?= baz)") (Text.pack "quux"), + bgroup "single" [ + bench "PCRE2-native" $ flip nf textSubject $ + sub (Text.pack "(?<=foo )bar(?= baz)") (Text.pack "quux"), - let quux = Text.pack "quux" - in bench "lens-powered" $ flip nf textSubject $ - set ([_regex|foo (bar) baz|] . _capture @1) quux]] + let quux = Text.pack "quux" + in bench "lens-powered" $ flip nf textSubject $ + set ([_regex|foo (bar) baz|] . _capture @1) quux], + + let fruit = Text.pack "apples and bananas" + in bgroup "multiple" [ + let a2o = gsub (Text.pack "a") (Text.pack "o") + in bench "PCRE2-native" $ nf a2o fruit, + + let a2o = set [_regex|a|] (Text.pack "o") + in bench "lens-powered" $ nf a2o fruit]]] stringPattern = "foo (bar) baz" stringSubject = "foo bar baz" diff --git a/pcre2.cabal b/pcre2.cabal --- a/pcre2.cabal +++ b/pcre2.cabal @@ -4,16 +4,16 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 9e2fa347c266eb48c8d78b48cae7cbadf7ea4bf1414ecafc9fbaeb5e2a7c492c +-- hash: 0a7a573e61659cfbca9092c36ae2549d63b0c6745b4bc3953f29dfc97aebd1b6 name: pcre2 -version: 1.0.2 +version: 1.1.0 synopsis: Regular expressions via the PCRE2 C library (included) description: Please see the README on GitHub at category: Text homepage: https://github.com/sjshuck/hs-pcre2#readme bug-reports: https://github.com/sjshuck/hs-pcre2/issues -author: Shlomo Shuck +author: Shlomo Shuck and contributors maintainer: stevenjshuck@gmail.com copyright: 2020 Shlomo Shuck license: Apache-2.0 @@ -149,6 +149,7 @@ , mtl , template-haskell , text + , transformers default-language: Haskell2010 test-suite pcre2-test @@ -168,6 +169,7 @@ , pcre2 , template-haskell , text + , transformers default-language: Haskell2010 benchmark pcre2-benchmarks @@ -189,4 +191,5 @@ , regex-pcre-builtin , template-haskell , text + , transformers default-language: Haskell2010 diff --git a/src/hs/Text/Regex/Pcre2.hs b/src/hs/Text/Regex/Pcre2.hs --- a/src/hs/Text/Regex/Pcre2.hs +++ b/src/hs/Text/Regex/Pcre2.hs @@ -138,12 +138,16 @@ -- ** Basic matching functions match, matchOpt, + matchAll, + matchAllOpt, matches, matchesOpt, captures, capturesOpt, capturesA, - capturesOptA, + capturesAOpt, + capturesAll, + capturesAllOpt, -- ** PCRE2-native substitution sub, @@ -176,7 +180,7 @@ -- > _nee :: Traversal' Text Text -- > _nee = _match "(?i)\\bnee\\b" -- - -- In addition to getting results, they support substitution through + -- In addition to getting results, they support global substitution through -- setting; more generally, they can accrete effects while performing -- replacements. -- @@ -185,12 +189,6 @@ -- "NEE" -- NOO -- "We are the knights who say...NOO!" - -- >>> - -- - -- The optic interface signals match failure by not targeting anything. - -- - -- >>> promptNee "Shhhhh" - -- "Shhhhh" -- >>> -- -- In general these traversals are not law-abiding. diff --git a/src/hs/Text/Regex/Pcre2/Internal.hs b/src/hs/Text/Regex/Pcre2/Internal.hs --- a/src/hs/Text/Regex/Pcre2/Internal.hs +++ b/src/hs/Text/Regex/Pcre2/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PolyKinds #-} @@ -17,6 +18,8 @@ import Control.Applicative (Alternative(..)) import Control.Exception hiding (TypeError) import Control.Monad.State.Strict +import Control.Monad.Trans.Maybe (MaybeT(..)) +import Control.Monad.Writer.Lazy (WriterT(..), execWriterT, tell) import Data.Either (partitionEithers) import Data.Function ((&)) import Data.Functor ((<&>)) @@ -29,12 +32,12 @@ import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (fromJust, fromMaybe) -import Data.Monoid (Alt(..), Any(..), First(..)) +import Data.Monoid import Data.Proxy (Proxy(..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Foreign as Text -import Data.Type.Bool (type (||), If) +import Data.Type.Bool (If, type (||)) import Data.Type.Equality (type (==)) import Data.Typeable (cast) import Foreign @@ -42,7 +45,7 @@ import qualified Foreign.Concurrent as Conc import GHC.TypeLits hiding (Text) import qualified GHC.TypeLits as TypeLits -import System.IO.Unsafe (unsafePerformIO) +import System.IO.Unsafe import Text.Regex.Pcre2.Foreign -- * General utilities @@ -136,6 +139,7 @@ view l = getConst . l Const to k f = Const . getConst . f . k has l = getAny . getConst . l (\_ -> Const $ Any True) +toListOf l = flip appEndo [] . view (l . to (Endo . (:))) -- toAlternativeOf :: (Alternative f) => Getting (Alt f a) s a -> s -> f a toAlternativeOf l = getAlt . view (l . to (Alt . pure)) @@ -146,9 +150,10 @@ -- * Assembling inputs into @Matcher@s and @Subber@s -- | A matching function where all inputs and auxilliary data structures have --- been \"compiled\". It takes a subject and produces a raw result code and --- match data, to be passed to further validation and inspection. -type Matcher = Text -> IO (CInt, MatchData) +-- been \"compiled\". It takes a subject and produces a list of match data +-- objects, representing a global match, to be passed to further validation and +-- inspection. +type Matcher = Text -> IO [MatchData] -- | A substitution function. It takes a subject and produces the number of -- substitutions performed (0 or 1, or more in the presence of `SubGlobal`) @@ -679,26 +684,55 @@ -> IO Matcher assembleMatcher = assembleSubjFun $ \matchEnv@(MatchEnv {..}) -> let matchTempEnvWithSubj = mkMatchTempEnv matchEnv - in \subject -> withForeignPtr matchEnvCode $ \codePtr -> do - matchData <- mkForeignPtr pcre2_match_data_free $ - pcre2_match_data_create_from_pattern codePtr nullPtr + in \subject -> + withForeignPtr matchEnvCode $ \codePtr -> + Text.useAsPtr subject $ \subjPtr subjCUs -> do + MatchTempEnv {..} <- matchTempEnvWithSubj subject - MatchTempEnv {..} <- matchTempEnvWithSubj subject - result <- - Text.useAsPtr subject $ \subjPtr subjCUs -> - withForeignOrNullPtr matchTempEnvCtx $ \ctxPtr -> - withForeignPtr matchData $ \matchDataPtr -> pcre2_match - codePtr - (castCUs subjPtr) - (fromIntegral subjCUs) - 0 - matchEnvOpts - matchDataPtr - ctxPtr - maybeRethrow matchTempEnvRef + -- Loop over the subject, emitting MatchData's until stopping. + execWriterT $ runMaybeT $ fix1 0 $ \continue curOff -> do + -- TODO Can one of these be reused for a whole global match? + matchData <- liftIO $ mkForeignPtr pcre2_match_data_free $ + pcre2_match_data_create_from_pattern codePtr nullPtr - return (result, matchData) + result <- liftIO $ + withForeignOrNullPtr matchTempEnvCtx $ \ctxPtr -> + withForeignPtr matchData $ \matchDataPtr -> pcre2_match + codePtr + (castCUs subjPtr) + (fromIntegral subjCUs) + curOff + matchEnvOpts + matchDataPtr + ctxPtr + -- Handle no match and errors + when (result == pcre2_ERROR_NOMATCH) stop + when (result == pcre2_ERROR_CALLOUT) $ + liftIO $ maybeRethrow matchTempEnvRef + liftIO $ check (> 0) result + + emit matchData + + lazy $ do + -- Determine next starting offset + nextOff <- liftIO $ + withForeignPtr matchData $ \matchDataPtr -> do + ovecPtr <- pcre2_get_ovector_pointer matchDataPtr + curOffEnd <- peekElemOff ovecPtr 1 + -- Prevent infinite loop upon empty match + return $ max curOffEnd (curOff + 1) + + -- Handle end of subject + when (nextOff > fromIntegral subjCUs) stop + + continue nextOff + + where + stop = MaybeT $ return Nothing + emit x = tell [x] + lazy = MaybeT . WriterT . unsafeInterleaveIO . runWriterT . runMaybeT + -- | A `Subber` works by first writing results to a reasonably-sized buffer. If -- we run out of room, PCRE2 allows us to simulate the rest of the substitution -- without writing anything, in order to calculate how big the buffer actually @@ -984,7 +1018,7 @@ -- * Packaging @Matcher@s and @Subber@s as public API functions -- | The most general form of a matching function, which can also be used as a --- @Setter'@ to perform substitutions at the Haskell level. +-- @Setter'@ to perform substitutions at the Haskell level. Operates globally. -- -- When any capture is forced, all captures are forced in order to GC C data -- more promptly. When we need /some/ captures but not /all/ captures, we can @@ -993,22 +1027,23 @@ -- -- Internal only! Users should not (have to) know about `Matcher`. _capturesInternal :: Matcher -> [Int] -> Traversal' Text (NonEmpty Text) -_capturesInternal matcher whitelist f subject - | result == pcre2_ERROR_NOMATCH = pure subject - | result <= 0 = throw $ Pcre2Exception result - | otherwise = f cs <&> \cs' -> - -- Swag foldl-as-foldr to create only as many segments as we need to - -- stitch back together and no more. - let triples = ovecEntries `NE.zip` cs `NE.zip` cs' - in Text.concat $ foldr mkSegments termSegments triples 0 +_capturesInternal matcher whitelist f subject = traverse f css <&> \css' -> + -- Swag foldl-as-foldr to create only as many segments as we need to + -- stitch back together and no more. + let triples = zip3 (flatten ovecEntries) (flatten css) (flatten css') + in Text.concat $ foldr mkSegments termSegments triples 0 where - (result, matchData) = unsafePerformIO $ matcher subject - cs = unsafePerformIO $ forM ovecEntries $ evaluate . slice subject - ovecEntries = unsafePerformIO $ getOvecEntriesAt whitelist matchData + flatten = concatMap NE.toList + ovecEntries = do + matchData <- unsafePerformIO $ matcher subject + return $ unsafePerformIO $ getOvecEntriesAt whitelist matchData + css = do + ovecEntry <- ovecEntries + return $ unsafePerformIO $ mapM (evaluate . slice subject) ovecEntry - mkSegments ((SliceRange off offEnd, c), c') r prevOffEnd + mkSegments (SliceRange off offEnd, c, c') r prevOffEnd | off == fromIntegral pcre2_UNSET || c == c' = -- This substring is unset or unchanged. Keep going without making -- cuts. @@ -1047,8 +1082,8 @@ withMatcher :: (Matcher -> a) -> Option -> Text -> a withMatcher f option patt = f $ unsafePerformIO $ assembleMatcher option patt --- | Match a pattern to a subject and return a list of captures, or @[]@ if no --- match. +-- | Match a pattern to a subject once and return a list of captures, or @[]@ if +-- no match. captures :: Text -> Text -> [Text] captures = capturesOpt mempty @@ -1056,22 +1091,38 @@ capturesOpt :: Option -> Text -> Text -> [Text] capturesOpt option patt = view $ _capturesOpt option patt . to NE.toList --- | Match a pattern to a subject and return a non-empty list of captures in an --- `Alternative`, or `empty` if no match. The non-empty list constructor `:|` --- serves as a cue to differentiate the 0th capture from the others: +-- | Match a pattern to a subject once and return a non-empty list of captures +-- in an `Alternative`, or `empty` if no match. The non-empty list constructor +-- `:|` serves as a cue to differentiate the 0th capture from the others: -- -- > let parseDate = capturesA "(\\d{4})-(\\d{2})-(\\d{2})" -- > in case parseDate "submitted 2020-10-20" of -- > Just (date :| [y, m, d]) -> ... -- > Nothing -> putStrLn "didn't match" capturesA :: (Alternative f) => Text -> Text -> f (NonEmpty Text) -capturesA = capturesOptA mempty +capturesA = capturesAOpt mempty --- | @capturesOptA mempty = capturesA@ -capturesOptA :: (Alternative f) => Option -> Text -> Text -> f (NonEmpty Text) -capturesOptA option patt = toAlternativeOf $ _capturesOpt option patt +-- | @capturesAOpt mempty = capturesA@ +-- +-- @since 1.1.0 +capturesAOpt :: (Alternative f) => Option -> Text -> Text -> f (NonEmpty Text) +capturesAOpt option patt = toAlternativeOf $ _capturesOpt option patt --- | Does the pattern match the subject? +-- | Match a pattern to a subject and lazily return zero or more non-empty lists +-- of captures corresponding to every non-overlapping place in the subject the +-- pattern matched. +-- +-- @since 1.1.0 +capturesAll :: Text -> Text -> [NonEmpty Text] +capturesAll = capturesAllOpt mempty + +-- | @capturesAllOpt mempty = capturesAll@ +-- +-- @since 1.1.0 +capturesAllOpt :: Option -> Text -> Text -> [NonEmpty Text] +capturesAllOpt option patt = toListOf $ _capturesOpt option patt + +-- | Does the pattern match the subject at least once? matches :: Text -> Text -> Bool matches = matchesOpt mempty @@ -1079,8 +1130,8 @@ matchesOpt :: Option -> Text -> Text -> Bool matchesOpt = withMatcher $ \matcher -> has $ _capturesInternal matcher [] --- | Match a pattern to a subject and return the portion that matched in an --- @Alternative@, or `empty` if no match. +-- | Match a pattern to a subject once and return the portion that matched in an +-- `Alternative`, or `empty` if no match. match :: (Alternative f) => Text -> Text -> f Text match = matchOpt mempty @@ -1088,6 +1139,19 @@ matchOpt :: (Alternative f) => Option -> Text -> Text -> f Text matchOpt option patt = toAlternativeOf $ _matchOpt option patt +-- | Match a pattern to a subject and lazily return a list of all +-- non-overlapping portions that matched. +-- +-- @since 1.1.0 +matchAll :: Text -> Text -> [Text] +matchAll = matchAllOpt mempty + +-- | @matchAllOpt mempty = matchAll@ +-- +-- @since 1.1.0 +matchAllOpt :: Option -> Text -> Text -> [Text] +matchAllOpt option patt = toListOf $ _matchOpt option patt + -- | Perform at most one substitution. See -- [the docs](https://pcre.org/current/doc/html/pcre2api.html#SEC36) for the -- special syntax of /replacement/. @@ -1116,8 +1180,8 @@ subOpt option patt replacement = snd . unsafePerformIO . subber where subber = unsafePerformIO $ assembleSubber replacement option patt --- | Given a pattern, produce an affine traversal (0 or 1 targets) that focuses --- from a subject to a potential non-empty list of captures. +-- | Given a pattern, produce a traversal (0 or more targets) that focuses from +-- a subject to each non-empty list of captures that pattern matches globally. -- -- Substitution works in the following way: If a capture is set such that the -- new `Text` is not equal to the old one, a substitution occurs, otherwise it @@ -1160,8 +1224,8 @@ _capturesOpt :: Option -> Text -> Traversal' Text (NonEmpty Text) _capturesOpt = withMatcher $ \matcher -> _capturesInternal matcher [0 ..] --- | Given a pattern, produce an affine traversal (0 or 1 targets) that focuses --- from a subject to the portion of it that matches. +-- | Given a pattern, produce a traversal (0 or more targets) that focuses from +-- a subject to the portions of it that match. -- -- Equivalent to @\\patt -> `_captures` patt . ix 0@, but more efficient. _match :: Text -> Traversal' Text Text diff --git a/src/hs/Text/Regex/Pcre2/TH.hs b/src/hs/Text/Regex/Pcre2/TH.hs --- a/src/hs/Text/Regex/Pcre2/TH.hs +++ b/src/hs/Text/Regex/Pcre2/TH.hs @@ -133,7 +133,7 @@ quoteDec = const $ fail "regex: cannot produce declarations"} --- | A lens variant of `regex`. Can only be used as an expression. +-- | A global, optical variant of `regex`. Can only be used as an expression. -- -- > _regex :: String -> Traversal' Text (Captures info) -- > _regex :: String -> Traversal' Text Text diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -189,6 +189,23 @@ it "permits other captures to be changed via Traversal'" $ do ("" & [_regex|(a)?|] . _capture @0 .~ "foo") `shouldBe` "foo" + describe "Traversal'" $ do + it "supports global substitutions" $ do + ("apples and bananas" & _match "a" .~ "o") + `shouldBe` "opples ond bononos" + + it "is lazy" $ do + counter <- newIORef (0 :: Int) + let callout = UnsafeCallout $ \_ -> do + modifyIORef counter (+ 1) + return CalloutProceed + take 3 ("apples and bananas" ^.. _matchOpt callout "(?C1)a") + `shouldBe` ["a", "a", "a"] + readIORef counter `shouldReturn` 3 + + it "converges in the presence of empty matches" $ do + length (toListOf [_regex||] "12345") `shouldBe` 6 + describe "bug fixes" bugFixes bugFixes :: Spec