pcre2 2.2.3 → 2.3.0
raw patch · 8 files changed
+193/−264 lines, 8 filesdep +tastydep +tasty-hunitdep −hspec
Dependencies added: tasty, tasty-hunit
Dependencies removed: hspec
Files
- ChangeLog.md +10/−0
- README.md +4/−2
- pcre2.cabal +18/−5
- src/hs/Text/Regex/Pcre2.hs +4/−21
- src/hs/Text/Regex/Pcre2/Foreign.hs +11/−0
- src/hs/Text/Regex/Pcre2/Internal.hs +8/−105
- src/hs/Text/Regex/Pcre2/TH.hs +4/−6
- test/Spec.hs +134/−125
ChangeLog.md view
@@ -1,5 +1,15 @@ # Changelog and Acknowledgements +## 2.3.0+* Disabled building JIT by default.+ * Removed various JIT-related functions and constants from+ `Text.Regex.Pcre2.Foreign`. No other modules were affected.+ * A 30–40% improvement is observed in both build time and binary output+ size.+ * JIT may be re-enabled with the `support-jit` flag.+* Removed PCRE2 compile-time config constants. The info they produce is now+ hard-coded in the Haddock docs.+ ## 2.2.3 * Exposed `CapturesInfo` kind of type-level regex info. * Exposed `predictCapturesInfo` for producing value-level of same, implementing
README.md view
@@ -19,7 +19,9 @@ _ -> die "nothing brown" ``` ```haskell-let kv'd = lined . packed . [_regex|(?x) # Extended PCRE2 syntax++let kv'd :: Traversal' String (Captures _)+ kv'd = lined . packed . [_regex|(?x) # Extended PCRE2 syntax ^\s* # Ignore leading whitespace ([^=:\s].*?) # Capture the non-empty key \s* # Ignore trailing whitespace@@ -89,4 +91,4 @@ PCRE2 is distributed under the [3-clause BSD](https://www.pcre.org/licence.txt) license. ## Main Author-©2020–2025 Steven Shuck+©2020–2026 Steven Shuck
pcre2.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: pcre2-version: 2.2.3+version: 2.3.0 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@@ -13,10 +13,14 @@ bug-reports: https://github.com/sjshuck/hs-pcre2/issues author: Steven Shuck and contributors maintainer: stevenjshuck@gmail.com-copyright: 2020-2025 Steven Shuck+copyright: 2020-2026 Steven Shuck license: Apache-2.0 license-file: LICENSE build-type: Simple+tested-with:+ GHC == 9.8.4+ , GHC == 9.10.3+ , GHC == 9.12.2 extra-source-files: README.md ChangeLog.md@@ -138,6 +142,11 @@ type: git location: https://github.com/sjshuck/hs-pcre2 +flag support-jit+ description: Whether to build with JIT support and export JIT-specific items.+ manual: False+ default: False+ library exposed-modules: Text.Regex.Pcre2@@ -150,8 +159,8 @@ Paths_pcre2 hs-source-dirs: src/hs- ghc-options: -W -optc=-DPCRE2_CODE_UNIT_WIDTH=8 -optc=-DPCRE2_STATIC=1 -optc=-DSUPPORT_PCRE2_8 -optc=-Wno-incompatible-pointer-types- cc-options: -DHAVE_CONFIG_H -DHAVE_INTTYPES_H=1 -DHAVE_LIMITS_H=1 -DHAVE_MEMMOVE_H=1 -DHAVE_STDINT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRERROR_H=1 -DHAVE_STRING_H=1 -DSUPPORT_JIT=1 -DSUPPORT_UNICODE=1+ ghc-options: -W -optc=-DPCRE2_CODE_UNIT_WIDTH=8 -optc=-DPCRE2_STATIC -optc=-DSUPPORT_PCRE2_8 -optc=-Wno-incompatible-pointer-types+ cc-options: -DHAVE_CONFIG_H -DHAVE_INTTYPES_H -DHAVE_LIMITS_H -DHAVE_MEMMOVE_H -DHAVE_STDINT_H -DHAVE_STDLIB_H -DHAVE_STRERROR_H -DHAVE_STRING_H -DSUPPORT_UNICODE include-dirs: src/c src/c/pcre2/src@@ -199,6 +208,9 @@ ghc-options: -optc=-Wno-ignored-qualifiers else ghc-options: -optc=-Wno-discarded-qualifiers+ if flag(support-jit)+ cpp-options: -DSUPPORT_JIT+ cc-options: -DSUPPORT_JIT test-suite pcre2-test type: exitcode-stdio-1.0@@ -211,11 +223,12 @@ build-depends: base >=4.9 && <5 , containers- , hspec , microlens , microlens-platform , mtl , pcre2+ , tasty+ , tasty-hunit , template-haskell , text >=2 default-language: Haskell2010
src/hs/Text/Regex/Pcre2.hs view
@@ -3,8 +3,9 @@ {-| === __Introduction__ - Atop the low-level binding to the C API, we present a high-level interface- to add regular expressions to Haskell programs.+ Atop the low-level binding to the C API (PCRE2 10.47, Unicode 16.0.0), we+ present a high-level interface to add regular expressions to Haskell+ programs. All input and output strings are strict `Data.Text.Text`, which maps to how PCRE2 operates in UTF-8 mode.@@ -289,25 +290,7 @@ -- * User errors SomePcre2Exception(), Pcre2Exception(),- Pcre2CompileException(),-- -- * PCRE2 build configuration- defaultBsr,- compiledWidths,- defaultDepthLimit,- defaultHeapLimit,- supportsJit,- jitTarget,- linkSize,- effectivelinkSize,- defaultMatchLimit,- defaultNewline,- defaultIsNeverBackslashC,- defaultParensLimit,- defaultTablesLength,- unicodeVersion,- supportsUnicode,- pcreVersion)+ Pcre2CompileException()) where import Text.Regex.Pcre2.Internal
src/hs/Text/Regex/Pcre2/Foreign.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CApiFFI #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} -- | A complete binding to the low-level C API.@@ -38,7 +39,9 @@ data Pcre2_callout_block data Pcre2_substitute_callout_block data Pcre2_code+#ifdef SUPPORT_JIT data Pcre2_jit_stack+#endif data Pcre2_match_data data Pcre2_callout_enumerate_block @@ -276,6 +279,7 @@ constant ''CUInt "EXTRA_MATCH_LINE" constant ''CUInt "EXTRA_MATCH_WORD" +#ifdef SUPPORT_JIT -- * JIT compilation foreign import capi safe "pcre2.h" pcre2_jit_compile@@ -319,6 +323,7 @@ foreign import capi safe "pcre2.h" pcre2_jit_stack_free :: Ptr Pcre2_jit_stack -> IO ()+#endif -- * Locale support @@ -354,7 +359,9 @@ constant ''CUInt "INFO_HASCRORLF" constant ''CUInt "INFO_HEAPLIMIT" constant ''CUInt "INFO_JCHANGED"+#ifdef SUPPORT_JIT constant ''CUInt "INFO_JITSIZE"+#endif constant ''CUInt "INFO_LASTCODETYPE" constant ''CUInt "INFO_LASTCODEUNIT" constant ''CUInt "INFO_MATCHEMPTY"@@ -469,7 +476,9 @@ constant ''CUInt "NOTEOL" constant ''CUInt "NOTEMPTY" constant ''CUInt "NOTEMPTY_ATSTART"+#ifdef SUPPORT_JIT constant ''CUInt "NO_JIT"+#endif constant ''CUInt "PARTIAL_HARD" constant ''CUInt "PARTIAL_SOFT" @@ -485,7 +494,9 @@ constant ''CInt "ERROR_DEPTHLIMIT" constant ''CInt "ERROR_HEAPLIMIT" constant ''CInt "ERROR_INTERNAL"+#ifdef SUPPORT_JIT constant ''CInt "ERROR_JIT_STACKLIMIT"+#endif constant ''CInt "ERROR_MATCHLIMIT" constant ''CInt "ERROR_NOMEMORY" constant ''CInt "ERROR_NULL"
src/hs/Text/Regex/Pcre2/Internal.hs view
@@ -208,11 +208,10 @@ | Anchored -- ^ Equivalent to beginning pattern with @^@. | BadEscapeIsLiteral -- ^ Do not throw an error for unrecognized or -- malformed escapes. /"This is a dangerous option."/- | Bsr Bsr -- ^ Override what @\\R@ matches (default given by `defaultBsr`).+ | Bsr Bsr -- ^ Override what @\\R@ matches (default is `BsrUnicode`). | Caseless -- ^ Case-insensitive match. Equivalent to @(?i)@. | DepthLimit Word32 -- ^ Override maximum depth of nested backtracking- -- (default given by `defaultDepthLimit`). Equivalent to- -- @(*LIMIT_DEPTH=@/number/@)@.+ -- (default is 10,000,000). Equivalent to @(*LIMIT_DEPTH=@/number/@)@. | DollarEndOnly -- ^ Don't match @$@ with a newline at the end of the -- subject. | DotAll -- ^ A dot also matches a (single-character) newline. Equivalent@@ -230,12 +229,12 @@ -- @[]@. | FirstLine -- ^ The match must begin in the first line of the subject. | HeapLimit Word32 -- ^ Override maximum heap memory (in kibibytes) used to- -- hold backtracking information (default given by `defaultHeapLimit`).+ -- hold backtracking information (default is 20,000,000). -- Equivalent to @(*LIMIT_HEAP=@/number/@)@. | Literal -- ^ Treat the pattern as a literal string. | MatchLimit Word32 -- ^ Override maximum value of the main matching loop's- -- internal counter (default given by `defaultMatchLimit`), as a simple CPU- -- throttle. Equivalent to @(*LIMIT_MATCH=@/number/@)@.+ -- internal counter (default is 10,000,000), as a simple CPU throttle.+ -- Equivalent to @(*LIMIT_MATCH=@/number/@)@. | MatchLine -- ^ Only match complete lines. Equivalent to bracketing the -- pattern with @^(?:@/pattern/@)$@. | MatchUnsetBackRef -- ^ A backreference to an unset capture group matches@@ -249,8 +248,8 @@ | NeverBackslashC -- ^ Do not allow the unsafe @\\C@ sequence. | NeverUcp -- ^ Don't count Unicode characters in some character classes -- such as @\\d@. Overrides @(*UCP)@.- | Newline Newline -- ^ Override what a newline is (default given by- -- `defaultNewline`). Equivalent to @(*CRLF)@ or similar.+ | Newline Newline -- ^ Override what a newline is (default is `NewlineLf`).+ -- Equivalent to @(*CRLF)@ or similar. | NoAutoCapture -- ^ Disable numbered capturing parentheses. | NoAutoPossess -- ^ Turn off some optimizations, possibly resulting in -- some callouts not being called.@@ -268,7 +267,7 @@ | OffsetLimit Word64 -- ^ Limit how far an unanchored search can advance in -- the subject. | ParensLimit Word32 -- ^ Override max depth of nested parentheses (default- -- given by `defaultParensLimit`).+ -- is 250). | PartialHard -- ^ If the subject ends without finding a complete match, -- stop trying alternatives and signal a partial match immediately. -- Currently we do this by throwing a `Pcre2Exception` but we should do@@ -1185,99 +1184,3 @@ -- it against a predicate, and throw an exception upon failure. check :: (CInt -> Bool) -> CInt -> IO () check p = unless . p <*> throwIO . Pcre2Exception---- * PCRE2 compile-time config---- | Helper for getting PCRE2 compile-time config integers.-getConfigNumeric :: CUInt -> CUInt-getConfigNumeric what = unsafePerformIO $ alloca $ \ptr -> do- pcre2_config what ptr- peek ptr---- | Helper for getting PCRE2 compile-time config strings.-getConfigString :: CUInt -> Maybe Text-getConfigString what = unsafePerformIO $ do- len <- pcre2_config what nullPtr- if len == pcre2_ERROR_BADOPTION- then return Nothing- -- FIXME Do we really need "+ 1" here?- -- FIXME allocaBytes looks wrong- else allocaBytes (fromIntegral (len + 1) * 2) $ \ptr -> do- pcre2_config what ptr- Just <$> Text.fromPtr ptr (fromIntegral len - 1)---- | See t`Bsr`.-defaultBsr :: Bsr-defaultBsr = bsrFromC $ getConfigNumeric pcre2_CONFIG_BSR---- | Which code widths PCRE2 is compiled to operate on. Can be any combination--- of 8, 16, and 32. Should be @[8]@ but provided here for completeness.-compiledWidths :: [Int]-compiledWidths =- let bitmap = getConfigNumeric pcre2_CONFIG_COMPILED_WIDTHS- in [w | (b, w) <- [(1, 8), (2, 16), (4, 32)], b .&. bitmap /= 0]---- | See `DepthLimit`.-defaultDepthLimit :: Int-defaultDepthLimit = fromIntegral $ getConfigNumeric pcre2_CONFIG_DEPTHLIMIT---- | See `HeapLimit`.-defaultHeapLimit :: Int-defaultHeapLimit = fromIntegral $ getConfigNumeric pcre2_CONFIG_HEAPLIMIT---- | Was PCRE2 built with JIT support?-supportsJit :: Bool-supportsJit = getConfigNumeric pcre2_CONFIG_JIT == 1---- | A nice description of the CPU architecture JIT support is compiled for, if--- any.-jitTarget :: Maybe Text-jitTarget = getConfigString pcre2_CONFIG_JITTARGET---- | Number of bytes PCRE2 was instructed to use for internal linkage in--- compiled regexes.-linkSize :: Int-linkSize = fromIntegral $ getConfigNumeric pcre2_CONFIG_LINKSIZE---- | Number of bytes actually used for internal linkage in compiled regexes.------ @since 2.2.3-effectivelinkSize :: Int-effectivelinkSize =- fromIntegral $ getConfigNumeric pcre2_CONFIG_EFFECTIVE_LINKSIZE---- | See `MatchLimit`.-defaultMatchLimit :: Int-defaultMatchLimit = fromIntegral $ getConfigNumeric pcre2_CONFIG_MATCHLIMIT---- | See t`Newline`.-defaultNewline :: Newline-defaultNewline = newlineFromC $ getConfigNumeric pcre2_CONFIG_NEWLINE---- | See `NeverBackslashC`.-defaultIsNeverBackslashC :: Bool-defaultIsNeverBackslashC = getConfigNumeric pcre2_CONFIG_NEVER_BACKSLASH_C == 1---- | See `ParensLimit`.-defaultParensLimit :: Int-defaultParensLimit = fromIntegral $ getConfigNumeric pcre2_CONFIG_PARENSLIMIT---- | Size in bytes of PCRE2's built-in character processing tables.-defaultTablesLength :: Int-defaultTablesLength = fromIntegral $ getConfigNumeric pcre2_CONFIG_TABLES_LENGTH---- | Unicode version string such as @8.0.0@, if Unicode is supported at all.-unicodeVersion :: Maybe Text-unicodeVersion = case getConfigString pcre2_CONFIG_UNICODE_VERSION of- Just v | Text.unpack v == "Unicode not supported" -> Nothing- maybeV -> maybeV---- | Was PCRE2 built with Unicode support?-supportsUnicode :: Bool-supportsUnicode = getConfigNumeric pcre2_CONFIG_UNICODE == 1---- | Version of the built-in C library. The versioning scheme is that PCRE--- legacy is 8.x and PCRE2 is 10.x, so this should be @10.@/something/.-pcreVersion :: Text-pcreVersion = fromMaybe e $ getConfigString pcre2_CONFIG_VERSION where- e = error "Text.Regex.Pcre2.Internal.pcreVersion: unable to get string"
src/hs/Text/Regex/Pcre2/TH.hs view
@@ -26,7 +26,6 @@ import qualified Data.Text as Text import qualified Data.Text.Foreign as Text import Data.Type.Bool (If)-import Data.Type.Equality (type (==)) import Foreign import Foreign.C (CUChar, CUInt) import GHC.TypeLits hiding (Text)@@ -61,11 +60,10 @@ -- | Look up the number of a capture at compile time, either by number or by -- name. Throw a helpful 'TypeError' if the index doesn't exist. type family CaptNum (i :: k) (info :: CapturesInfo) :: Nat where- CaptNum (i :: Nat) '(hi, _) = If (i `CmpNat` hi == 'GT)- -- then- (TypeError (TypeLits.Text "No capture numbered " :<>: ShowType i))- -- else- i+ CaptNum (i :: Nat) '(hi, _) = If (i <=? hi)+ {- then -} i+ {- else -} (TypeError+ (TypeLits.Text "No capture numbered " :<>: ShowType i)) CaptNum (i :: Symbol) '(_, '(i, num) ': _) = num CaptNum (i :: Symbol) '(hi, _ ': kvs) = CaptNum i '(hi, kvs)
test/Spec.hs view
@@ -1,251 +1,250 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Main where import Control.Applicative (Alternative)-import Control.Exception (catch, evaluate, handle)+import Control.Exception import Control.Monad (forM_, void)-import Control.Monad.RWS.Lazy (ask, evalRWS, tell)+import Control.Monad.RWS.Lazy (RWS, ask, evalRWS, tell) import Data.IORef (modifyIORef', newIORef, readIORef) import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (Text) import qualified Data.Text as Text import Lens.Micro.Platform-import Test.Hspec+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.HUnit import Text.Printf (printf) import Text.Regex.Pcre2 import Text.Regex.Pcre2.Unsafe main :: IO ()-main = hspec $ do- describe "partial application" $ do- it "only causes one compilation" $ do+main = defaultMain $ testGroup "tests" [+ testGroup "partial application" [+ testCase "only causes one compilation" $ do onlyCausesOneCompilation $ \option ->- matchesOpt option "foo"+ matchesOpt option "foo", - it "only causes one compilation (point-free expression)" $ do+ testCase "only causes one compilation (point-free expression)" $ do onlyCausesOneCompilation $ \option ->- (||) <$> Text.null <*> matchesOpt option "foo"+ (||) <$> Text.null <*> matchesOpt option "foo"], - describe "basic matching" $ do+ testGroup "basic matching" [ -- verifies that NotEmpty makes a difference, see below- it "matches an empty pattern to an empty subject" $ do- match "" "" `shouldBe` Just ""+ testCase "matches an empty pattern to an empty subject" $ do+ match "" "" @?= Just "", - it "works using matches" $ do- matches "(?i)foo" "FOO" `shouldBe` True+ testCase "works using matches" $ do+ matches "(?i)foo" "FOO" @?= True, - it "works using captures" $ do+ testCase "works using captures" $ do case captures "(\\d{4})-(\\d{2})-(\\d{2})" submitted of- Just ne -> ne `shouldBe` "2020-10-20" :| ["2020", "10", "20"]- Nothing -> expectationFailure "didn't match"+ Just ne -> ne @?= "2020-10-20" :| ["2020", "10", "20"]+ Nothing -> assertFailure "didn't match", - it "is lazy" $ do+ testCase "is lazy" $ do counter <- newIORef (0 :: Int) let callout = UnsafeCallout $ \_ -> do modifyIORef' counter (+ 1) return CalloutProceed take 3 (matchOpt callout "(?C1)a" "apples and bananas")- `shouldBe` ["a", "a", "a"]- readIORef counter `shouldReturn` 3+ @?= ["a", "a", "a"]+ readIORef counter >>= (@?= 3), - it ("fills up Alternative containers" `issue` 18) $ do+ testCase ("fills up Alternative containers" `issue` 18) $ do let result :: (Alternative f) => f Text result = match "\\d+" "123 456"- result `shouldBe` Just "123"- result `shouldBe` ["123", "456"]+ result @?= Just "123"+ result @?= ["123", "456"], - it ("is in UTF mode" `issue` 26) $ do+ testCase ("is in UTF mode" `issue` 26) $ do matchesOpt (Bsr BsrUnicode) "\\R$" "line separator: \x2028"- `shouldBe` True+ @?= True, - it ("doesn't use-after-free() for long matches" `issue` 39) $ do+ testCase ("doesn't use-after-free() for long matches" `issue` 39) $ do let subj = Text.replicate 20000 "a"- length (captures @[] "." subj) `shouldBe` 20000-- describe "lens-powered matching" $ do- let _nee :: Traversal' Text Text- _nee = _matchOpt (Caseless <> MatchWord) "nee"- promptNee = traverseOf (_nee . unpacked) $ \s -> tell [s] >> ask+ length (captures @[] "." subj) @?= 20000], - it "can accrete effects while performing replacements" $ do+ testGroup "lens-powered matching" [+ testCase "can accrete effects while performing replacements" $ do let result = evalRWS (promptNee "We are the knights who say...NEE!") "NOO" ()- result `shouldBe` ("We are the knights who say...NOO!", ["NEE"])+ result @?= ("We are the knights who say...NOO!", ["NEE"]), - it "signals match failure by not targeting anything" $ do+ testCase "signals match failure by not targeting anything" $ do let result = evalRWS (promptNee "Shhhhh") (error "should be unreachable") ()- result `shouldBe` ("Shhhhh", [])+ result @?= ("Shhhhh", []), - it "does not substitute when setting equal Text" $ do+ testCase "does not substitute when setting equal Text" $ do let threeAndMiddle = _captures ". (.) ."- ("A A A" & threeAndMiddle .~ "A A A" :| ["B"]) `shouldBe` "A B A"- ("A A A" & threeAndMiddle .~ "A B A" :| ["A"]) `shouldBe` "A B A"+ ("A A A" & threeAndMiddle .~ "A A A" :| ["B"]) @?= "A B A"+ ("A A A" & threeAndMiddle .~ "A B A" :| ["A"]) @?= "A B A"], - describe "option handling" $ do- it "includes compile options" $ do- matchOpt Ungreedy "a+" "aaa" `shouldBe` Just "a"+ testGroup "option handling" [+ testCase "includes compile options" $ do+ matchOpt Ungreedy "a+" "aaa" @?= Just "a", - it "includes extra compile options" $ do- matchOpt BadEscapeIsLiteral "\\j" "\\j" `shouldBe` Just "j"+ testCase "includes extra compile options" $ do+ matchOpt BadEscapeIsLiteral "\\j" "\\j" @?= Just "j", - it "includes compile context options" $ do+ testCase "includes compile context options" $ do let bsrMatchesFF bsr = matchesOpt (Bsr bsr) "\\R" "\f"- bsrMatchesFF BsrUnicode `shouldBe` True- bsrMatchesFF BsrAnyCrlf `shouldBe` False+ bsrMatchesFF BsrUnicode @?= True+ bsrMatchesFF BsrAnyCrlf @?= False, -- We already know it includes compile recursion guards - it "includes match options" $ do- matchOpt NotEmpty "" "" `shouldBe` Nothing+ testCase "includes match options" $ do+ matchOpt NotEmpty "" "" @?= Nothing, - it "includes callouts" $ do+ testCase "includes callouts" $ do calloutRanRef <- newIORef 0 let callout = UnsafeCallout $ \_ -> do modifyIORef' calloutRanRef (+ 1) return CalloutProceed- matchOpt callout "(?C'foo')a(?C42)a" "aa" `shouldBe` Just "aa"- readIORef calloutRanRef `shouldReturn` 2+ matchOpt callout "(?C'foo')a(?C42)a" "aa" @?= Just "aa"+ readIORef calloutRanRef >>= (@?= 2), - it "includes substitution callouts" $ do+ testCase "includes substitution callouts" $ do subCalloutRanRef <- newIORef 0 let subCallout = UnsafeSubCallout $ \_ -> do modifyIORef' subCalloutRanRef (+ 1) return SubCalloutAccept- subOpt (subCallout <> SubGlobal) "a" "b" "aa" `shouldBe` "bb"- readIORef subCalloutRanRef `shouldReturn` 2+ subOpt (subCallout <> SubGlobal) "a" "b" "aa" @?= "bb"+ readIORef subCalloutRanRef >>= (@?= 2), - it "includes match context options" $ do- matchOpt (OffsetLimit 10) "b" "aaaaaaaaaaab" `shouldBe` Nothing+ testCase "includes match context options" $ do+ matchOpt (OffsetLimit 10) "b" "aaaaaaaaaaab" @?= Nothing], - describe "user errors" $ do- it "are thrown at match time" $ do- (broken @Maybe "foo" `seq` return ())- `shouldThrow` anyPcre2Exception+ testGroup "user errors" [+ testCase "are thrown at match time" $ do+ assertThrow @SomePcre2Exception $+ broken @Maybe "foo" `seq` return (), - it "are catchable using Control.Exception.evaluate" $ do+ testCase "are catchable using Control.Exception.evaluate" $ do let example = handle @SomePcre2Exception (\_ -> return Nothing) $ evaluate $ broken "foo"- example `shouldReturn` Nothing+ example >>= (@?= Nothing), - it "are catchable using instance Alternative IO" $ do+ testCase "are catchable using instance Alternative IO" $ do let example = handle @SomePcre2Exception (\_ -> return "broken") $ broken "foo"- example `shouldReturn` "broken"+ example >>= (@?= "broken")], - describe "native substitution" $ do- it "works using sub" $ do+ testGroup "native substitution" [+ testCase "works using sub" $ do let result = sub "(\\w+) calling the (\\w+)" "$2 calling the $1" "the pot calling the kettle black"- result `shouldBe` "the kettle calling the pot black"+ result @?= "the kettle calling the pot black", - it "works using gsub" $ do- gsub "a" "o" "apples and bananas" `shouldBe` "opples ond bononos"+ testCase "works using gsub" $ do+ gsub "a" "o" "apples and bananas" @?= "opples ond bononos"], - describe "regex :: QuasiQuoter" $ do- context "as an expression" $ do- it "works with parenthesized captures" $ do+ testGroup "regex :: QuasiQuoter" [+ testGroup "as an expression" [+ testCase "works with parenthesized captures" $ do case [regex|(?<y>\d{4})-(?<m>\d{2})-(?<d>\d{2})|] submitted of- Nothing -> expectationFailure "regex didn't match"+ Nothing -> assertFailure "regex didn't match" Just cs -> do let date = capture @0 cs year = read @Int $ Text.unpack $ capture @"y" cs- (date, year) `shouldBe` ("2020-10-20", 2020)+ (date, year) @?= ("2020-10-20", 2020), - it "works without parenthesized captures" $ do+ testCase "works without parenthesized captures" $ do let example = forM_ @Maybe ([regex|^\s+$|] " ") $ \spaces -> error $ "line has spaces only: " ++ show spaces- example `shouldThrow` anyErrorCall+ assertThrow @ErrorCall example], - context "as a pattern" $ do- it "works with named captures" $ do+ testGroup "as a pattern" [+ testCase "works with named captures" $ do case submitted of [regex|(?<y>\d{4})-(?<m>\d{2})-(?<d>\d{2})|] -> do let year = read @Int $ Text.unpack y- year `shouldBe` 2020- _ -> expectationFailure "regex didn't match"+ year @?= 2020+ _ -> assertFailure "regex didn't match", - it ("works with possibly unset named captures" `issue` 4) $ do+ testCase ("works with possibly unset named captures" `issue` 4) $ do let f = fmap (capture @"b") . [regex|(?<a>a)|(?<b>b)|]- f "a" `shouldReturn` ""- f "b" `shouldReturn` "b"+ f "a" >>= (@?= "")+ f "b" >>= (@?= "b"), - it "works without named captures" $ do+ testCase "works without named captures" $ do case "abc" of [regex|a(b)c|] -> return ()- _ -> expectationFailure "regex didn't match"+ _ -> assertFailure "regex didn't match"]], - describe "_regex" $ do- it "works with parenthesized captures" $ do+ testGroup "_regex" [+ testCase "works with parenthesized captures" $ do -- Adapt the _captures example for use here let result = "Well bust my buttons!" &~ do zoom [_regex|(\w+) my (\w+)|] $ do _capture @1 . _head .= 'd' _capture @2 %= Text.reverse _last .= '?'- result `shouldBe` "Well dust my snottub?"+ result @?= "Well dust my snottub?", - it "works without parenthesized captures" $ do+ testCase "works without parenthesized captures" $ do let embeddedNumber :: Traversal' String Int embeddedNumber = packed . [_regex|\d+|] . unpacked . _Show result = "There are 14 competing standards" & embeddedNumber %~ (+ 1)- result `shouldBe` "There are 15 competing standards"+ result @?= "There are 15 competing standards"], - describe "Captures" $ do- let mkCaptures = [regex|a(b)(?<c>c)|] "abc"+ testGroup "Captures" [ - it "has a predictable Show instance" $ do+ testCase "has a predictable Show instance" $ do cs <- mkCaptures- show cs `shouldBe` "Captures (\"abc\" :| [\"b\",\"c\"])"+ show cs @?= "Captures (\"abc\" :| [\"b\",\"c\"])", - it "can have its underlying list extracted" $ do+ testCase "can have its underlying list extracted" $ do cs <- mkCaptures- getCaptures cs `shouldBe` "abc" :| ["b", "c"]+ getCaptures cs @?= "abc" :| ["b", "c"]], - describe "predictCapturesInfo" $ do- it ("analyzes captures groups' names" `issue` 45) $ do- predictCapturesInfo mempty "foo (?<bar>...) (?<a>[[:alpha:]]) (ba*z)"- `shouldReturn` (3, [("bar", 1), ("a", 2)])+ testGroup "predictCapturesInfo" [+ testCase ("analyzes captures groups' names" `issue` 45) $ do+ info <- predictCapturesInfo mempty+ "foo (?<bar>...) (?<a>[[:alpha:]]) (ba*z)"+ info @?= (3, [("bar", 1), ("a", 2)])], - describe "an unset capture" $ do- it "is treated as empty" $ do- captures "(a)?" "" `shouldBe` Just ("" :| [""])+ testGroup "an unset capture" [+ testCase "is treated as empty" $ do+ captures "(a)?" "" @?= Just ("" :| [""]), - it "is unchanged via Traversal'" $ do- set ([_regex|(a)?|] . _capture @1) "foo" "" `shouldBe` ""+ testCase "is unchanged via Traversal'" $ do+ set ([_regex|(a)?|] . _capture @1) "foo" "" @?= "", - it "permits other captures to be changed via Traversal'" $ do- set ([_regex|(a)?|] . _capture @0) "foo" "" `shouldBe` "foo"+ testCase "permits other captures to be changed via Traversal'" $ do+ set ([_regex|(a)?|] . _capture @0) "foo" "" @?= "foo"], - describe "Traversal'" $ do- it "supports global substitutions" $ do- set (_match "a") "o" "apples and bananas"- `shouldBe` "opples ond bononos"+ testGroup "Traversal'" [+ testCase "supports global substitutions" $ do+ set (_match "a") "o" "apples and bananas" @?= "opples ond bononos", - it "converges in the presence of empty matches" $ do- length (match @[] "" "12345") `shouldBe` 6+ testCase "converges in the presence of empty matches" $ do+ length (match @[] "" "12345") @?= 6], - describe "PCRE2 build configuration" $ do- it ("includes Unicode support" `issue` 21) $ do- matchesOpt Ucp "\\w$" "aleph: \x2135" `shouldBe` True+ testGroup "PCRE2 build configuration" [+ testCase ("includes Unicode support" `issue` 21) $ do+ matchesOpt Ucp "\\w$" "aleph: \x2135" @?= True]] --- | Modify label of `describe`, `it`, etc. to include a link to a Github issue.+-- | Modify label of `testGroup`, `testCase`, etc. to include a link to a Github+-- issue. issue :: String -> Int -> String issue = printf "%s (https://github.com/sjshuck/hs-pcre2/issues/%d)" -onlyCausesOneCompilation :: (Option -> Text -> a) -> Expectation+onlyCausesOneCompilation :: (Option -> Text -> a) -> Assertion onlyCausesOneCompilation regexWithOpt = do counter <- newIORef (0 :: Int) let option = UnsafeCompileRecGuard $ \_ -> do@@ -256,18 +255,28 @@ run "foo" countAfterOnce <- getCount- countAfterOnce `shouldSatisfy` (> 0) -- probably 2!+ countAfterOnce > 0 -- probably 2!+ @? "compile recursion guard didn't run after first match" run "bar" run "baz" countAfterTwiceMore <- getCount- countAfterTwiceMore `shouldBe` countAfterOnce+ countAfterTwiceMore == countAfterOnce+ @? "compile recursion guard ran again" -anyPcre2Exception :: Selector SomePcre2Exception-anyPcre2Exception _ = True+broken :: (Alternative f) => Text -> f Text+broken = match "*" submitted :: Text submitted = "submitted 2020-10-20" -broken :: (Alternative f) => Text -> f Text-broken = match "*"+promptNee :: Text -> RWS String [String] () Text+promptNee = traverseOf (_nee . unpacked) $ \s -> tell [s] >> ask where+ _nee = _matchOpt (Caseless <> MatchWord) "nee"++mkCaptures :: IO (Captures '(2, '[ '("c", 2)]))+mkCaptures = [regex|a(b)(?<c>c)|] "abc"++assertThrow :: forall e a. (Exception e) => IO a -> Assertion+assertThrow action =+ try @e action >>= traverseOf_ _Right (\_ -> assertFailure "didn't throw")