diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/pcre2.cabal b/pcre2.cabal --- a/pcre2.cabal +++ b/pcre2.cabal @@ -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 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 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 @@ -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 diff --git a/src/hs/Text/Regex/Pcre2/Foreign.hs b/src/hs/Text/Regex/Pcre2/Foreign.hs --- a/src/hs/Text/Regex/Pcre2/Foreign.hs +++ b/src/hs/Text/Regex/Pcre2/Foreign.hs @@ -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" 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 @@ -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" 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 @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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|(?\d{4})-(?\d{2})-(?\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|(?\d{4})-(?\d{2})-(?\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)|(?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)|] "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 (?...) (?[[:alpha:]]) (ba*z)" - `shouldReturn` (3, [("bar", 1), ("a", 2)]) + testGroup "predictCapturesInfo" [ + testCase ("analyzes captures groups' names" `issue` 45) $ do + info <- predictCapturesInfo mempty + "foo (?...) (?[[: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)|] "abc" + +assertThrow :: forall e a. (Exception e) => IO a -> Assertion +assertThrow action = + try @e action >>= traverseOf_ _Right (\_ -> assertFailure "didn't throw")