pcre2 1.1.4 → 1.1.5
raw patch · 9 files changed
+199/−206 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +6/−0
- README.md +10/−3
- bench/Bench.hs +0/−1
- pcre2.cabal +3/−3
- src/c/getters.h +31/−31
- src/hs/Text/Regex/Pcre2.hs +0/−3
- src/hs/Text/Regex/Pcre2/Internal.hs +108/−127
- src/hs/Text/Regex/Pcre2/TH.hs +37/−36
- test/Spec.hs +4/−2
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog and Acknowledgements +## 1.1.5+* Fixed [#17](https://github.com/sjshuck/pcre2/17), where functions returning+ `Alternative` containers were not restricted to single results despite their+ documentation.+* Minor improvements to docs and examples.+ ## 1.1.4 * Fixed some incorrect foreign imports' safety.
README.md view
@@ -12,11 +12,19 @@ ``` ```haskell case "The quick brown fox" of- [regex|brown\s+(?<animal>\S+)|] -> Text.putStrLn animal+ [regex|brown\s+(?<animal>\w+)|] -> Text.putStrLn animal _ -> error "nothing brown" ``` ```haskell-let kv'd = lined . packed . [_regex|^\s*(.*?)\s*[=:]\s*(.*)|]+let kv'd = lined . packed . [_regex|(?x) # Extended PCRE2 syntax+ ^\s* # Ignore leading whitespace+ ([^=:\s].*?) # Capture the non-empty key+ \s* # Ignore trailing whitespace+ [=:] # Separator+ \s* # Ignore leading whitespace+ (.*?) # Capture the possibly-empty value+ \s*$ # Ignore trailing whitespace+ |] forMOf kv'd file $ execStateT $ do k <- gets $ capture @1@@ -31,7 +39,6 @@ ``` ## Features-* Low-surface API covering most use cases. * Quiet functions with simple types—for the most part it's `Text` _(pattern)_ `-> Text` _(subject)_ `-> result`. * Use partial application to create performant, compile-once-match-many code.
bench/Bench.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}
pcre2.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 31554f80cf0112dda9453046d82fbd24ca1c7090ffa1e4ff1f3709967ca2326f+-- hash: cb8596609200fe862c181845b59caabfdf1c2a19dc0f410828ecba4f7c2c4fe5 name: pcre2-version: 1.1.4+version: 1.1.5 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
src/c/getters.h view
@@ -8,7 +8,7 @@ #ifdef GETTER #error GETTER already defined #endif-#define GETTER(src, field, ret) \+#define GETTER(src, ret, field) \ ret pcre2_##src##_##field(pcre2_##src *block) \ { \ return block->field; \@@ -22,38 +22,38 @@ return block->version; } */-GETTER(callout_block, version, uint32_t)-GETTER(callout_block, callout_number, uint32_t)-GETTER(callout_block, capture_top, uint32_t)-GETTER(callout_block, capture_last, uint32_t)-GETTER(callout_block, callout_flags, uint32_t)-GETTER(callout_block, offset_vector, PCRE2_SIZE *)-GETTER(callout_block, mark, PCRE2_SPTR)-GETTER(callout_block, subject, PCRE2_SPTR)-GETTER(callout_block, subject_length, PCRE2_SIZE)-GETTER(callout_block, start_match, PCRE2_SIZE)-GETTER(callout_block, current_position, PCRE2_SIZE)-GETTER(callout_block, pattern_position, PCRE2_SIZE)-GETTER(callout_block, next_item_length, PCRE2_SIZE)-GETTER(callout_block, callout_string_offset, PCRE2_SIZE)-GETTER(callout_block, callout_string_length, PCRE2_SIZE)-GETTER(callout_block, callout_string, PCRE2_SPTR)+GETTER(callout_block, uint32_t, version)+GETTER(callout_block, uint32_t, callout_number)+GETTER(callout_block, uint32_t, capture_top)+GETTER(callout_block, uint32_t, capture_last)+GETTER(callout_block, uint32_t, callout_flags)+GETTER(callout_block, PCRE2_SIZE *, offset_vector)+GETTER(callout_block, PCRE2_SPTR, mark)+GETTER(callout_block, PCRE2_SPTR, subject)+GETTER(callout_block, PCRE2_SIZE, subject_length)+GETTER(callout_block, PCRE2_SIZE, start_match)+GETTER(callout_block, PCRE2_SIZE, current_position)+GETTER(callout_block, PCRE2_SIZE, pattern_position)+GETTER(callout_block, PCRE2_SIZE, next_item_length)+GETTER(callout_block, PCRE2_SIZE, callout_string_offset)+GETTER(callout_block, PCRE2_SIZE, callout_string_length)+GETTER(callout_block, PCRE2_SPTR, callout_string) -GETTER(callout_enumerate_block, version, uint32_t)-GETTER(callout_enumerate_block, pattern_position, PCRE2_SIZE)-GETTER(callout_enumerate_block, next_item_length, PCRE2_SIZE)-GETTER(callout_enumerate_block, callout_number, uint32_t)-GETTER(callout_enumerate_block, callout_string_offset, PCRE2_SIZE)-GETTER(callout_enumerate_block, callout_string_length, PCRE2_SIZE)-GETTER(callout_enumerate_block, callout_string, PCRE2_SPTR)+GETTER(callout_enumerate_block, uint32_t, version)+GETTER(callout_enumerate_block, PCRE2_SIZE, pattern_position)+GETTER(callout_enumerate_block, PCRE2_SIZE, next_item_length)+GETTER(callout_enumerate_block, uint32_t, callout_number)+GETTER(callout_enumerate_block, PCRE2_SIZE, callout_string_offset)+GETTER(callout_enumerate_block, PCRE2_SIZE, callout_string_length)+GETTER(callout_enumerate_block, PCRE2_SPTR, callout_string) -GETTER(substitute_callout_block, version, uint32_t)-GETTER(substitute_callout_block, subscount, uint32_t)-GETTER(substitute_callout_block, input, PCRE2_SPTR)-GETTER(substitute_callout_block, output, PCRE2_SPTR)-GETTER(substitute_callout_block, ovector, PCRE2_SIZE *)-GETTER(substitute_callout_block, oveccount, uint32_t)-GETTER(substitute_callout_block, output_offsets, PCRE2_SIZE *) // array of 2+GETTER(substitute_callout_block, uint32_t, version)+GETTER(substitute_callout_block, uint32_t, subscount)+GETTER(substitute_callout_block, PCRE2_SPTR, input)+GETTER(substitute_callout_block, PCRE2_SPTR, output)+GETTER(substitute_callout_block, PCRE2_SIZE *, ovector)+GETTER(substitute_callout_block, uint32_t, oveccount)+GETTER(substitute_callout_block, PCRE2_SIZE *, output_offsets) // array of 2 #undef GETTER
src/hs/Text/Regex/Pcre2.hs view
@@ -231,9 +231,6 @@ -- +--------------------+---------------------------------------+------------------------------+ -- | @QuasiQuotes@ | @[@/f/@|@...@|]@ syntax | Always | -- +--------------------+---------------------------------------+------------------------------+- -- | @TemplateHaskell@ | Running PCRE2 at compile time and | Always |- -- | | generating code | |- -- +--------------------+---------------------------------------+------------------------------+ -- | @TypeApplications@ | @\@i@ syntax for supplying type index | Using `capture`\/`_capture` | -- | | arguments to applicable functions | | -- +--------------------+---------------------------------------+------------------------------+
src/hs/Text/Regex/Pcre2/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-}@@ -21,14 +22,13 @@ import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Functor.Const (Const(..))-import Data.Functor.Identity (Identity(..)) import Data.IORef import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IM import Data.List (foldl', intercalate) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE-import Data.Monoid+import Data.Monoid (Alt(..), Any(..), Endo(..)) import Data.Proxy (Proxy(..)) import Data.Text (Text) import qualified Data.Text as Text@@ -42,7 +42,7 @@ import qualified Foreign.Concurrent as Conc import GHC.TypeLits hiding (Text) import qualified GHC.TypeLits as TypeLits-import System.IO.Unsafe+import System.IO.Unsafe (unsafePerformIO) import Text.Regex.Pcre2.Foreign -- * General utilities@@ -70,10 +70,6 @@ bitOr :: (Foldable t, Bits a) => t a -> a bitOr = foldl' (.|.) zeroBits --- | 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@@ -107,8 +103,8 @@ thinSlice text (SliceRange off offEnd) | off == fromIntegral pcre2_UNSET = Text.empty | otherwise = text+ & Text.takeWord16 offEnd & Text.dropWord16 off- & Text.takeWord16 (offEnd - off) -- | Slice a 'Text', copying if it\'s less than half of the original. slice :: Text -> SliceRange -> Text@@ -127,25 +123,37 @@ instance CastCUs Word16 CUShort -- ** Lens types and utilities------ $LensTypesAndUtilities--- The combinators\' types are excessively polymorphic\/polykinded\/ugly because--- they have no accompanying signatures (not worth the trouble). type Lens' s a = forall f. (Functor f) => (a -> f a) -> s -> f s type Traversal' s a = forall f. (Applicative f) => (a -> f a) -> s -> f s -preview l = getFirst . getConst . l (Const . First . Just)+type Getting r s a = (a -> Const r a) -> s -> Const r s++preview :: Getting (Alt Maybe a) s a -> s -> Maybe a+preview = toAlternativeOf++view :: Getting a s a -> s -> a view l = getConst . l Const++to :: (s -> a) -> forall r. Getting r s a to k f = Const . getConst . f . k++has :: Getting Any s a -> s -> Bool 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))+toListOf :: Getting (Endo [a]) s a -> s -> [a]+toListOf l x = let build = Endo . (:) in view (l . to build) x `appEndo` [] +toAlternativeOf :: (Alternative f) => Getting (Alt f a) s a -> s -> f a+toAlternativeOf l = let alt = Alt . pure in getAlt . view (l . to alt)++-- | See https://github.com/sjshuck/hs-pcre2/issues/17.+-- This should go away with https://github.com/sjshuck/hs-pcre2/issues/18.+toAlternativeOf1 :: (Alternative f) => Getting (Alt Maybe a) s a -> s -> f a+toAlternativeOf1 l = maybe empty pure . preview l+ _headNE :: Lens' (NonEmpty a) a-_headNE f (x :| xs) = f x <&> \x' -> x' :| xs+_headNE f (x :| xs) = f x <&> (:| xs) -- ** Streaming support @@ -155,12 +163,7 @@ | StreamYield b (Stream b m a) -- ^ yield a value and keep going | StreamEffect (m (Stream b m a)) -- ^ have an effect and keep going | StreamStop -- ^ short-circuit--instance (Functor m) => Functor (Stream b m) where- f `fmap` StreamPure x = StreamPure $ f x- f `fmap` StreamYield y sx = StreamYield y $ f <$> sx- f `fmap` StreamEffect msx = StreamEffect $ fmap f <$> msx- _ `fmap` StreamStop = StreamStop+ deriving (Functor) instance (Functor m) => Applicative (Stream b m) where pure = StreamPure@@ -170,7 +173,6 @@ StreamStop <*> _ = StreamStop instance (Functor m) => Monad (Stream b m) where- return = pure StreamPure x >>= f = f x StreamYield y sx >>= f = StreamYield y $ sx >>= f StreamEffect msx >>= f = StreamEffect $ msx <&> (>>= f)@@ -328,10 +330,10 @@ | SubReplacementOnly -- ^ /Affects `subOpt`./ Return just the rendered -- replacement instead of it within the subject. With `SubGlobal`, all -- results are concatenated.- | SubUnknownUnset -- ^ /Affects `subOpt`./ References in the replacement- -- to non-existent captures don\'t error but are treated as unset.- | SubUnsetEmpty -- ^ /Affects `subOpt`./ References in the replacement- -- to unset captures don\'t error but are treated as empty.+ | SubUnknownUnset -- ^ /Affects `subOpt`./ References in the replacement to+ -- non-existent captures don\'t error but are treated as unset.+ | SubUnsetEmpty -- ^ /Affects `subOpt`./ References in the replacement to+ -- unset captures don\'t error but are treated as empty. | Ucp -- ^ Count Unicode characters in some character classes such as @\\d@. -- Incompatible with `NeverUcp`. | Ungreedy -- ^ Invert the effect of @?@. Without it, quantifiers are@@ -489,11 +491,11 @@ TwoOptions opt0 opt1 -> applyOption opt0 ++ applyOption opt1 -- CompileOption- Anchored -> [CompileOption pcre2_ANCHORED] AllowEmptyClass -> [CompileOption pcre2_ALLOW_EMPTY_CLASS] AltBsuxLegacy -> [CompileOption pcre2_ALT_BSUX] AltCircumflex -> [CompileOption pcre2_ALT_CIRCUMFLEX] AltVerbNames -> [CompileOption pcre2_ALT_VERBNAMES]+ Anchored -> [CompileOption pcre2_ANCHORED] AutoCallout -> [CompileOption pcre2_AUTO_CALLOUT] Caseless -> [CompileOption pcre2_CASELESS] DollarEndOnly -> [CompileOption pcre2_DOLLAR_ENDONLY]@@ -538,14 +540,14 @@ -- MatchOption NotBol -> [MatchOption pcre2_NOTBOL]- NotEol -> [MatchOption pcre2_NOTEOL] NotEmpty -> [MatchOption pcre2_NOTEMPTY] NotEmptyAtStart -> [MatchOption pcre2_NOTEMPTY_ATSTART]+ NotEol -> [MatchOption pcre2_NOTEOL] PartialHard -> [MatchOption pcre2_PARTIAL_HARD] PartialSoft -> [MatchOption pcre2_PARTIAL_SOFT]- SubReplacementOnly -> [MatchOption pcre2_SUBSTITUTE_REPLACEMENT_ONLY] SubGlobal -> [MatchOption pcre2_SUBSTITUTE_GLOBAL] SubLiteral -> [MatchOption pcre2_SUBSTITUTE_LITERAL]+ SubReplacementOnly -> [MatchOption pcre2_SUBSTITUTE_REPLACEMENT_ONLY] SubUnknownUnset -> [MatchOption pcre2_SUBSTITUTE_UNKNOWN_UNSET] SubUnsetEmpty -> [MatchOption pcre2_SUBSTITUTE_UNSET_EMPTY] @@ -556,14 +558,14 @@ UnsafeSubCallout f -> [SubCalloutOption f] -- MatchContextOption- OffsetLimit limit -> CompileOption pcre2_USE_OFFSET_LIMIT : unary- MatchContextOption pcre2_set_offset_limit (fromIntegral limit)+ DepthLimit limit -> unary+ MatchContextOption pcre2_set_depth_limit (fromIntegral limit) HeapLimit limit -> unary MatchContextOption pcre2_set_heap_limit (fromIntegral limit) MatchLimit limit -> unary MatchContextOption pcre2_set_match_limit (fromIntegral limit)- DepthLimit limit -> unary- MatchContextOption pcre2_set_depth_limit (fromIntegral limit)+ OffsetLimit limit -> CompileOption pcre2_USE_OFFSET_LIMIT : unary+ MatchContextOption pcre2_set_offset_limit (fromIntegral limit) where unary ctor f x = (: []) $ ctor $ \ctx -> withForeignPtr ctx $ \ctxPtr ->@@ -608,7 +610,7 @@ type ExtractOpts = StateT [AppliedOption] IO -- | Use a fake @Prism'@ to extract a category of options.-extractOptsOf :: Traversal' AppliedOption a -> ExtractOpts [a]+extractOptsOf :: Getting (Alt Maybe a) AppliedOption a -> ExtractOpts [a] extractOptsOf traversal = state $ partitionEithers . map discrim where discrim opt = maybe (Right opt) Left $ preview traversal opt @@ -719,11 +721,7 @@ -- | Helper for @assemble*@ functions. Basically, extract all options and help -- produce a function that takes a `Text` subject.-assembleSubjFun- :: (MatchEnv -> Text -> a)- -> Option- -> Text- -> IO (Text -> a)+assembleSubjFun :: (MatchEnv -> Text -> a) -> Option -> Text -> IO (Text -> a) assembleSubjFun mkSubjFun option patt = runStateT extractAll (applyOption option) <&> \case (subjFun, []) -> subjFun@@ -739,46 +737,44 @@ -- | Produce a `Matcher` from user-supplied `Option` and pattern. assembleMatcher :: Option -> Text -> IO Matcher-assembleMatcher = assembleSubjFun $ \matchEnv@(MatchEnv {..}) ->- let matchTempEnvWithSubj = mkMatchTempEnv matchEnv- in \subject -> StreamEffect $- withForeignPtr matchEnvCode $ \codePtr ->- withMatchDataFromCode codePtr $ \matchDataPtr ->- Text.useAsPtr subject $ \subjPtr subjCUs -> do- MatchTempEnv {..} <- matchTempEnvWithSubj subject+assembleMatcher = assembleSubjFun $ \matchEnv@(MatchEnv {..}) subject ->+ StreamEffect $+ withForeignPtr matchEnvCode $ \codePtr ->+ withMatchDataFromCode codePtr $ \matchDataPtr ->+ Text.useAsPtr subject $ \subjPtr subjCUs -> do+ MatchTempEnv {..} <- mkMatchTempEnv matchEnv subject - -- Loop over the subject, emitting slice lists until stopping.- return $ fix1 0 $ \continue curOff -> do- result <- liftIO $- withForeignOrNullPtr matchTempEnvCtx $ \ctxPtr ->- pcre2_match- codePtr- (castCUs subjPtr)- (fromIntegral subjCUs)- curOff- matchEnvOpts- matchDataPtr- ctxPtr+ -- Loop over the subject, emitting match data until stopping.+ return $ fix1 0 $ \continue curOff -> do+ result <- liftIO $ withForeignOrNullPtr matchTempEnvCtx $ \ctxPtr ->+ pcre2_match+ codePtr+ (castCUs subjPtr)+ (fromIntegral subjCUs)+ curOff+ matchEnvOpts+ matchDataPtr+ ctxPtr - -- Handle no match and errors- when (result == pcre2_ERROR_NOMATCH) StreamStop- when (result == pcre2_ERROR_CALLOUT) $- liftIO $ maybeRethrow matchTempEnvRef- liftIO $ check (> 0) result+ -- Handle no match and errors+ when (result == pcre2_ERROR_NOMATCH) StreamStop+ when (result == pcre2_ERROR_CALLOUT) $+ liftIO $ maybeRethrow matchTempEnvRef+ liftIO $ check (> 0) result - streamYield matchDataPtr+ streamYield matchDataPtr - -- Determine next starting offset- nextOff <- liftIO $ do- ovecPtr <- pcre2_get_ovector_pointer matchDataPtr- curOffEnd <- peekElemOff ovecPtr 1- -- Prevent infinite loop upon empty match- return $ max curOffEnd (curOff + 1)+ -- Determine next starting offset+ nextOff <- liftIO $ 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) StreamStop+ -- Handle end of subject+ when (nextOff > fromIntegral subjCUs) StreamStop - continue nextOff+ continue nextOff where withMatchDataFromCode codePtr action = do@@ -807,8 +803,7 @@ -> Option -> Text -- ^ pattern -> IO Subber-assembleSubber replacement =- assembleSubjFun $ \firstMatchEnv@(MatchEnv {..}) ->+assembleSubber replacement = assembleSubjFun $ \firstMatchEnv@(MatchEnv {..}) -> -- Subber \subject -> withForeignPtr matchEnvCode $ \codePtr ->@@ -882,9 +877,9 @@ :: MatchEnv -> Text -- ^ Callout info requires access to the original subject. -> IO MatchTempEnv-mkMatchTempEnv (MatchEnv {..})- | null matchEnvCallout && null matchEnvSubCallout = \_ -> return noCallouts- | otherwise = \subject -> do+mkMatchTempEnv (MatchEnv {..}) subject+ | null matchEnvCallout && null matchEnvSubCallout = return noCallouts+ | otherwise = do calloutStateRef <- newIORef $ CalloutState { calloutStateException = Nothing, calloutStateSubsLog = IM.empty}@@ -981,7 +976,7 @@ -- data to Haskell and present to the user function. Ensure no pointers are -- leaked! getCalloutInfo :: Text -> Ptr Pcre2_callout_block -> IO CalloutInfo-getCalloutInfo subject blockPtr = do+getCalloutInfo calloutSubject blockPtr = do calloutIndex <- do str <- pcre2_callout_block_callout_string blockPtr if str == nullPtr@@ -998,20 +993,16 @@ len <- pcre2_callout_block_callout_string_length blockPtr CalloutName <$> Text.fromPtr (castCUs str) (fromIntegral len) - let calloutSubject = subject- calloutCaptures <- do ovecPtr <- pcre2_callout_block_offset_vector blockPtr top <- pcre2_callout_block_capture_top blockPtr forM (0 :| [1 .. fromIntegral top - 1]) $ \n -> do- start <- peekElemOff ovecPtr $ n * 2- if start == pcre2_UNSET- then return Nothing- else Just <$> do- end <- peekElemOff ovecPtr $ n * 2 + 1- return $ slice calloutSubject $ SliceRange- (fromIntegral start)- (fromIntegral end)+ [start, end] <- forM [0, 1] $ peekElemOff ovecPtr . (n * 2 +)+ return $ if start == pcre2_UNSET+ then Nothing+ else Just $ slice calloutSubject $ SliceRange+ (fromIntegral start)+ (fromIntegral end) calloutMark <- do ptr <- pcre2_callout_block_mark blockPtr@@ -1045,14 +1036,12 @@ ovecPtr <- pcre2_substitute_callout_block_ovector blockPtr ovecCount <- pcre2_substitute_callout_block_oveccount blockPtr forM (0 :| [1 .. fromIntegral ovecCount - 1]) $ \n -> do- start <- peekElemOff ovecPtr $ n * 2- if start == pcre2_UNSET- then return Nothing- else Just <$> do- end <- peekElemOff ovecPtr $ n * 2 + 1- return $ slice subCalloutSubject $ SliceRange- (fromIntegral start)- (fromIntegral end)+ [start, end] <- forM [0, 1] $ peekElemOff ovecPtr . (n * 2 +)+ return $ if start == pcre2_UNSET+ then Nothing+ else Just $ slice subCalloutSubject $ SliceRange+ (fromIntegral start)+ (fromIntegral end) subCalloutReplacement <- do outPtr <- pcre2_substitute_callout_block_output blockPtr@@ -1074,12 +1063,8 @@ -- @Setter'@ to perform substitutions at the Haskell level. Operates globally. -- -- Internal only! Users should not (have to) know about `Matcher`.-_capturesInternal- :: Matcher- -> FromMatch -- ^ get some or all captures offsets- -> (Text -> SliceRange -> Text) -- ^ slicer- -> Traversal' Text (NonEmpty Text)-_capturesInternal matcher getSliceRanges slicer f subject =+_capturesInternal :: Matcher -> FromMatch -> Traversal' Text (NonEmpty Text)+_capturesInternal matcher fromMatch 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.@@ -1090,9 +1075,8 @@ in Text.concat $ foldr mkSegments termSegments triples 0 where- sliceRangeLists = unsafeLazyStreamToList $- mapMS getSliceRanges $ matcher subject- captureLists = map (NE.map $ slicer subject) sliceRangeLists+ sliceRangeLists = unsafeLazyStreamToList $ mapMS fromMatch $ matcher subject+ captureLists = map (NE.map $ slice subject) sliceRangeLists mkSegments (SliceRange off offEnd, c, c') r prevOffEnd | off == fromIntegral pcre2_UNSET || c == c' =@@ -1138,10 +1122,9 @@ 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-withMatcher f option patt = f $ unsafePerformIO $ assembleMatcher option patt+-- | Placeholder for half-building a `Traversal'` to be passed to `has`.+errorFromMatch :: FromMatch+errorFromMatch _ = return $ error "BUG! Tried to use match results" -- | Match a pattern to a subject once and return a list of captures, or @[]@ if -- no match.@@ -1150,8 +1133,7 @@ -- | @capturesOpt mempty = captures@ capturesOpt :: Option -> Text -> Text -> [Text]-capturesOpt option patt =- maybe [] NE.toList . preview (_capturesOpt option patt)+capturesOpt option patt = maybe [] NE.toList . capturesAOpt option patt -- | 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@@ -1168,7 +1150,7 @@ -- -- @since 1.1.0 capturesAOpt :: (Alternative f) => Option -> Text -> Text -> f (NonEmpty Text)-capturesAOpt option patt = toAlternativeOf $ _capturesOpt option patt+capturesAOpt option patt = toAlternativeOf1 $ _capturesOpt option patt -- | Match a pattern to a subject and lazily produce a list of all -- non-overlapping portions, with all capture groups, that matched.@@ -1189,10 +1171,8 @@ -- | @matchesOpt mempty = matches@ matchesOpt :: Option -> Text -> Text -> Bool-matchesOpt = withMatcher $ \matcher -> has $ _capturesInternal- matcher- (const $ return noTouchy)- noTouchy+matchesOpt option patt = has $ _capturesInternal matcher errorFromMatch where+ matcher = unsafePerformIO $ assembleMatcher option patt -- | Match a pattern to a subject once and return the portion that matched in an -- `Alternative`, or `empty` if no match.@@ -1201,7 +1181,7 @@ -- | @matchOpt mempty = match@ matchOpt :: (Alternative f) => Option -> Text -> Text -> f Text-matchOpt option patt = toAlternativeOf $ _matchOpt option patt+matchOpt option patt = toAlternativeOf1 $ _matchOpt option patt -- | Match a pattern to a subject and lazily return a list of all -- non-overlapping portions that matched.@@ -1286,8 +1266,8 @@ -- | @_capturesOpt mempty = _captures@ _capturesOpt :: Option -> Text -> Traversal' Text (NonEmpty Text)-_capturesOpt = withMatcher $ \matcher ->- _capturesInternal matcher getAllSliceRanges slice+_capturesOpt option patt = _capturesInternal matcher getAllSliceRanges where+ matcher = unsafePerformIO $ assembleMatcher option patt -- | Given a pattern, produce a traversal (0 or more targets) that focuses from -- a subject to the portions of it that match.@@ -1298,12 +1278,13 @@ -- | @_matchOpt mempty = _match@ _matchOpt :: Option -> Text -> Traversal' Text Text-_matchOpt = withMatcher $ \matcher ->- _capturesInternal matcher get0thSliceRanges slice . _headNE+_matchOpt option patt = _cs . _headNE where+ _cs = _capturesInternal matcher get0thSliceRanges+ matcher = unsafePerformIO $ assembleMatcher option patt -- * Support for Template Haskell compile-time regex analysis --- | From options and pattern, determine parenthesized patterns\' names in+-- | From options and pattern, determine parenthesized captures\' names in -- order. predictCaptureNames :: Option -> Text -> IO [Maybe Text] predictCaptureNames option patt = do@@ -1313,7 +1294,7 @@ withForeignPtr code getCaptureNames --- | NOTE: The 0th capture is always named @Nothing@.+-- | Get parenthesized captures\' names in order. getCaptureNames :: Ptr Pcre2_code -> IO [Maybe Text] getCaptureNames codePtr = do nameCount <- getCodeInfo @CUInt codePtr pcre2_INFO_NAMECOUNT@@ -1334,7 +1315,7 @@ hiCaptNum <- getCodeInfo @CUInt codePtr pcre2_INFO_CAPTURECOUNT - return $ map (names IM.!?) [0 .. fromIntegral hiCaptNum]+ return $ map (names IM.!?) [1 .. fromIntegral hiCaptNum] -- | Low-level access to compiled pattern info, per the docs. getCodeInfo :: (Storable a) => Ptr Pcre2_code -> CUInt -> IO a
src/hs/Text/Regex/Pcre2/TH.hs view
@@ -4,10 +4,8 @@ module Text.Regex.Pcre2.TH where -import Control.Applicative (Alternative(..))-import Data.Functor ((<&>)) import Data.IORef-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@@ -19,9 +17,13 @@ import System.IO.Unsafe (unsafePerformIO) import Text.Regex.Pcre2.Internal +-- | Unexported, top-level `IORef` that\'s created upon the first runtime+-- evaluation of a Template Haskell `Matcher`. globalMatcherCache :: IORef (Map Text Matcher) globalMatcherCache = unsafePerformIO $ newIORef Map.empty+{-# NOINLINE globalMatcherCache #-} +-- | Given a `Text`, create or retrieve a `Matcher` from the global cache. memoMatcher :: Text -> Matcher memoMatcher patt = unsafePerformIO $ do cache <- readIORef globalMatcherCache@@ -33,27 +35,32 @@ (Map.insert patt matcher cache, ()) return matcher +-- | Generate code to produce \(and memoize\) a `Matcher` from a pattern. matcherQ :: String -> ExpQ matcherQ s = [e| memoMatcher $ Text.pack $(stringE s) |] +-- | Predict parenthesized captures \(maybe named\) of a pattern at splice time. predictCaptureNamesQ :: String -> Q [Maybe Text] predictCaptureNamesQ = runIO . predictCaptureNames mempty . Text.pack +-- | Get the indexes of `Just` the named captures. toKVs :: [Maybe Text] -> [(Int, Text)]-toKVs names = [(number, name) | (number, Just name) <- zip [0 ..] names]+toKVs names = [(number, name) | (number, Just name) <- zip [1 ..] names] +-- | Generate the data-kinded phantom type parameter of `Captures` of a pattern,+-- if needed. capturesInfoQ :: String -> Q (Maybe Type) capturesInfoQ s = predictCaptureNamesQ s >>= \case- -- No named captures, so need for Captures, so no info.- [Nothing] -> return Nothing+ -- No parenthesized captures, so need for Captures, so no info.+ [] -> return Nothing - -- Named captures. Present- -- [Nothing, Just "foo", Just "bar", Nothing]+ -- One or more parenthesized captures. Present+ -- [Just "foo", Just "bar", Nothing] -- as -- '(3, '[ '("foo", 1), '("bar", 2)]). captureNames -> Just <$> promotedTupleT 2 `appT` hi `appT` kvs where -- 3- hi = litT $ numTyLit $ fromIntegral $ length captureNames - 1+ hi = litT $ numTyLit $ fromIntegral $ length captureNames -- '[ '("foo", 1), '("bar", 2)] kvs = foldr f promotedNilT $ toKVs captureNames where -- '("foo", 1) ': ...@@ -82,13 +89,13 @@ -- > year = read @Int $ Text.unpack $ capture @"y" cs -- > ... ----- > forM_ ([regex|^\s+$|] line :: Maybe Text) $ \spaces ->--- > error $ "line has spaces only: " ++ show spaces+-- > forM_ ([regex|\s+$|] line :: Maybe Text) $ \spaces -> error $+-- > "line has trailing spaces (" ++ show (Text.length spaces) ++ " characters)" -- -- /__As a pattern__/ ----- This matches when the regex matches, whereupon any named captures are bound--- to variables of the same names.+-- This matches when the regex first matches, whereupon any named captures are+-- bound to variables of the same names. -- -- > case "submitted 2020-10-20" of -- > [regex|(?<y>\d{4})-(?<m>\d{2})-(?<d>\d{2})|] ->@@ -101,15 +108,15 @@ -- If there are no named captures, this simply acts as a guard. regex :: QuasiQuoter regex = QuasiQuoter {- quoteExp = \s -> capturesInfoQ s >>= \case- Nothing -> [e|- let _cs = _capturesInternal $(matcherQ s) get0thSliceRanges slice- in toAlternativeOf $ _cs . _headNE |]- Just info -> [e|- let _cs = _capturesInternal $(matcherQ s) getAllSliceRanges slice- wrap cs = Captures cs :: Captures $(return info)- in toAlternativeOf $ _cs . to wrap |],+ quoteExp = \s -> do+ let fromCsQ = capturesInfoQ s >>= maybe [e| _headNE |] toWrapQ+ toWrapQ info = [e|+ let wrap cs = Captures cs :: Captures $(return info)+ in to wrap |] + [e| toAlternativeOf1 $+ _capturesInternal $(matcherQ s) getAllSliceRanges . $(fromCsQ) |],+ quotePat = \s -> do captureNames <- predictCaptureNamesQ s @@ -117,11 +124,7 @@ -- No named captures. Test whether the string matches without -- creating any new Text values. Nothing -> viewP- [e|- has $ _capturesInternal- $(matcherQ s)- (const $ return noTouchy)- noTouchy |]+ [e| has $ _capturesInternal $(matcherQ s) errorFromMatch |] [p| True |] -- One or more named captures. Attempt to bind only those to local@@ -132,7 +135,6 @@ 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],@@ -159,15 +161,14 @@ -- _regex :: QuasiQuoter _regex = QuasiQuoter {- quoteExp = \s -> capturesInfoQ s >>= \case- Nothing -> [e|- let _cs = _capturesInternal $(matcherQ s) get0thSliceRanges slice- in _cs . _headNE |]- Just info -> [e|- let _cs = _capturesInternal $(matcherQ s) getAllSliceRanges slice- wrapped :: Lens' (NonEmpty Text) (Captures $(return info))- wrapped f cs = f (Captures cs) <&> \(Captures cs') -> cs'- in _cs . wrapped |],+ quoteExp = \s -> do+ let fromCsQ = capturesInfoQ s >>= maybe [e| _headNE |] wrappedQ+ wrappedQ info = [e|+ let wrapped :: Lens' (NonEmpty Text) (Captures $(return info))+ wrapped f cs = f (Captures cs) <&> \(Captures cs') -> cs'+ in wrapped |]++ [e| _capturesInternal $(matcherQ s) getAllSliceRanges . $(fromCsQ) |], quotePat = const $ fail "_regex: cannot produce a pattern",
test/Spec.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} @@ -222,9 +221,12 @@ _ -> expectationFailure "quasi-quoted pattern didn't match" + issue 17 $ do+ match "\\d+" "123 456" `shouldBe` ["123"]+ where issue :: Int -> Expectation -> Spec- issue n = it $ "https://github.com/sjshuck/pcre2/issues/" ++ show n+ issue n = it $ "https://github.com/sjshuck/hs-pcre2/issues/" ++ show n onlyCausesOneCompilation :: (Option -> Text -> a) -> Expectation onlyCausesOneCompilation regexWithOpt = do