pcre2 1.1.1 → 1.1.2
raw patch · 4 files changed
+123/−97 lines, 4 filesdep +streamingdep −transformersPVP ok
version bump matches the API change (PVP)
Dependencies added: streaming
Dependencies removed: transformers
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- pcre2.cabal +5/−5
- src/hs/Text/Regex/Pcre2/Internal.hs +87/−77
- src/hs/Text/Regex/Pcre2/TH.hs +26/−15
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog and Acknowledgements +## 1.1.2+* Refactored using the `streaming` library. Fixed+ [#11](https://github.com/sjshuck/pcre2/11), where large global matches were+ very slow.+ ## 1.1.1 * Fixed [#12](https://github.com/sjshuck/pcre2/4), where some functions returned too many match results.
pcre2.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d8aba62e213c9b15ec9218a159e7922eb4ebb298385cd3ff0e1acd1f15fd6506+-- hash: 59ef57516a0657d661f19dafd5afd97472da24119ee5d5d31c7681834b8c303a name: pcre2-version: 1.1.1+version: 1.1.2 synopsis: Regular expressions via the PCRE2 C library (included) description: Please see the README on GitHub at <https://github.com/sjshuck/hs-pcre2> category: Text@@ -147,9 +147,9 @@ base >=4.9 && <5 , containers , mtl+ , streaming , template-haskell , text- , transformers default-language: Haskell2010 test-suite pcre2-test@@ -167,9 +167,9 @@ , microlens-platform , mtl , pcre2+ , streaming , template-haskell , text- , transformers default-language: Haskell2010 benchmark pcre2-benchmarks@@ -189,7 +189,7 @@ , pcre-light , pcre2 , regex-pcre-builtin+ , streaming , template-haskell , text- , transformers default-language: Haskell2010
src/hs/Text/Regex/Pcre2/Internal.hs view
@@ -18,8 +18,6 @@ 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 ((<&>))@@ -31,7 +29,6 @@ import Data.List (foldl', intercalate) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE-import Data.Maybe (fromJust, fromMaybe) import Data.Monoid import Data.Proxy (Proxy(..)) import Data.Text (Text)@@ -45,6 +42,9 @@ import qualified Foreign.Concurrent as Conc import GHC.TypeLits hiding (Text) import qualified GHC.TypeLits as TypeLits+import Streaming (Of(..), Stream)+import qualified Streaming+import qualified Streaming.Prelude as Streaming import System.IO.Unsafe import Text.Regex.Pcre2.Foreign @@ -74,6 +74,10 @@ bitOr :: (Foldable t, Num a, Bits a) => t a -> a bitOr = foldl' (.|.) 0 +-- | Placeholder for half-building a `Traversal'` to be passed to `has`.+noTouchy :: a+noTouchy = error "BUG! Tried to use match results"+ -- | Equivalent to @flip fix@. -- -- Used to express a recursive function of one argument that is called only once@@ -150,11 +154,14 @@ -- * 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 a whitelist of capture indexes--- to extract, and produces lists of capture offsets representing a global--- match. The whitelist is @[]@ rather than @NonEmpty@ to facilitate writing--- literals.-type Matcher = Text -> [Int] -> IO [NonEmpty SliceRange]+-- been \"compiled\". It takes a subject a produces a finite stream of match+-- results corresponding to a global match.+--+-- The actual values of type @Ptr Pcre2_match_data@ will be equal within each+-- global match; they represent the states of the C data at moments in time, and+-- are intended to be composed with another streaming transformation before+-- being subjected to teardown and `unsafePerformIO`.+type Matcher = Text -> Stream (Of (Ptr Pcre2_match_data)) IO () -- | A substitution function. It takes a subject and produces the number of -- substitutions performed (0 or 1, or more in the presence of `SubGlobal`)@@ -678,26 +685,18 @@ return $ mkSubjFun matchEnv --- | Produce a `Matcher`.-assembleMatcher- :: Option- -> Text -- ^ pattern- -> IO Matcher+-- | Produce a `Matcher` from user-supplied `Option` and pattern.+assembleMatcher :: Option -> Text -> IO Matcher assembleMatcher = assembleSubjFun $ \matchEnv@(MatchEnv {..}) -> let matchTempEnvWithSubj = mkMatchTempEnv matchEnv- in \subject whitelist ->+ in \subject -> Streaming.effect $ withForeignPtr matchEnvCode $ \codePtr ->+ withMatchDataFromCode codePtr $ \matchDataPtr -> Text.useAsPtr subject $ \subjPtr subjCUs -> do MatchTempEnv {..} <- matchTempEnvWithSubj subject - -- These need to happen one after the other. We need the- -- ForeignPtr to touch later, to allow cleanup after lazy matching.- matchDataPtr <- pcre2_match_data_create_from_pattern codePtr nullPtr- matchData <-- Conc.newForeignPtr <*> pcre2_match_data_free $ matchDataPtr- -- Loop over the subject, emitting slice lists until stopping.- lists <- execWriterT $ runMaybeT $ fix1 0 $ \continue curOff -> do+ return $ fix1 0 $ \continue curOff -> do result <- liftIO $ withForeignOrNullPtr matchTempEnvCtx $ \ctxPtr -> pcre2_match@@ -710,17 +709,13 @@ ctxPtr -- Handle no match and errors- when (result == pcre2_ERROR_NOMATCH) stop- when (result == pcre2_ERROR_CALLOUT) $- liftIO $ maybeRethrow matchTempEnvRef- liftIO $ check (> 0) result-- slices <- liftIO $ unsafeInterleaveIO $- getOvecEntriesAt whitelist matchDataPtr+ unless (result == pcre2_ERROR_NOMATCH) $ do+ when (result == pcre2_ERROR_CALLOUT) $+ liftIO $ maybeRethrow matchTempEnvRef+ liftIO $ check (> 0) result - emit slices+ Streaming.yield matchDataPtr - lazy $ do -- Determine next starting offset nextOff <- liftIO $ do ovecPtr <- pcre2_get_ovector_pointer matchDataPtr@@ -729,20 +724,16 @@ return $ max curOffEnd (curOff + 1) -- Handle end of subject- when (nextOff > fromIntegral subjCUs) stop-- -- Force slices out of the current match_data state before- -- clobbering it with the next match- slices `seq` continue nextOff-- touchForeignPtr matchData-- return lists+ unless (nextOff > fromIntegral subjCUs) $+ -- Force slices out of the current match_data state+ -- before clobbering it with the next match+ continue nextOff where- stop = MaybeT $ return Nothing- emit x = tell [x]- lazy = MaybeT . WriterT . unsafeInterleaveIO . runWriterT . runMaybeT+ withMatchDataFromCode codePtr action = do+ matchData <- mkForeignPtr pcre2_match_data_free $+ pcre2_match_data_create_from_pattern codePtr nullPtr+ withForeignPtr matchData action -- | 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@@ -1031,26 +1022,29 @@ -- | The most general form of a matching function, which can also be used as a -- @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--- pass in a whitelist of the numbers of captures we want, thereby avoiding--- unnecessary allocations.--- -- Internal only! Users should not (have to) know about `Matcher`.-_capturesInternal :: Matcher -> [Int] -> Traversal' Text (NonEmpty Text)-_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+_capturesInternal+ :: Matcher+ -> FromMatch -- ^ get some or all captures offsets+ -> (Text -> SliceRange -> Text) -- ^ slicer+ -> Traversal' Text (NonEmpty Text)+_capturesInternal matcher getSliceRanges slicer f subject =+ traverse f captureLists <&> \captureLists' ->+ -- Swag foldl-as-foldr to create only as many segments as we need to+ -- stitch back together and no more.+ let triples = concat $ zipWith3 zip3+ (map NE.toList sliceRangeLists)+ (map NE.toList captureLists)+ (map NE.toList captureLists')+ in Text.concat $ foldr mkSegments termSegments triples 0 where-- flatten = concatMap NE.toList- ovecEntries = unsafePerformIO $ matcher subject whitelist- css = do- ovecEntry <- ovecEntries- return $ unsafePerformIO $ mapM (evaluate . slice subject) ovecEntry+ sliceRangeLists = Streaming.destroy+ (Streaming.mapM getSliceRanges $ matcher subject)+ (\(srs :> srss) -> srs : srss)+ unsafePerformIO+ (const [])+ captureLists = map (NE.map $ slicer subject) sliceRangeLists mkSegments (SliceRange off offEnd, c, c') r prevOffEnd | off == fromIntegral pcre2_UNSET || c == c' =@@ -1068,24 +1062,35 @@ -- cases where no substring is changed. in [thinSlice subject (SliceRange off offEnd) | off /= offEnd] --- | Strictly read specifically indexed captures' offsets from match results.--- Truncate indexes when they go out of bounds, to support infinite lists.-getOvecEntriesAt :: [Int] -> Ptr Pcre2_match_data -> IO (NonEmpty SliceRange)-getOvecEntriesAt whitelist matchDataPtr = do- count <- fromIntegral <$> pcre2_get_ovector_count matchDataPtr+-- | A function that takes a subject and a C match result, and extracts a+-- collection of captures. We need to pass this effectful callback to+-- `_capturesInternal` because of the latter\'s tight, imperative loop that+-- reuses the same @pcre2_match_data@ block.+type FromMatch = Ptr Pcre2_match_data -> IO (NonEmpty SliceRange) - case NE.nonEmpty $ takeWhile (< count) whitelist of- Nothing -> error "BUG! Empty whitelist"- Just ns -> do- ovecPtr <- pcre2_get_ovector_pointer matchDataPtr+-- | Read all specifically indexed captures\' offsets from match results.+getWhitelistedSliceRanges :: NonEmpty Int -> FromMatch+getWhitelistedSliceRanges whitelist matchDataPtr = do+ ovecPtr <- pcre2_get_ovector_pointer matchDataPtr+ let peekOvec :: Int -> IO Text.I16+ peekOvec = fmap fromIntegral . peekElemOff ovecPtr - let peekOvec :: Int -> IO Text.I16- peekOvec = fmap fromIntegral . peekElemOff ovecPtr+ forM whitelist $ \i -> liftM2 SliceRange+ (peekOvec $ i * 2)+ (peekOvec $ i * 2 + 1) - forM ns $ \n -> liftM2 SliceRange- (peekOvec $ n * 2)- (peekOvec $ n * 2 + 1)+-- | Read just the 0th capture\'s offsets from match results.+get0thSliceRanges :: FromMatch+get0thSliceRanges = getWhitelistedSliceRanges $ 0 :| [] +-- | Read all captures\' offsets from match results.+getAllSliceRanges :: FromMatch+getAllSliceRanges matchDataPtr = do+ count <- fromIntegral <$> pcre2_get_ovector_count matchDataPtr+ let whitelist = 0 :| [1 .. count - 1]++ getWhitelistedSliceRanges whitelist matchDataPtr+ -- | Helper to create non-Template Haskell API functions. They all take options -- and a pattern, and then do something via a 'Matcher'. withMatcher :: (Matcher -> a) -> Option -> Text -> a@@ -1137,7 +1142,10 @@ -- | @matchesOpt mempty = matches@ matchesOpt :: Option -> Text -> Text -> Bool-matchesOpt = withMatcher $ \matcher -> has $ _capturesInternal matcher []+matchesOpt = withMatcher $ \matcher -> has $ _capturesInternal+ matcher+ (const $ return $ noTouchy :| noTouchy)+ noTouchy -- | Match a pattern to a subject once and return the portion that matched in an -- `Alternative`, or `empty` if no match.@@ -1231,18 +1239,20 @@ -- | @_capturesOpt mempty = _captures@ _capturesOpt :: Option -> Text -> Traversal' Text (NonEmpty Text)-_capturesOpt = withMatcher $ \matcher -> _capturesInternal matcher [0 ..]+_capturesOpt = withMatcher $ \matcher ->+ _capturesInternal matcher getAllSliceRanges slice -- | 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 = `_captures` patt . ix 0@ _match :: Text -> Traversal' Text Text _match = _matchOpt mempty -- | @_matchOpt mempty = _match@ _matchOpt :: Option -> Text -> Traversal' Text Text-_matchOpt = withMatcher $ \matcher -> _capturesInternal matcher [0] . _headNE+_matchOpt = withMatcher $ \matcher ->+ _capturesInternal matcher get0thSliceRanges slice . _headNE -- * Support for Template Haskell compile-time regex analysis
src/hs/Text/Regex/Pcre2/TH.hs view
@@ -7,7 +7,7 @@ import Control.Applicative (Alternative(..)) import Data.IORef import Data.Functor ((<&>))-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map@@ -103,31 +103,39 @@ regex = QuasiQuoter { quoteExp = \s -> capturesInfoQ s >>= \case Nothing -> [e|- let _cs = _capturesInternal $(matcherQ s) [0]+ let _cs = _capturesInternal $(matcherQ s) get0thSliceRanges slice in toAlternativeOf $ _cs . _headNE |] Just info -> [e|- let wrap cs = Captures cs :: Captures $(return info)- _cs = _capturesInternal $(matcherQ s) [0 ..]+ let _cs = _capturesInternal $(matcherQ s) getAllSliceRanges slice+ wrap cs = Captures cs :: Captures $(return info) in toAlternativeOf $ _cs . to wrap |], quotePat = \s -> do captureNames <- predictCaptureNamesQ s - case toKVs captureNames of+ case NE.nonEmpty $ toKVs captureNames of -- No named captures. Test whether the string matches without -- creating any new Text values.- [] -> viewP- [e| has $ _capturesInternal $(matcherQ s) [] |]+ Nothing -> viewP+ [e|+ has $ _capturesInternal+ $(matcherQ s)+ (const $ return $ noTouchy :| noTouchy)+ noTouchy |] [p| True |] -- One or more named captures. Attempt to bind only those to local -- variables of the same names.- numberedNames -> viewP e p where- (nums, names) = unzip numberedNames+ Just numberedNames -> viewP e p where+ (numbers, names) = NE.unzip numberedNames e = [e|- let _cs = _capturesInternal $(matcherQ s) $(liftData nums)- in maybe [] NE.toList . preview _cs |]- p = listP $ map (varP . mkName . Text.unpack) names,+ let _cs = _capturesInternal+ $(matcherQ s)+ (getWhitelistedSliceRanges $(liftData numbers))+ slice+ in view $ _cs . to NE.toList |]+ p = foldr f wildP names where+ f name r = conP '(:) [varP $ mkName $ Text.unpack name, r], quoteType = const $ fail "regex: cannot produce a type", @@ -152,11 +160,14 @@ _regex :: QuasiQuoter _regex = QuasiQuoter { quoteExp = \s -> capturesInfoQ s >>= \case- Nothing -> [e| _capturesInternal $(matcherQ s) [0] . _headNE |]+ Nothing -> [e|+ let _cs = _capturesInternal $(matcherQ s) get0thSliceRanges slice+ in _cs . _headNE |] Just info -> [e|- let wrapped :: Lens' (NonEmpty Text) (Captures $(return info))+ let _cs = _capturesInternal $(matcherQ s) getAllSliceRanges slice+ wrapped :: Lens' (NonEmpty Text) (Captures $(return info)) wrapped f cs = f (Captures cs) <&> \(Captures cs') -> cs'- in _capturesInternal $(matcherQ s) [0 ..] . wrapped |],+ in _cs . wrapped |], quotePat = const $ fail "_regex: cannot produce a pattern",