pcre2-2.2.3: test/Spec.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import Control.Applicative (Alternative)
import Control.Exception (catch, evaluate, handle)
import Control.Monad (forM_, void)
import Control.Monad.RWS.Lazy (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 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
onlyCausesOneCompilation $ \option ->
matchesOpt option "foo"
it "only causes one compilation (point-free expression)" $ do
onlyCausesOneCompilation $ \option ->
(||) <$> Text.null <*> matchesOpt option "foo"
describe "basic matching" $ do
-- verifies that NotEmpty makes a difference, see below
it "matches an empty pattern to an empty subject" $ do
match "" "" `shouldBe` Just ""
it "works using matches" $ do
matches "(?i)foo" "FOO" `shouldBe` True
it "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"
it "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
it ("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"]
it ("is in UTF mode" `issue` 26) $ do
matchesOpt (Bsr BsrUnicode) "\\R$" "line separator: \x2028"
`shouldBe` True
it ("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
it "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"])
it "signals match failure by not targeting anything" $ do
let result = evalRWS
(promptNee "Shhhhh")
(error "should be unreachable")
()
result `shouldBe` ("Shhhhh", [])
it "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"
describe "option handling" $ do
it "includes compile options" $ do
matchOpt Ungreedy "a+" "aaa" `shouldBe` Just "a"
it "includes extra compile options" $ do
matchOpt BadEscapeIsLiteral "\\j" "\\j" `shouldBe` Just "j"
it "includes compile context options" $ do
let bsrMatchesFF bsr = matchesOpt (Bsr bsr) "\\R" "\f"
bsrMatchesFF BsrUnicode `shouldBe` True
bsrMatchesFF BsrAnyCrlf `shouldBe` False
-- We already know it includes compile recursion guards
it "includes match options" $ do
matchOpt NotEmpty "" "" `shouldBe` Nothing
it "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
it "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
it "includes match context options" $ do
matchOpt (OffsetLimit 10) "b" "aaaaaaaaaaab" `shouldBe` Nothing
describe "user errors" $ do
it "are thrown at match time" $ do
(broken @Maybe "foo" `seq` return ())
`shouldThrow` anyPcre2Exception
it "are catchable using Control.Exception.evaluate" $ do
let example = handle @SomePcre2Exception (\_ -> return Nothing) $
evaluate $ broken "foo"
example `shouldReturn` Nothing
it "are catchable using instance Alternative IO" $ do
let example = handle @SomePcre2Exception (\_ -> return "broken") $
broken "foo"
example `shouldReturn` "broken"
describe "native substitution" $ do
it "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"
it "works using gsub" $ do
gsub "a" "o" "apples and bananas" `shouldBe` "opples ond bononos"
describe "regex :: QuasiQuoter" $ do
context "as an expression" $ do
it "works with parenthesized captures" $ do
case [regex|(?<y>\d{4})-(?<m>\d{2})-(?<d>\d{2})|] submitted of
Nothing -> expectationFailure "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)
it "works without parenthesized captures" $ do
let example = forM_ @Maybe ([regex|^\s+$|] " ") $ \spaces ->
error $ "line has spaces only: " ++ show spaces
example `shouldThrow` anyErrorCall
context "as a pattern" $ do
it "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"
it ("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"
it "works without named captures" $ do
case "abc" of
[regex|a(b)c|] -> return ()
_ -> expectationFailure "regex didn't match"
describe "_regex" $ do
it "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?"
it "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"
describe "Captures" $ do
let mkCaptures = [regex|a(b)(?<c>c)|] "abc"
it "has a predictable Show instance" $ do
cs <- mkCaptures
show cs `shouldBe` "Captures (\"abc\" :| [\"b\",\"c\"])"
it "can have its underlying list extracted" $ do
cs <- mkCaptures
getCaptures cs `shouldBe` "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)])
describe "an unset capture" $ do
it "is treated as empty" $ do
captures "(a)?" "" `shouldBe` Just ("" :| [""])
it "is unchanged via Traversal'" $ do
set ([_regex|(a)?|] . _capture @1) "foo" "" `shouldBe` ""
it "permits other captures to be changed via Traversal'" $ do
set ([_regex|(a)?|] . _capture @0) "foo" "" `shouldBe` "foo"
describe "Traversal'" $ do
it "supports global substitutions" $ do
set (_match "a") "o" "apples and bananas"
`shouldBe` "opples ond bononos"
it "converges in the presence of empty matches" $ do
length (match @[] "" "12345") `shouldBe` 6
describe "PCRE2 build configuration" $ do
it ("includes Unicode support" `issue` 21) $ do
matchesOpt Ucp "\\w$" "aleph: \x2135" `shouldBe` True
-- | Modify label of `describe`, `it`, 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 regexWithOpt = do
counter <- newIORef (0 :: Int)
let option = UnsafeCompileRecGuard $ \_ -> do
modifyIORef' counter (+ 1)
return True
run = void . evaluate . regexWithOpt option
getCount = readIORef counter
run "foo"
countAfterOnce <- getCount
countAfterOnce `shouldSatisfy` (> 0) -- probably 2!
run "bar"
run "baz"
countAfterTwiceMore <- getCount
countAfterTwiceMore `shouldBe` countAfterOnce
anyPcre2Exception :: Selector SomePcre2Exception
anyPcre2Exception _ = True
submitted :: Text
submitted = "submitted 2020-10-20"
broken :: (Alternative f) => Text -> f Text
broken = match "*"