diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,8 @@ # Changelog and Acknowledgements +## 2.0.5 +* Enabled PCRE2's built-in Unicode support. + ## 2.0.4 * Added `Show` instance for `Captures` to ease debugging user code. 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.0.4 +version: 2.0.5 synopsis: Regular expressions via the PCRE2 C library (included) description: Please see the README on GitHub at category: Text @@ -108,8 +108,8 @@ Paths_pcre2 hs-source-dirs: src/hs - ghc-options: -W -optc=-DPCRE2_CODE_UNIT_WIDTH=16 -optc=-DPCRE2_STATIC=1 -optc=-DHAVE_INTTYPES_H=1 -optc=-DHAVE_LIMITS_H=1 -optc=-DHAVE_MEMMOVE_H=1 -optc=-DHAVE_STDINT_H=1 -optc=-DHAVE_STDLIB_H=1 -optc=-DHAVE_STRERROR_H=1 -optc=-DHAVE_STRING_H=1 -optc=-DSUPPORT_JIT=1 -optc=-DSUPPORT_PCRE2_16=1 -optc=-DSUPPORT_UNICODE=1 -optc=-Wno-discarded-qualifiers -optc=-Wno-incompatible-pointer-types - cc-options: -DHAVE_CONFIG_H -DPCRE2_CODE_UNIT_WIDTH=16 + ghc-options: -W -optc=-DPCRE2_CODE_UNIT_WIDTH=16 -optc=-DPCRE2_STATIC=1 -optc=-Wno-discarded-qualifiers -optc=-Wno-incompatible-pointer-types + cc-options: -DHAVE_CONFIG_H -DPCRE2_CODE_UNIT_WIDTH=16 -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_PCRE2_16=1 -DSUPPORT_UNICODE=1 include-dirs: src/c src/c/pcre2/src diff --git a/src/c/getters.h b/src/c/getters.h --- a/src/c/getters.h +++ b/src/c/getters.h @@ -1,9 +1,9 @@ // Functions to get PCRE2 struct fields. -#include - #ifndef GETTERS_H #define GETTERS_H + +#include #ifdef GETTER #error GETTER already defined 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 @@ -112,12 +112,11 @@ === __Handling results and errors__ In contrast to [other](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/match) - [APIs](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/matchAll)—including - previous versions of [this library](https://github.com/sjshuck/hs-pcre2/issues/17)—where - there are separate functions to request single versus global matching, we - accomplish this /(since 2.0.0)/ in a unified fashion using the + [APIs](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/matchAll) + where there are separate functions to request single versus global matching, + we accomplish this /(since 2.0.0)/ in a unified fashion using the `Control.Applicative.Alternative` typeclass. Typically the user will - choose from two instances, `Maybe` and `[]`: + choose from two instances, `Maybe` and @[]@: > b2 :: (Alternative f) => Text -> f Text > b2 = match "b.." @@ -200,7 +199,7 @@ -- and memoized, rather than created inline. -- -- > _nee :: Traversal' Text Text - -- > _nee = _match "(?i)\\bnee\\b" + -- > _nee = _matchOpt (Caseless <> MatchWord) "nee" -- -- In addition to getting results, they support global substitution through -- setting; more generally, they can accrete effects while performing 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 @@ -4,7 +4,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} module Text.Regex.Pcre2.Internal where @@ -1208,47 +1207,6 @@ _matchOpt option patt = _gcaptures (pureUserMatcher option patt) get0thSlice . _Identity --- * Support for Template Haskell compile-time regex analysis - --- | From options and pattern, determine parenthesized captures\' names in --- order. -predictCaptureNames :: Option -> Text -> IO [Maybe Text] -predictCaptureNames option patt = do - code <- evalStateT - (extractCompileEnv >>= extractCode patt) - (applyOption option) - - withForeignPtr code getCaptureNames - --- | Get parenthesized captures\' names in order. -getCaptureNames :: Ptr Pcre2_code -> IO [Maybe Text] -getCaptureNames codePtr = do - nameCount <- getCodeInfo @CUInt codePtr pcre2_INFO_NAMECOUNT - nameEntrySize <- getCodeInfo @CUInt codePtr pcre2_INFO_NAMEENTRYSIZE - nameTable <- getCodeInfo @PCRE2_SPTR codePtr pcre2_INFO_NAMETABLE - - -- Can't do [0 .. nameCount - 1] because it underflows when nameCount == 0 - let indexes = takeWhile (< nameCount) [0 ..] - names <- fmap IM.fromList $ forM indexes $ \i -> do - let entryPtr = nameTable `advancePtr` fromIntegral (i * nameEntrySize) - groupNamePtr = entryPtr `advancePtr` 1 - groupNumber <- peek entryPtr - groupNameLen <- lengthArray0 0 groupNamePtr - groupName <- Text.fromPtr - (fromCUs groupNamePtr) - (fromIntegral groupNameLen) - return (fromIntegral groupNumber, groupName) - - hiCaptNum <- getCodeInfo @CUInt codePtr pcre2_INFO_CAPTURECOUNT - - 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 -getCodeInfo codePtr what = alloca $ \wherePtr -> do - pcre2_pattern_info codePtr what wherePtr >>= check (== 0) - peek wherePtr - -- * Exceptions -- | The root of the PCRE2 exception hierarchy. @@ -1273,7 +1231,7 @@ instance Show Pcre2CompileException where show (Pcre2CompileException x patt offset) = "pcre2_compile: " ++ Text.unpack (getErrorMessage x) ++ "\n" ++ - concatMap (replicate tab ' ' ++) pattLinesMaybeWithCaret + concatMap (replicate tab ' ' ++) pattLinesMaybeWithCaret where tab = 20 pattLinesMaybeWithCaret @@ -1281,7 +1239,7 @@ | otherwise = insertCaretLine numberedPattLines offset' = fromIntegral offset pattLines = unchompedLines $ Text.unpack patt - numberedPattLines = zip [0 ..] pattLines + numberedPattLines = zip [0 :: Int ..] pattLines (caretRow, caretCol) = (!! offset') $ do (row, line) <- numberedPattLines (col, _) <- zip [0 ..] line @@ -1327,7 +1285,7 @@ pcre2_config what ptr Just <$> Text.fromPtr ptr (fromIntegral len - 1) --- | See `Bsr`. +-- | See t`Bsr`. defaultBsr :: Bsr defaultBsr = bsrFromC $ getConfigNumeric pcre2_CONFIG_BSR @@ -1363,7 +1321,7 @@ defaultMatchLimit :: Int defaultMatchLimit = fromIntegral $ getConfigNumeric pcre2_CONFIG_MATCHLIMIT --- | See `Newline`. +-- | See t`Newline`. defaultNewline :: Newline defaultNewline = newlineFromC $ getConfigNumeric pcre2_CONFIG_NEWLINE 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 @@ -12,24 +12,30 @@ module Text.Regex.Pcre2.TH where +import Control.Monad.State.Strict (evalStateT, forM) import Control.Applicative (Alternative(..)) import Data.IORef +import qualified Data.IntMap.Strict as IM import Data.List.NonEmpty (NonEmpty(..)) import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import Data.Proxy (Proxy(..)) import Data.Text (Text) import qualified Data.Text as Text -import Data.Type.Bool (type (||), If) +import qualified Data.Text.Foreign as Text +import Data.Type.Bool (If) import Data.Type.Equality (type (==)) +import Foreign +import Foreign.C (CUInt) import GHC.TypeLits hiding (Text) import qualified GHC.TypeLits as TypeLits import Language.Haskell.TH import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Syntax (liftData) import Lens.Micro import Lens.Micro.Extras (view) import System.IO.Unsafe (unsafePerformIO) +import Text.Regex.Pcre2.Foreign import Text.Regex.Pcre2.Internal -- | A wrapper around a list of captures that carries additional type-level @@ -41,11 +47,9 @@ -- `CapturesInfo` is not part of the public API and may change without warning. -- -- After obtaining `Captures` it\'s recommended to immediately consume them and --- transform them into application-level data, to avoid leaking the types to top --- level and having to write signatures. In times of need, \"@Captures _@\" may --- be written with the help of @{-\# LANGUAGE PartialTypeSignatures \#-}@. +-- transform them into application-level data, to avoid leaking the types. newtype Captures (info :: CapturesInfo) = Captures (NonEmpty Text) - deriving (Show) + deriving (Show {- ^ @since 2.0.4 -}) -- | The kind of `Captures`\'s @info@. The first number is the total number of -- parenthesized captures, and the list is a lookup table from capture names to @@ -61,12 +65,11 @@ -- | 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 (num :: Nat) '(hi, _) = - If (CmpNat num 0 == 'LT || CmpNat num hi == 'GT) - -- then - (TypeError (TypeLits.Text "No capture numbered " :<>: ShowType num)) - -- else - num + CaptNum (num :: Nat) '(hi, _) = If (num `CmpNat` hi == 'GT) + -- then + (TypeError (TypeLits.Text "No capture numbered " :<>: ShowType num)) + -- else + num CaptNum (name :: Symbol) '(_, '(name, num) ': _) = num CaptNum (name :: Symbol) '(hi, _ ': kvs) = CaptNum name '(hi, kvs) @@ -117,7 +120,46 @@ let matcher = pureUserMatcher mempty patt in (Map.insert patt matcher cache, matcher) --- | Predict parenthesized captures \(maybe named\) of a pattern at splice time. +-- | From options and pattern, determine parenthesized captures\' names in +-- order. +predictCaptureNames :: Option -> Text -> IO [Maybe Text] +predictCaptureNames option patt = do + code <- evalStateT + (extractCompileEnv >>= extractCode patt) + (applyOption option) + + withForeignPtr code getCaptureNames + +-- | Get parenthesized captures\' names in order. +getCaptureNames :: Ptr Pcre2_code -> IO [Maybe Text] +getCaptureNames codePtr = do + nameCount <- getCodeInfo @CUInt codePtr pcre2_INFO_NAMECOUNT + nameEntrySize <- getCodeInfo @CUInt codePtr pcre2_INFO_NAMEENTRYSIZE + nameTable <- getCodeInfo @PCRE2_SPTR codePtr pcre2_INFO_NAMETABLE + + -- Can't do [0 .. nameCount - 1] because it underflows when nameCount == 0 + let indexes = takeWhile (< nameCount) [0 ..] + names <- fmap IM.fromList $ forM indexes $ \i -> do + let entryPtr = nameTable `advancePtr` fromIntegral (i * nameEntrySize) + groupNamePtr = entryPtr `advancePtr` 1 + groupNumber <- peek entryPtr + groupNameLen <- lengthArray0 0 groupNamePtr + groupName <- Text.fromPtr + (fromCUs groupNamePtr) + (fromIntegral groupNameLen) + return (fromIntegral groupNumber, groupName) + + hiCaptNum <- getCodeInfo @CUInt codePtr pcre2_INFO_CAPTURECOUNT + + 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 +getCodeInfo codePtr what = alloca $ \wherePtr -> do + pcre2_pattern_info codePtr what wherePtr >>= check (== 0) + peek wherePtr + +-- | Predict parenthesized captures (maybe named) of a pattern at splice time. predictCaptureNamesQ :: String -> Q [Maybe Text] predictCaptureNamesQ = runIO . predictCaptureNames mempty . Text.pack @@ -188,7 +230,7 @@ -- -- if there are none. In other words, if there is more than the 0th capture, -- this behaves like `captures` (except returning an opaque `Captures` instead --- of a `NonEmpty` list), otherwise it behaves like `match`. +-- of a `NonEmpty` list), otherwise it behaves like `Text.Regex.Pcre2.match`. -- -- To retrieve an individual capture from a `Captures`, use `capture`. -- diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,20 +9,18 @@ import Control.Applicative (Alternative) import Control.Exception (catch, evaluate, handle) import Control.Monad.RWS.Lazy (ask, evalRWS, forM_, tell, void) -import Data.IORef +import Data.IORef (modifyIORef', newIORef, readIORef) import Data.List.NonEmpty (NonEmpty(..)) -import Data.Proxy (Proxy(..)) 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 - let submitted = "submitted 2020-10-20" - describe "partial application" $ do it "only causes one compilation" $ do onlyCausesOneCompilation $ \option -> @@ -48,29 +46,35 @@ it "is lazy" $ do counter <- newIORef (0 :: Int) let callout = UnsafeCallout $ \_ -> do - modifyIORef counter (+ 1) + 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"] + describe "lens-powered matching" $ do let _nee :: Traversal' Text Text - _nee = _match "(?i)\\bnee\\b" + _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" - Proxy + () 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") - Proxy + () result `shouldBe` ("Shhhhh", []) it "does not substitute when setting equal Text" $ do @@ -101,7 +105,7 @@ it "includes callouts" $ do calloutRanRef <- newIORef 0 let callout = UnsafeCallout $ \_ -> do - modifyIORef calloutRanRef (+ 1) + modifyIORef' calloutRanRef (+ 1) return CalloutProceed matchOpt callout "(?C'foo')a(?C42)a" "aa" `shouldBe` Just "aa" readIORef calloutRanRef `shouldReturn` 2 @@ -109,7 +113,7 @@ it "includes substitution callouts" $ do subCalloutRanRef <- newIORef 0 let subCallout = UnsafeSubCallout $ \_ -> do - modifyIORef subCalloutRanRef (+ 1) + modifyIORef' subCalloutRanRef (+ 1) return SubCalloutAccept subOpt (subCallout <> SubGlobal) "a" "b" "aa" `shouldBe` "bb" readIORef subCalloutRanRef `shouldReturn` 2 @@ -166,6 +170,11 @@ 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)|(?b)|] + f "a" `shouldReturn` "" + f "b" `shouldReturn` "b" + it "works without named captures" $ do case "abc" of [regex|a(b)c|] -> return () @@ -211,30 +220,19 @@ it "converges in the presence of empty matches" $ do length (match @[] "" "12345") `shouldBe` 6 - describe "bug fixes" bugFixes - -bugFixes :: Spec -bugFixes = do - issue 4 $ do - let f = fmap (capture @"b") . [regex|(?a)|(?b)|] - f "a" `shouldReturn` "" - f "b" `shouldReturn` "b" - - issue 18 $ do - let result :: (Alternative f) => f Text - result = match "\\d+" "123 456" - result `shouldBe` Just "123" - result `shouldBe` ["123", "456"] + describe "PCRE2 build configuration" $ do + it ("includes Unicode support" `issue` 21) $ do + matchesOpt Ucp "\\w" "aleph: \x2135" `shouldBe` True - where - issue :: Int -> Expectation -> Spec - issue n = it $ "https://github.com/sjshuck/hs-pcre2/issues/" ++ show n +-- | 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) + modifyIORef' counter (+ 1) return True run = void . evaluate . regexWithOpt option getCount = readIORef counter @@ -251,10 +249,13 @@ anyPcre2Exception :: Selector SomePcre2Exception anyPcre2Exception _ = True +submitted :: Text +submitted = "submitted 2020-10-20" + broken :: (Alternative f) => Text -> f Text broken = match "*" --- microlens doesn't have this yet as of 06/26/2021 +-- | @microlens@ doesn\'t have this yet as of 01/18/2022 _Show :: (Read a, Show a) => Traversal' String a _Show f s = case reads s of [(x, "")] -> show <$> f x