{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

module Text.Regex.Pcre2.Internal where

import           Control.Applicative        (Alternative(..))
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Either                (partitionEithers)
import           Data.Foldable              (foldl', toList)
import           Data.Function              (fix)
import           Data.Functor.Identity      (Identity(..))
import           Data.IORef
import           Data.IntMap.Strict         (IntMap)
import qualified Data.IntMap.Strict         as IM
import           Data.List.NonEmpty         (NonEmpty(..))
import           Data.Maybe                 (fromMaybe)
import           Data.Monoid                (Alt(..), First)
import           Data.Proxy                 (Proxy(..))
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import qualified Data.Text.Foreign          as Text
import           Data.Typeable              (cast)
import           Data.Void                  (Void, absurd)
import           Foreign
import           Foreign.C.Types            (CInt(..), CUInt(..), CUChar)
import qualified Foreign.Concurrent         as Conc
import           Lens.Micro
import           Lens.Micro.Extras          (preview, view)
import           System.IO.Unsafe           (unsafePerformIO)
import           Text.Regex.Pcre2.Foreign

-- * General utilities

type FfiWrapper f = f -> IO (FunPtr f)

-- | There is no @nullForeignPtr@ to pass to `withForeignPtr`, so we have to
-- fake it with a `Maybe`.
withForeignOrNullPtr :: Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr :: Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr = ((Ptr a -> IO b) -> IO b)
-> (ForeignPtr a -> (Ptr a -> IO b) -> IO b)
-> Maybe (ForeignPtr a)
-> (Ptr a -> IO b)
-> IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Ptr a -> IO b) -> Ptr a -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr a
forall a. Ptr a
nullPtr) ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr

-- | Helper so we never leak untracked 'Ptr's.
mkForeignPtr :: (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr :: (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr a -> IO ()
finalize IO (Ptr a)
create = IO (Ptr a)
create IO (Ptr a) -> (Ptr a -> IO (ForeignPtr a)) -> IO (ForeignPtr a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr a -> IO () -> IO (ForeignPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Conc.newForeignPtr (Ptr a -> IO () -> IO (ForeignPtr a))
-> (Ptr a -> IO ()) -> Ptr a -> IO (ForeignPtr a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr a -> IO ()
finalize

-- | Helper so we never leak untracked 'FunPtr's.
mkFunPtr :: ForeignPtr b -> IO (FunPtr a) -> IO (FunPtr a)
mkFunPtr :: ForeignPtr b -> IO (FunPtr a) -> IO (FunPtr a)
mkFunPtr ForeignPtr b
anchor IO (FunPtr a)
create = do
    FunPtr a
funPtr <- IO (FunPtr a)
create
    ForeignPtr b -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
Conc.addForeignPtrFinalizer ForeignPtr b
anchor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
funPtr
    FunPtr a -> IO (FunPtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr a
funPtr

bitOr :: (Foldable t, Bits a) => t a -> a
bitOr :: t a -> a
bitOr = (a -> a -> a) -> a -> t a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) a
forall a. Bits a => a
zeroBits

-- | Like `lines`, but don't remove any characters.
unchompedLines :: String -> [String]
unchompedLines :: String -> [String]
unchompedLines String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
s of
    (String
line,     Char
_ : String
rest) -> (String
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
unchompedLines String
rest
    (String
lastLine, String
"")       -> [String
lastLine | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lastLine]

-- | Equivalent to @flip fix@.
--
-- Used to express a recursive function of one argument that is called only once
-- on an initial value:
--
-- > let go x = ... in go x0
--
-- as:
--
-- > fix1 x0 $ \go x -> ...
fix1 :: a -> ((a -> b) -> a -> b) -> b
fix1 :: a -> ((a -> b) -> a -> b) -> b
fix1 a
x (a -> b) -> a -> b
f = ((a -> b) -> a -> b) -> a -> b
forall a. (a -> a) -> a
fix (a -> b) -> a -> b
f a
x

-- | Like `fix1`, but for a function of two arguments.  Currently unused.
fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c
fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c
fix2 a
x b
y (a -> b -> c) -> a -> b -> c
f = ((a -> b -> c) -> a -> b -> c) -> a -> b -> c
forall a. (a -> a) -> a
fix (a -> b -> c) -> a -> b -> c
f a
x b
y

-- | Like `fix1`, but for a function of three arguments.  Currently unused.
fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d
fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d
fix3 a
x b
y c
z (a -> b -> c -> d) -> a -> b -> c -> d
f = ((a -> b -> c -> d) -> a -> b -> c -> d) -> a -> b -> c -> d
forall a. (a -> a) -> a
fix (a -> b -> c -> d) -> a -> b -> c -> d
f a
x b
y c
z

-- ** Fast @Text@ slicing

data Slice = Slice
    {-# UNPACK #-} !Text.I8
    {-# UNPACK #-} !Text.I8

-- | Zero-copy slice a 'Text'.  An unset capture is represented by a
-- `pcre2_UNSET` range and is interpreted in this library as `Text.empty`.
thinSlice :: Text -> Slice -> Text
thinSlice :: Text -> Slice -> Text
thinSlice Text
text Slice
slice = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
Text.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Slice -> Maybe Text
maybeThinSlice Text
text Slice
slice

-- | Like `thinSlice`, but encode `pcre2_UNSET` as `Nothing`.
maybeThinSlice :: Text -> Slice -> Maybe Text
maybeThinSlice :: Text -> Slice -> Maybe Text
maybeThinSlice Text
text (Slice I8
off I8
offEnd)
    | I8
off I8 -> I8 -> Bool
forall a. Eq a => a -> a -> Bool
== PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
pcre2_UNSET = Maybe Text
forall a. Maybe a
Nothing
    | Bool
otherwise                       = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
text
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& I8 -> Text -> Text
Text.takeWord8 I8
offEnd
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& I8 -> Text -> Text
Text.dropWord8 I8
off

-- | Slice a 'Text', copying if it's less than half of the original.  Note this
-- is a lazy, pure operation.
smartSlice :: Text -> Slice -> Text
smartSlice :: Text -> Slice -> Text
smartSlice Text
text Slice
slice = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
Text.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Slice -> Maybe Text
maybeSmartSlice Text
text Slice
slice

-- | Like `smartSlice`, but only produce a result when not `pcre2_UNSET`.  It is
-- forced when the outer `Maybe` constructor is forced.
maybeSmartSlice :: Text -> Slice -> Maybe Text
maybeSmartSlice :: Text -> Slice -> Maybe Text
maybeSmartSlice Text
text Slice
slice = Text -> Text
f (Text -> Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Text -> Slice -> Maybe Text
maybeThinSlice Text
text Slice
slice where
    f :: Text -> Text
f Text
substring
        | Text -> Int
Text.length Text
substring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
Text.length Text
text Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 = Text
substring
        | Bool
otherwise                                        = Text -> Text
Text.copy Text
substring

-- | Safe, type-restricted `castPtr`.
fromCUs :: Ptr CUChar -> Ptr Word8
fromCUs :: Ptr CUChar -> Ptr Word8
fromCUs = Ptr CUChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr

-- | Safe, type-restricted `castPtr`.
toCUs :: Ptr Word8 -> Ptr CUChar
toCUs :: Ptr Word8 -> Ptr CUChar
toCUs = Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr

-- ** Lens utilities

-- | A more general `toListOf` that collects targets into any `Alternative`.
toAlternativeOf :: (Alternative f) => Getting (Alt f a) s a -> s -> f a
toAlternativeOf :: Getting (Alt f a) s a -> s -> f a
toAlternativeOf Getting (Alt f a) s a
l = let alt :: a -> Alt f a
alt = f a -> Alt f a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> Alt f a) -> (a -> f a) -> a -> Alt f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure in Alt f a -> f a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f a -> f a) -> (s -> Alt f a) -> s -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Alt f a) s (Alt f a) -> s -> Alt f a
forall a s. Getting a s a -> s -> a
view (Getting (Alt f a) s a
l Getting (Alt f a) s a
-> ((Alt f a -> Const (Alt f a) (Alt f a))
    -> a -> Const (Alt f a) a)
-> Getting (Alt f a) s (Alt f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Alt f a) -> SimpleGetter a (Alt f a)
forall s a. (s -> a) -> SimpleGetter s a
to a -> Alt f a
forall a. a -> Alt f a
alt)

_Identity :: Lens' (Identity a) a
_Identity :: (a -> f a) -> Identity a -> f (Identity a)
_Identity a -> f a
f (Identity a
x) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> f a -> f (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x

-- ** Streaming support

-- | A @FreeT@-style stream that can short-circuit.
data Stream b m a
    = StreamPure a
    | 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.
    deriving (a -> Stream b m b -> Stream b m a
(a -> b) -> Stream b m a -> Stream b m b
(forall a b. (a -> b) -> Stream b m a -> Stream b m b)
-> (forall a b. a -> Stream b m b -> Stream b m a)
-> Functor (Stream b m)
forall a b. a -> Stream b m b -> Stream b m a
forall a b. (a -> b) -> Stream b m a -> Stream b m b
forall b (m :: * -> *) a b.
Functor m =>
a -> Stream b m b -> Stream b m a
forall b (m :: * -> *) a b.
Functor m =>
(a -> b) -> Stream b m a -> Stream b m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stream b m b -> Stream b m a
$c<$ :: forall b (m :: * -> *) a b.
Functor m =>
a -> Stream b m b -> Stream b m a
fmap :: (a -> b) -> Stream b m a -> Stream b m b
$cfmap :: forall b (m :: * -> *) a b.
Functor m =>
(a -> b) -> Stream b m a -> Stream b m b
Functor)

instance (Functor m) => Applicative (Stream b m) where
    pure :: a -> Stream b m a
pure = a -> Stream b m a
forall b (m :: * -> *) a. a -> Stream b m a
StreamPure
    StreamPure a -> b
f     <*> :: Stream b m (a -> b) -> Stream b m a -> Stream b m b
<*> Stream b m a
sx = a -> b
f (a -> b) -> Stream b m a -> Stream b m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream b m a
sx
    StreamYield b
y Stream b m (a -> b)
sf <*> Stream b m a
sx = b -> Stream b m b -> Stream b m b
forall b (m :: * -> *) a. b -> Stream b m a -> Stream b m a
StreamYield b
y (Stream b m b -> Stream b m b) -> Stream b m b -> Stream b m b
forall a b. (a -> b) -> a -> b
$ Stream b m (a -> b)
sf Stream b m (a -> b) -> Stream b m a -> Stream b m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream b m a
sx
    StreamEffect m (Stream b m (a -> b))
msf <*> Stream b m a
sx = m (Stream b m b) -> Stream b m b
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (m (Stream b m b) -> Stream b m b)
-> m (Stream b m b) -> Stream b m b
forall a b. (a -> b) -> a -> b
$ m (Stream b m (a -> b))
msf m (Stream b m (a -> b))
-> (Stream b m (a -> b) -> Stream b m b) -> m (Stream b m b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Stream b m (a -> b) -> Stream b m a -> Stream b m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream b m a
sx)
    Stream b m (a -> b)
StreamStop       <*> Stream b m a
_  = Stream b m b
forall b (m :: * -> *) a. Stream b m a
StreamStop

instance (Functor m) => Monad (Stream b m) where
    StreamPure a
x     >>= :: Stream b m a -> (a -> Stream b m b) -> Stream b m b
>>= a -> Stream b m b
f = a -> Stream b m b
f a
x
    StreamYield b
y Stream b m a
sx >>= a -> Stream b m b
f = b -> Stream b m b -> Stream b m b
forall b (m :: * -> *) a. b -> Stream b m a -> Stream b m a
StreamYield b
y (Stream b m b -> Stream b m b) -> Stream b m b -> Stream b m b
forall a b. (a -> b) -> a -> b
$ Stream b m a
sx Stream b m a -> (a -> Stream b m b) -> Stream b m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Stream b m b
f
    StreamEffect m (Stream b m a)
msx >>= a -> Stream b m b
f = m (Stream b m b) -> Stream b m b
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (m (Stream b m b) -> Stream b m b)
-> m (Stream b m b) -> Stream b m b
forall a b. (a -> b) -> a -> b
$ m (Stream b m a)
msx m (Stream b m a)
-> (Stream b m a -> Stream b m b) -> m (Stream b m b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Stream b m a -> (a -> Stream b m b) -> Stream b m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Stream b m b
f)
    Stream b m a
StreamStop       >>= a -> Stream b m b
_ = Stream b m b
forall b (m :: * -> *) a. Stream b m a
StreamStop

instance MonadTrans (Stream b) where
    lift :: m a -> Stream b m a
lift = m (Stream b m a) -> Stream b m a
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (m (Stream b m a) -> Stream b m a)
-> (m a -> m (Stream b m a)) -> m a -> Stream b m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Stream b m a) -> m a -> m (Stream b m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Stream b m a
forall b (m :: * -> *) a. a -> Stream b m a
StreamPure

instance (MonadIO m) => MonadIO (Stream b m) where
    liftIO :: IO a -> Stream b m a
liftIO = m a -> Stream b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Stream b m a) -> (IO a -> m a) -> IO a -> Stream b m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

streamYield :: b -> Stream b m ()
streamYield :: b -> Stream b m ()
streamYield b
y = b -> Stream b m () -> Stream b m ()
forall b (m :: * -> *) a. b -> Stream b m a -> Stream b m a
StreamYield b
y (Stream b m () -> Stream b m ()) -> Stream b m () -> Stream b m ()
forall a b. (a -> b) -> a -> b
$ () -> Stream b m ()
forall b (m :: * -> *) a. a -> Stream b m a
StreamPure ()

-- | Effectfully transform yielded values.
mapMS :: (Functor m) => (b -> m c) -> Stream b m a -> Stream c m a
mapMS :: (b -> m c) -> Stream b m a -> Stream c m a
mapMS b -> m c
f = ((Stream b m a -> Stream c m a) -> Stream b m a -> Stream c m a)
-> Stream b m a -> Stream c m a
forall a. (a -> a) -> a
fix (((Stream b m a -> Stream c m a) -> Stream b m a -> Stream c m a)
 -> Stream b m a -> Stream c m a)
-> ((Stream b m a -> Stream c m a) -> Stream b m a -> Stream c m a)
-> Stream b m a
-> Stream c m a
forall a b. (a -> b) -> a -> b
$ \Stream b m a -> Stream c m a
go -> \case
    StreamPure a
x     -> a -> Stream c m a
forall b (m :: * -> *) a. a -> Stream b m a
StreamPure a
x
    StreamYield b
y Stream b m a
sx -> m (Stream c m a) -> Stream c m a
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (m (Stream c m a) -> Stream c m a)
-> m (Stream c m a) -> Stream c m a
forall a b. (a -> b) -> a -> b
$ b -> m c
f b
y m c -> (c -> Stream c m a) -> m (Stream c m a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \c
y' -> c -> Stream c m a -> Stream c m a
forall b (m :: * -> *) a. b -> Stream b m a -> Stream b m a
StreamYield c
y' (Stream c m a -> Stream c m a) -> Stream c m a -> Stream c m a
forall a b. (a -> b) -> a -> b
$ Stream b m a -> Stream c m a
go Stream b m a
sx
    StreamEffect m (Stream b m a)
ms  -> m (Stream c m a) -> Stream c m a
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (m (Stream c m a) -> Stream c m a)
-> m (Stream c m a) -> Stream c m a
forall a b. (a -> b) -> a -> b
$ Stream b m a -> Stream c m a
go (Stream b m a -> Stream c m a)
-> m (Stream b m a) -> m (Stream c m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stream b m a)
ms
    Stream b m a
StreamStop       -> Stream c m a
forall b (m :: * -> *) a. Stream b m a
StreamStop

-- | Unsafely, lazily tear down a `Stream` into a pure list of values yielded.
-- The stream must be infinite in the sense of it only terminating due to
-- explicit `StreamStop`.
unsafeLazyStreamToList :: Stream b IO Void -> [b]
unsafeLazyStreamToList :: Stream b IO Void -> [b]
unsafeLazyStreamToList = ((Stream b IO Void -> [b]) -> Stream b IO Void -> [b])
-> Stream b IO Void -> [b]
forall a. (a -> a) -> a
fix (((Stream b IO Void -> [b]) -> Stream b IO Void -> [b])
 -> Stream b IO Void -> [b])
-> ((Stream b IO Void -> [b]) -> Stream b IO Void -> [b])
-> Stream b IO Void
-> [b]
forall a b. (a -> b) -> a -> b
$ \Stream b IO Void -> [b]
continue -> \case
    StreamPure Void
v    -> Void -> [b]
forall a. Void -> a
absurd Void
v
    StreamYield b
y Stream b IO Void
s -> b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Stream b IO Void -> [b]
continue Stream b IO Void
s
    StreamEffect IO (Stream b IO Void)
ms -> Stream b IO Void -> [b]
continue (Stream b IO Void -> [b]) -> Stream b IO Void -> [b]
forall a b. (a -> b) -> a -> b
$ IO (Stream b IO Void) -> Stream b IO Void
forall a. IO a -> a
unsafePerformIO IO (Stream b IO Void)
ms
    Stream b IO Void
StreamStop      -> []

-- * Assembling inputs into @Matcher@s and @Subber@s

-- | A matching function where all inputs and auxilliary data structures have
-- been \"compiled\".  It takes a subject a produces a stream of match results
-- corresponding to a global match.
--
-- The actual values of type @Ptr Pcre2_match_data@ will be equal within each
-- global match; they represent the states of the C data at moments in time, and
-- are intended to be composed with another streaming transformation before
-- being subjected to teardown and `unsafePerformIO`.
type Matcher = Text -> Stream (Ptr Pcre2_match_data) IO Void

-- | A substitution function.  It takes a subject and produces the number of
-- substitutions performed (0 or 1, or more in the presence of `SubGlobal`)
-- along with the transformed subject.  Currently the number is unused.
type Subber = Text -> IO (CInt, Text)

-- ** Options

-- | A `Monoid` representing nearly every facility PCRE2 presents for tweaking
-- the behavior of regex compilation and execution.
--
-- All library functions that take options have the suffix @Opt@ in their names;
-- for each of them, there's also a non-@Opt@ convenience function that simply
-- has the (unexported) `mempty` option.  For many uses, options won't be
-- needed.
--
-- Some options can be enabled by special character sequences in the pattern as
-- an alternative to specifying them as an `Option`.  See `Caseless` for
-- example.
--
-- Most options are exported in "Text.Regex.Pcre2".  The callout interface is
-- found in "Text.Regex.Pcre2.Unsafe".
--
-- Documentation is scant here.  For more complete, accurate information,
-- including discussions of corner cases arising from specific combinations of
-- options and pattern items, please see the [C API
-- documentation](https://pcre.org/current/doc/html/pcre2api.html).
data Option
    = NoOptions -- ^ `mempty`
    | TwoOptions Option Option -- ^ `<>`

    | AllowEmptyClass -- ^ Make @[]@ not match anything, rather than counting
    -- the @]@ as the first character of the class.
    | AltBsux -- ^ Like `AltBsuxLegacy`, except with ECMAScript 6 hex literal
    -- feature for @\\u@.
    | AltBsuxLegacy -- ^ Behave like ECMAScript 5 for @\\U@, @\\u@, and @\\x@.
    -- See 'AltBsux'.
    | AltCircumflex -- ^ Match a @^@ after a newline at the end of the subject.
    -- Only relevant in multiline mode.
    | AltVerbNames -- ^ Enable backslash escapes in verb names.  E.g.,
    -- @(*MARK:L\\(O\\)L)@.
    | 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`).
    | Caseless -- ^ Case-insensitive match.  Equivalent to @(?i)@.
    | DepthLimit Word32 -- ^ Override maximum depth of nested backtracking
    -- (default given by `defaultDepthLimit`).  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
    -- to @(?s)@.
    | EndAnchored -- ^ More or less like ending pattern with @$@.
    | EscapedCrIsLf -- ^ Interpret @\\r@ as @\\n@.
    | Extended -- ^ In the pattern, ignore whitespace, and enable comments
    -- starting with @#@.  Equivalent to @(?x)@.
    | ExtendedMore -- ^ Like `Extended` but also ignore spaces and tabs within
    -- @[]@.
    | 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`).
    -- 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/@)@.
    | MatchLine -- ^ Only match complete lines.  Equivalent to bracketing the
    -- pattern with @^(?:@/pattern/@)$@.
    | MatchUnsetBackRef -- ^ A backreference to an unset capture group matches
    -- an empty string.
    | MatchWord -- ^ Only match subjects that have word boundaries at the
    -- beginning and end.  Equivalent to bracketing the pattern with
    -- @\\b(?:@/pattern/@)\\b@.
    | MaxPatternLength Word64 -- ^ Default is `maxBound`.
    | Multiline -- ^ @^@ and @$@ mean "beginning\/end of a line" rather than
    -- "beginning\/end of the subject".  Equivalent to @(?m)@.
    | 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.
    | NoAutoCapture -- ^ Disable numbered capturing parentheses.
    | NoAutoPossess -- ^ Turn off some optimizations, possibly resulting in some
    -- callouts not being called.
    | NoDotStarAnchor -- ^ Turn off an optimization involving @.*@, possibly
    -- resulting in some callouts not being called.
    | NoStartOptimize -- ^ Turn off some optimizations normally performed at the
    -- beginning of a pattern.
    | NotBol -- ^ First character of subject is not the __b__eginning __o__f
    -- __l__ine.  Only affects @^@.
    | NotEmpty -- ^ The 0th capture doesn't match if it would be empty.
    | NotEmptyAtStart -- ^ The 0th capture doesn't match if it would be empty
    -- and at the beginning of the subject.
    | NotEol -- ^ End of subject is not the __e__nd __o__f __l__ine.  Only
    -- affects @$@.
    | 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`).
    | 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
    -- better.
    | PartialSoft -- ^ If the subject ends and all alternatives have been tried,
    -- but no complete match is found, signal a partial match.  Currently we do
    -- this by throwing a `Pcre2Exception` but we should do better.
    | SubGlobal -- ^ /Affects `subOpt`./  Replace all, rather than just the
    -- first.
    | SubLiteral -- ^ /Affects `subOpt`./  Treat the replacement as a literal
    -- string.
    | 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.
    | Ucp -- ^ Count Unicode characters in some character classes such as @\\d@.
    -- Incompatible with `NeverUcp`.
    | Ungreedy -- ^ Invert the effect of @?@.  Without it, quantifiers are
    -- non-greedy; with it, they are greedy.  Equivalent to @(?U)@.

    | UnsafeCompileRecGuard (Int -> IO Bool) -- ^ Run the given guard on every
    -- new descent into a level of parentheses, passing the current depth as
    -- argument.  Returning @False@ aborts pattern compilation with an
    -- exception.  Multiples of this option before the rightmost are ignored.
    --
    -- /NOTE: Currently (PCRE2 version 10\.39) patterns seem to be compiled in/
    -- /two passes, both times triggering the recursion guard.  Also, it is/
    -- /triggered at the beginning of the pattern, passing 0.  None of this is/
    -- /documented; expect the unexpected in the presence of side effects!/
    | UnsafeCallout (CalloutInfo -> IO CalloutResult) -- ^ Run the given callout
    -- at every callout point (see
    -- [the docs](https://pcre.org/current/doc/html/pcre2callout.html) for more
    -- info).  Multiples of this option before the rightmost are ignored.
    | AutoCallout -- ^ Run callout for every pattern item.  Only relevant if a
    -- callout is set.
    | UnsafeSubCallout (SubCalloutInfo -> IO SubCalloutResult) -- ^ Run the
    -- given callout on every substitution.  This is at most once unless
    -- `SubGlobal` is set.  Multiples of this option before the rightmost are
    -- ignored.

instance Semigroup Option where
    <> :: Option -> Option -> Option
(<>) = Option -> Option -> Option
TwoOptions

instance Monoid Option where
    mempty :: Option
mempty = Option
NoOptions

-- | What @\\R@, __b__ack__s__lash __R__, can mean.
data Bsr
    = BsrUnicode -- ^ any Unicode line ending sequence
    | BsrAnyCrlf -- ^ @\\r@, @\\n@, or @\\r\\n@
    deriving (Bsr -> Bsr -> Bool
(Bsr -> Bsr -> Bool) -> (Bsr -> Bsr -> Bool) -> Eq Bsr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bsr -> Bsr -> Bool
$c/= :: Bsr -> Bsr -> Bool
== :: Bsr -> Bsr -> Bool
$c== :: Bsr -> Bsr -> Bool
Eq, Int -> Bsr -> String -> String
[Bsr] -> String -> String
Bsr -> String
(Int -> Bsr -> String -> String)
-> (Bsr -> String) -> ([Bsr] -> String -> String) -> Show Bsr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Bsr] -> String -> String
$cshowList :: [Bsr] -> String -> String
show :: Bsr -> String
$cshow :: Bsr -> String
showsPrec :: Int -> Bsr -> String -> String
$cshowsPrec :: Int -> Bsr -> String -> String
Show)

-- | C to Haskell.
bsrFromC :: CUInt -> Bsr
bsrFromC :: CUInt -> Bsr
bsrFromC CUInt
x
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_BSR_UNICODE = Bsr
BsrUnicode
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_BSR_ANYCRLF = Bsr
BsrAnyCrlf
    | Bool
otherwise              = String -> Bsr
forall a. HasCallStack => String -> a
error (String -> Bsr) -> String -> Bsr
forall a b. (a -> b) -> a -> b
$ String
"bsrFromC: bad value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CUInt -> String
forall a. Show a => a -> String
show CUInt
x

-- | Haskell to C.
bsrToC :: Bsr -> CUInt
bsrToC :: Bsr -> CUInt
bsrToC Bsr
BsrUnicode = CUInt
pcre2_BSR_UNICODE
bsrToC Bsr
BsrAnyCrlf = CUInt
pcre2_BSR_ANYCRLF

-- | What's considered a newline.
data Newline
    = NewlineCr      -- ^ @\\r@ only
    | NewlineLf      -- ^ @\\n@ only
    | NewlineCrlf    -- ^ @\\r\\n@ only
    | NewlineAny     -- ^ any Unicode line ending sequence
    | NewlineAnyCrlf -- ^ any of the above
    | NewlineNul     -- ^ binary zero
    deriving (Newline -> Newline -> Bool
(Newline -> Newline -> Bool)
-> (Newline -> Newline -> Bool) -> Eq Newline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Newline -> Newline -> Bool
$c/= :: Newline -> Newline -> Bool
== :: Newline -> Newline -> Bool
$c== :: Newline -> Newline -> Bool
Eq, Int -> Newline -> String -> String
[Newline] -> String -> String
Newline -> String
(Int -> Newline -> String -> String)
-> (Newline -> String)
-> ([Newline] -> String -> String)
-> Show Newline
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Newline] -> String -> String
$cshowList :: [Newline] -> String -> String
show :: Newline -> String
$cshow :: Newline -> String
showsPrec :: Int -> Newline -> String -> String
$cshowsPrec :: Int -> Newline -> String -> String
Show)

-- | C to Haskell.
newlineFromC :: CUInt -> Newline
newlineFromC :: CUInt -> Newline
newlineFromC CUInt
x
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_CR      = Newline
NewlineCr
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_LF      = Newline
NewlineLf
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_CRLF    = Newline
NewlineCrlf
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_ANY     = Newline
NewlineAny
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_ANYCRLF = Newline
NewlineAnyCrlf
    | CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
pcre2_NEWLINE_NUL     = Newline
NewlineNul
    | Bool
otherwise                  = String -> Newline
forall a. HasCallStack => String -> a
error (String -> Newline) -> String -> Newline
forall a b. (a -> b) -> a -> b
$ String
"newlineFromC: bad value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CUInt -> String
forall a. Show a => a -> String
show CUInt
x

-- | Haskell to C.
newlineToC :: Newline -> CUInt
newlineToC :: Newline -> CUInt
newlineToC Newline
NewlineCr      = CUInt
pcre2_NEWLINE_CR
newlineToC Newline
NewlineLf      = CUInt
pcre2_NEWLINE_LF
newlineToC Newline
NewlineCrlf    = CUInt
pcre2_NEWLINE_CRLF
newlineToC Newline
NewlineAny     = CUInt
pcre2_NEWLINE_ANY
newlineToC Newline
NewlineAnyCrlf = CUInt
pcre2_NEWLINE_ANYCRLF
newlineToC Newline
NewlineNul     = CUInt
pcre2_NEWLINE_NUL

-- | Input for user-defined callouts.
data CalloutInfo
    = CalloutInfo{
        -- | The index of which callout point we're on.
        CalloutInfo -> CalloutIndex
calloutIndex :: CalloutIndex,
        -- | The captures that have been set so far.
        CalloutInfo -> NonEmpty (Maybe Text)
calloutCaptures :: NonEmpty (Maybe Text),
        -- | The original subject.
        CalloutInfo -> Text
calloutSubject :: Text,
        -- | The name of the most recently passed @(*MARK)@, @(*PRUNE)@, or
        -- @(*THEN)@, if any.
        CalloutInfo -> Maybe Text
calloutMark :: Maybe Text,
        -- | Is this the first callout after the start of matching?
        CalloutInfo -> Bool
calloutIsFirst :: Bool,
        -- | Has a backtrack occurred since the previous callout, or the
        -- beginning of matching if no previous callouts?
        CalloutInfo -> Bool
calloutBacktracked :: Bool}
    deriving (Int -> CalloutInfo -> String -> String
[CalloutInfo] -> String -> String
CalloutInfo -> String
(Int -> CalloutInfo -> String -> String)
-> (CalloutInfo -> String)
-> ([CalloutInfo] -> String -> String)
-> Show CalloutInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CalloutInfo] -> String -> String
$cshowList :: [CalloutInfo] -> String -> String
show :: CalloutInfo -> String
$cshow :: CalloutInfo -> String
showsPrec :: Int -> CalloutInfo -> String -> String
$cshowsPrec :: Int -> CalloutInfo -> String -> String
Show, CalloutInfo -> CalloutInfo -> Bool
(CalloutInfo -> CalloutInfo -> Bool)
-> (CalloutInfo -> CalloutInfo -> Bool) -> Eq CalloutInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalloutInfo -> CalloutInfo -> Bool
$c/= :: CalloutInfo -> CalloutInfo -> Bool
== :: CalloutInfo -> CalloutInfo -> Bool
$c== :: CalloutInfo -> CalloutInfo -> Bool
Eq)

-- | What caused the callout.
data CalloutIndex
    = CalloutNumber Int -- ^ Numerical callout.
    | CalloutName Text -- ^ String callout.
    | CalloutAuto Int Int -- ^ The item located at this half-open range of
    -- offsets within the pattern.  See `AutoCallout`.
    deriving (Int -> CalloutIndex -> String -> String
[CalloutIndex] -> String -> String
CalloutIndex -> String
(Int -> CalloutIndex -> String -> String)
-> (CalloutIndex -> String)
-> ([CalloutIndex] -> String -> String)
-> Show CalloutIndex
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CalloutIndex] -> String -> String
$cshowList :: [CalloutIndex] -> String -> String
show :: CalloutIndex -> String
$cshow :: CalloutIndex -> String
showsPrec :: Int -> CalloutIndex -> String -> String
$cshowsPrec :: Int -> CalloutIndex -> String -> String
Show, CalloutIndex -> CalloutIndex -> Bool
(CalloutIndex -> CalloutIndex -> Bool)
-> (CalloutIndex -> CalloutIndex -> Bool) -> Eq CalloutIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalloutIndex -> CalloutIndex -> Bool
$c/= :: CalloutIndex -> CalloutIndex -> Bool
== :: CalloutIndex -> CalloutIndex -> Bool
$c== :: CalloutIndex -> CalloutIndex -> Bool
Eq)

-- | Callout functions return one of these values, which dictates what happens
-- next in the match.
data CalloutResult
    = CalloutProceed -- ^ Keep going.
    | CalloutNoMatchHere -- ^ Fail the current capture, but not the whole match.
    -- For example, backtracking may occur.
    | CalloutNoMatch -- ^ Fail the whole match.
    deriving (Int -> CalloutResult -> String -> String
[CalloutResult] -> String -> String
CalloutResult -> String
(Int -> CalloutResult -> String -> String)
-> (CalloutResult -> String)
-> ([CalloutResult] -> String -> String)
-> Show CalloutResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CalloutResult] -> String -> String
$cshowList :: [CalloutResult] -> String -> String
show :: CalloutResult -> String
$cshow :: CalloutResult -> String
showsPrec :: Int -> CalloutResult -> String -> String
$cshowsPrec :: Int -> CalloutResult -> String -> String
Show, CalloutResult -> CalloutResult -> Bool
(CalloutResult -> CalloutResult -> Bool)
-> (CalloutResult -> CalloutResult -> Bool) -> Eq CalloutResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalloutResult -> CalloutResult -> Bool
$c/= :: CalloutResult -> CalloutResult -> Bool
== :: CalloutResult -> CalloutResult -> Bool
$c== :: CalloutResult -> CalloutResult -> Bool
Eq)

-- | Input for user-defined substitution callouts.
data SubCalloutInfo
    = SubCalloutInfo{
        -- | The 1-based index of which substitution we're on.  Only goes past 1
        -- during global substitutions.
        SubCalloutInfo -> Int
subCalloutSubsCount :: Int,
        -- | The captures that have been set so far.
        SubCalloutInfo -> NonEmpty (Maybe Text)
subCalloutCaptures :: NonEmpty (Maybe Text),
        -- | The original subject.
        SubCalloutInfo -> Text
subCalloutSubject :: Text,
        -- | The replacement.
        SubCalloutInfo -> Text
subCalloutReplacement :: Text}
    deriving (Int -> SubCalloutInfo -> String -> String
[SubCalloutInfo] -> String -> String
SubCalloutInfo -> String
(Int -> SubCalloutInfo -> String -> String)
-> (SubCalloutInfo -> String)
-> ([SubCalloutInfo] -> String -> String)
-> Show SubCalloutInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SubCalloutInfo] -> String -> String
$cshowList :: [SubCalloutInfo] -> String -> String
show :: SubCalloutInfo -> String
$cshow :: SubCalloutInfo -> String
showsPrec :: Int -> SubCalloutInfo -> String -> String
$cshowsPrec :: Int -> SubCalloutInfo -> String -> String
Show, SubCalloutInfo -> SubCalloutInfo -> Bool
(SubCalloutInfo -> SubCalloutInfo -> Bool)
-> (SubCalloutInfo -> SubCalloutInfo -> Bool) -> Eq SubCalloutInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubCalloutInfo -> SubCalloutInfo -> Bool
$c/= :: SubCalloutInfo -> SubCalloutInfo -> Bool
== :: SubCalloutInfo -> SubCalloutInfo -> Bool
$c== :: SubCalloutInfo -> SubCalloutInfo -> Bool
Eq)

-- | Substitution callout functions return one of these values, which dictates
-- what happens next in the substitution.
data SubCalloutResult
    = SubCalloutAccept -- ^ Succeed, and keep going if in global mode.
    | SubCalloutSkip -- ^ Do not perform this substitution, but keep going if in
    -- global mode.
    | SubCalloutAbort -- ^ Do not perform this or any subsequent substitutions.
    deriving (Int -> SubCalloutResult -> String -> String
[SubCalloutResult] -> String -> String
SubCalloutResult -> String
(Int -> SubCalloutResult -> String -> String)
-> (SubCalloutResult -> String)
-> ([SubCalloutResult] -> String -> String)
-> Show SubCalloutResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SubCalloutResult] -> String -> String
$cshowList :: [SubCalloutResult] -> String -> String
show :: SubCalloutResult -> String
$cshow :: SubCalloutResult -> String
showsPrec :: Int -> SubCalloutResult -> String -> String
$cshowsPrec :: Int -> SubCalloutResult -> String -> String
Show, SubCalloutResult -> SubCalloutResult -> Bool
(SubCalloutResult -> SubCalloutResult -> Bool)
-> (SubCalloutResult -> SubCalloutResult -> Bool)
-> Eq SubCalloutResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubCalloutResult -> SubCalloutResult -> Bool
$c/= :: SubCalloutResult -> SubCalloutResult -> Bool
== :: SubCalloutResult -> SubCalloutResult -> Bool
$c== :: SubCalloutResult -> SubCalloutResult -> Bool
Eq)

-- ** Lower-level representation of options and C data

type CompileContext = ForeignPtr Pcre2_compile_context
type Code           = ForeignPtr Pcre2_code
type MatchContext   = ForeignPtr Pcre2_match_context
type MatchData      = ForeignPtr Pcre2_match_data

-- | An `Option` can result in multiple \"plans\".
applyOption :: Option -> [AppliedOption]
applyOption :: Option -> [AppliedOption]
applyOption = \case
    Option
NoOptions            -> []
    TwoOptions Option
opt0 Option
opt1 -> Option -> [AppliedOption]
applyOption Option
opt0 [AppliedOption] -> [AppliedOption] -> [AppliedOption]
forall a. [a] -> [a] -> [a]
++ Option -> [AppliedOption]
applyOption Option
opt1

    -- CompileOption
    Option
AllowEmptyClass   -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ALLOW_EMPTY_CLASS]
    Option
AltBsuxLegacy     -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ALT_BSUX]
    Option
AltCircumflex     -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ALT_CIRCUMFLEX]
    Option
AltVerbNames      -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ALT_VERBNAMES]
    Option
Anchored          -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ANCHORED]
    Option
AutoCallout       -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_AUTO_CALLOUT]
    Option
Caseless          -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_CASELESS]
    Option
DollarEndOnly     -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_DOLLAR_ENDONLY]
    Option
DotAll            -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_DOTALL]
    Option
EndAnchored       -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_ENDANCHORED]
    Option
Extended          -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_EXTENDED]
    Option
ExtendedMore      -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_EXTENDED_MORE]
    Option
FirstLine         -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_FIRSTLINE]
    Option
Literal           -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_LITERAL]
    Option
MatchUnsetBackRef -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_MATCH_UNSET_BACKREF]
    Option
Multiline         -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_MULTILINE]
    Option
NeverBackslashC   -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NEVER_BACKSLASH_C]
    Option
NeverUcp          -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NEVER_UCP]
    Option
NoAutoCapture     -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NO_AUTO_CAPTURE]
    Option
NoAutoPossess     -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NO_AUTO_POSSESS]
    Option
NoDotStarAnchor   -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NO_DOTSTAR_ANCHOR]
    Option
NoStartOptimize   -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_NO_START_OPTIMIZE]
    Option
Ucp               -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_UCP]
    Option
Ungreedy          -> [CUInt -> AppliedOption
CompileOption CUInt
pcre2_UNGREEDY]

    -- CompileExtraOption
    Option
AltBsux            -> [CUInt -> AppliedOption
CompileExtraOption CUInt
pcre2_EXTRA_ALT_BSUX]
    Option
BadEscapeIsLiteral -> [CUInt -> AppliedOption
CompileExtraOption CUInt
pcre2_EXTRA_BAD_ESCAPE_IS_LITERAL]
    Option
EscapedCrIsLf      -> [CUInt -> AppliedOption
CompileExtraOption CUInt
pcre2_EXTRA_ESCAPED_CR_IS_LF]
    Option
MatchLine          -> [CUInt -> AppliedOption
CompileExtraOption CUInt
pcre2_EXTRA_MATCH_LINE]
    Option
MatchWord          -> [CUInt -> AppliedOption
CompileExtraOption CUInt
pcre2_EXTRA_MATCH_WORD]

    -- CompileContextOption
    Bsr Bsr
bsr -> ((ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_compile_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption
CompileContextOption Ptr Pcre2_compile_context -> CUInt -> IO CInt
pcre2_set_bsr (Bsr -> CUInt
bsrToC Bsr
bsr)
    MaxPatternLength Word64
len -> ((ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_compile_context -> PCRE2_SIZE -> IO CInt)
-> PCRE2_SIZE
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption
CompileContextOption Ptr Pcre2_compile_context -> PCRE2_SIZE -> IO CInt
pcre2_set_max_pattern_length (Word64 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)
    Newline Newline
newline -> ((ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_compile_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption
CompileContextOption Ptr Pcre2_compile_context -> CUInt -> IO CInt
pcre2_set_newline (Newline -> CUInt
newlineToC Newline
newline)
    ParensLimit Word32
limit -> ((ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_compile_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption
CompileContextOption Ptr Pcre2_compile_context -> CUInt -> IO CInt
pcre2_set_parens_nest_limit (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
limit)

    -- CompileRecGuardOption
    UnsafeCompileRecGuard Int -> IO Bool
f -> [(Int -> IO Bool) -> AppliedOption
CompileRecGuardOption Int -> IO Bool
f]

    -- MatchOption
    Option
NotBol             -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_NOTBOL]
    Option
NotEmpty           -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_NOTEMPTY]
    Option
NotEmptyAtStart    -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_NOTEMPTY_ATSTART]
    Option
NotEol             -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_NOTEOL]
    Option
PartialHard        -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_PARTIAL_HARD]
    Option
PartialSoft        -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_PARTIAL_SOFT]
    Option
SubGlobal          -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_SUBSTITUTE_GLOBAL]
    Option
SubLiteral         -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_SUBSTITUTE_LITERAL]
    Option
SubReplacementOnly -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_SUBSTITUTE_REPLACEMENT_ONLY]
    Option
SubUnknownUnset    -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_SUBSTITUTE_UNKNOWN_UNSET]
    Option
SubUnsetEmpty      -> [CUInt -> AppliedOption
MatchOption CUInt
pcre2_SUBSTITUTE_UNSET_EMPTY]

    -- CalloutOption
    UnsafeCallout CalloutInfo -> IO CalloutResult
f -> [(CalloutInfo -> IO CalloutResult) -> AppliedOption
CalloutOption CalloutInfo -> IO CalloutResult
f]

    -- SubCalloutOption
    UnsafeSubCallout SubCalloutInfo -> IO SubCalloutResult
f -> [(SubCalloutInfo -> IO SubCalloutResult) -> AppliedOption
SubCalloutOption SubCalloutInfo -> IO SubCalloutResult
f]

    -- MatchContextOption
    DepthLimit Word32
limit -> ((ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_match_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption
MatchContextOption Ptr Pcre2_match_context -> CUInt -> IO CInt
pcre2_set_depth_limit (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
limit)
    HeapLimit Word32
limit -> ((ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_match_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption
MatchContextOption Ptr Pcre2_match_context -> CUInt -> IO CInt
pcre2_set_heap_limit (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
limit)
    MatchLimit Word32
limit -> ((ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_match_context -> CUInt -> IO CInt)
-> CUInt
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption
MatchContextOption Ptr Pcre2_match_context -> CUInt -> IO CInt
pcre2_set_match_limit (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
limit)
    OffsetLimit Word64
limit -> CUInt -> AppliedOption
CompileOption CUInt
pcre2_USE_OFFSET_LIMIT AppliedOption -> [AppliedOption] -> [AppliedOption]
forall a. a -> [a] -> [a]
: ((ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption)
-> (Ptr Pcre2_match_context -> PCRE2_SIZE -> IO CInt)
-> PCRE2_SIZE
-> [AppliedOption]
forall a a p.
((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary
        (ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption
MatchContextOption Ptr Pcre2_match_context -> PCRE2_SIZE -> IO CInt
pcre2_set_offset_limit (Word64 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
limit)

    where
    unary :: ((ForeignPtr a -> IO ()) -> a)
-> (Ptr a -> p -> IO CInt) -> p -> [a]
unary (ForeignPtr a -> IO ()) -> a
ctor Ptr a -> p -> IO CInt
f p
x = [(ForeignPtr a -> IO ()) -> a
ctor ((ForeignPtr a -> IO ()) -> a) -> (ForeignPtr a -> IO ()) -> a
forall a b. (a -> b) -> a -> b
$ \ForeignPtr a
ctx -> ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ctx Ptr a -> IO ()
applyAndCheck] where
        applyAndCheck :: Ptr a -> IO ()
applyAndCheck Ptr a
ctxPtr = Ptr a -> p -> IO CInt
f Ptr a
ctxPtr p
x IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

-- | Intermediate representation of options expressing what effect they'll have
-- on which stage of regex compilation\/execution.  Also provide fake @Prism'@s.
data AppliedOption
    = CompileOption !CUInt
    | CompileExtraOption !CUInt
    | CompileContextOption !(CompileContext -> IO ())
    | CompileRecGuardOption !(Int -> IO Bool)
    | MatchOption !CUInt
    | CalloutOption !(CalloutInfo -> IO CalloutResult)
    | SubCalloutOption !(SubCalloutInfo -> IO SubCalloutResult)
    | MatchContextOption !(MatchContext -> IO ())

_CompileOption :: (CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_CompileOption CUInt -> f CUInt
f =
    \case CompileOption CUInt
x -> CUInt -> AppliedOption
CompileOption (CUInt -> AppliedOption) -> f CUInt -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> f CUInt
f CUInt
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_CompileExtraOption :: (CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_CompileExtraOption CUInt -> f CUInt
f =
    \case CompileExtraOption CUInt
x -> CUInt -> AppliedOption
CompileExtraOption (CUInt -> AppliedOption) -> f CUInt -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> f CUInt
f CUInt
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_CompileContextOption :: ((ForeignPtr Pcre2_compile_context -> IO ())
 -> f (ForeignPtr Pcre2_compile_context -> IO ()))
-> AppliedOption -> f AppliedOption
_CompileContextOption (ForeignPtr Pcre2_compile_context -> IO ())
-> f (ForeignPtr Pcre2_compile_context -> IO ())
f =
    \case CompileContextOption ForeignPtr Pcre2_compile_context -> IO ()
x -> (ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption
CompileContextOption ((ForeignPtr Pcre2_compile_context -> IO ()) -> AppliedOption)
-> f (ForeignPtr Pcre2_compile_context -> IO ()) -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ForeignPtr Pcre2_compile_context -> IO ())
-> f (ForeignPtr Pcre2_compile_context -> IO ())
f ForeignPtr Pcre2_compile_context -> IO ()
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_CompileRecGuardOption :: ((Int -> IO Bool) -> f (Int -> IO Bool))
-> AppliedOption -> f AppliedOption
_CompileRecGuardOption (Int -> IO Bool) -> f (Int -> IO Bool)
f =
    \case CompileRecGuardOption Int -> IO Bool
x -> (Int -> IO Bool) -> AppliedOption
CompileRecGuardOption ((Int -> IO Bool) -> AppliedOption)
-> f (Int -> IO Bool) -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Bool) -> f (Int -> IO Bool)
f Int -> IO Bool
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_MatchOption :: (CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_MatchOption CUInt -> f CUInt
f =
    \case MatchOption CUInt
x -> CUInt -> AppliedOption
MatchOption (CUInt -> AppliedOption) -> f CUInt -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUInt -> f CUInt
f CUInt
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_CalloutOption :: ((CalloutInfo -> IO CalloutResult)
 -> f (CalloutInfo -> IO CalloutResult))
-> AppliedOption -> f AppliedOption
_CalloutOption (CalloutInfo -> IO CalloutResult)
-> f (CalloutInfo -> IO CalloutResult)
f =
    \case CalloutOption CalloutInfo -> IO CalloutResult
x -> (CalloutInfo -> IO CalloutResult) -> AppliedOption
CalloutOption ((CalloutInfo -> IO CalloutResult) -> AppliedOption)
-> f (CalloutInfo -> IO CalloutResult) -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CalloutInfo -> IO CalloutResult)
-> f (CalloutInfo -> IO CalloutResult)
f CalloutInfo -> IO CalloutResult
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_SubCalloutOption :: ((SubCalloutInfo -> IO SubCalloutResult)
 -> f (SubCalloutInfo -> IO SubCalloutResult))
-> AppliedOption -> f AppliedOption
_SubCalloutOption (SubCalloutInfo -> IO SubCalloutResult)
-> f (SubCalloutInfo -> IO SubCalloutResult)
f =
    \case SubCalloutOption SubCalloutInfo -> IO SubCalloutResult
x -> (SubCalloutInfo -> IO SubCalloutResult) -> AppliedOption
SubCalloutOption ((SubCalloutInfo -> IO SubCalloutResult) -> AppliedOption)
-> f (SubCalloutInfo -> IO SubCalloutResult) -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SubCalloutInfo -> IO SubCalloutResult)
-> f (SubCalloutInfo -> IO SubCalloutResult)
f SubCalloutInfo -> IO SubCalloutResult
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o
_MatchContextOption :: ((ForeignPtr Pcre2_match_context -> IO ())
 -> f (ForeignPtr Pcre2_match_context -> IO ()))
-> AppliedOption -> f AppliedOption
_MatchContextOption (ForeignPtr Pcre2_match_context -> IO ())
-> f (ForeignPtr Pcre2_match_context -> IO ())
f =
    \case MatchContextOption ForeignPtr Pcre2_match_context -> IO ()
x -> (ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption
MatchContextOption ((ForeignPtr Pcre2_match_context -> IO ()) -> AppliedOption)
-> f (ForeignPtr Pcre2_match_context -> IO ()) -> f AppliedOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ForeignPtr Pcre2_match_context -> IO ())
-> f (ForeignPtr Pcre2_match_context -> IO ())
f ForeignPtr Pcre2_match_context -> IO ()
x; AppliedOption
o -> AppliedOption -> f AppliedOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedOption
o

-- ** Extracting options at the right times
--
-- $ExtractingOptionsAtTheRightTimes
-- We interleave the extraction of options with the manipulation of foreign data
-- en route to the target `Matcher` or `Subber`.

-- | A `Monad` modeling both option extraction and foreign effects.
type ExtractOpts = StateT [AppliedOption] IO

-- | Use a fake @Prism'@ to extract a category of options.
extractOptsOf :: Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf :: Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting (First a) AppliedOption a
prism = ([AppliedOption] -> ([a], [AppliedOption])) -> ExtractOpts [a]
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (([AppliedOption] -> ([a], [AppliedOption])) -> ExtractOpts [a])
-> ([AppliedOption] -> ([a], [AppliedOption])) -> ExtractOpts [a]
forall a b. (a -> b) -> a -> b
$ [Either a AppliedOption] -> ([a], [AppliedOption])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either a AppliedOption] -> ([a], [AppliedOption]))
-> ([AppliedOption] -> [Either a AppliedOption])
-> [AppliedOption]
-> ([a], [AppliedOption])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppliedOption -> Either a AppliedOption)
-> [AppliedOption] -> [Either a AppliedOption]
forall a b. (a -> b) -> [a] -> [b]
map AppliedOption -> Either a AppliedOption
discrim where
    discrim :: AppliedOption -> Either a AppliedOption
discrim AppliedOption
opt = Either a AppliedOption
-> (a -> Either a AppliedOption)
-> Maybe a
-> Either a AppliedOption
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppliedOption -> Either a AppliedOption
forall a b. b -> Either a b
Right AppliedOption
opt) a -> Either a AppliedOption
forall a b. a -> Either a b
Left (Maybe a -> Either a AppliedOption)
-> Maybe a -> Either a AppliedOption
forall a b. (a -> b) -> a -> b
$ AppliedOption
opt AppliedOption -> Getting (First a) AppliedOption a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First a) AppliedOption a
prism

-- | Prepare to compile a `Code`.
extractCompileEnv :: ExtractOpts CompileEnv
extractCompileEnv :: ExtractOpts CompileEnv
extractCompileEnv = do
    [ForeignPtr Pcre2_compile_context -> IO ()]
ctxUpds <- Getting
  (First (ForeignPtr Pcre2_compile_context -> IO ()))
  AppliedOption
  (ForeignPtr Pcre2_compile_context -> IO ())
-> ExtractOpts [ForeignPtr Pcre2_compile_context -> IO ()]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting
  (First (ForeignPtr Pcre2_compile_context -> IO ()))
  AppliedOption
  (ForeignPtr Pcre2_compile_context -> IO ())
forall (f :: * -> *).
Applicative f =>
((ForeignPtr Pcre2_compile_context -> IO ())
 -> f (ForeignPtr Pcre2_compile_context -> IO ()))
-> AppliedOption -> f AppliedOption
_CompileContextOption
    CUInt
xtraOpts <- [CUInt] -> CUInt
forall (t :: * -> *) a. (Foldable t, Bits a) => t a -> a
bitOr ([CUInt] -> CUInt)
-> StateT [AppliedOption] IO [CUInt]
-> StateT [AppliedOption] IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First CUInt) AppliedOption CUInt
-> StateT [AppliedOption] IO [CUInt]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting (First CUInt) AppliedOption CUInt
forall (f :: * -> *).
Applicative f =>
(CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_CompileExtraOption
    Maybe (Int -> IO Bool)
recGuard <- Getting (First (Int -> IO Bool)) [Int -> IO Bool] (Int -> IO Bool)
-> [Int -> IO Bool] -> Maybe (Int -> IO Bool)
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First (Int -> IO Bool)) [Int -> IO Bool] (Int -> IO Bool)
forall s a. Snoc s s a a => Traversal' s a
_last ([Int -> IO Bool] -> Maybe (Int -> IO Bool))
-> StateT [AppliedOption] IO [Int -> IO Bool]
-> StateT [AppliedOption] IO (Maybe (Int -> IO Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First (Int -> IO Bool)) AppliedOption (Int -> IO Bool)
-> StateT [AppliedOption] IO [Int -> IO Bool]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting (First (Int -> IO Bool)) AppliedOption (Int -> IO Bool)
forall (f :: * -> *).
Applicative f =>
((Int -> IO Bool) -> f (Int -> IO Bool))
-> AppliedOption -> f AppliedOption
_CompileRecGuardOption

    if [ForeignPtr Pcre2_compile_context -> IO ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ForeignPtr Pcre2_compile_context -> IO ()]
ctxUpds Bool -> Bool -> Bool
&& CUInt
xtraOpts CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 Bool -> Bool -> Bool
&& Maybe (Int -> IO Bool) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (Int -> IO Bool)
recGuard
        then CompileEnv -> ExtractOpts CompileEnv
forall (m :: * -> *) a. Monad m => a -> m a
return CompileEnv :: Maybe (ForeignPtr Pcre2_compile_context)
-> Maybe (IORef (Maybe SomeException)) -> CompileEnv
CompileEnv{
            compileEnvCtx :: Maybe (ForeignPtr Pcre2_compile_context)
compileEnvCtx  = Maybe (ForeignPtr Pcre2_compile_context)
forall a. Maybe a
Nothing,
            compileEnvERef :: Maybe (IORef (Maybe SomeException))
compileEnvERef = Maybe (IORef (Maybe SomeException))
forall a. Maybe a
Nothing}

        else IO CompileEnv -> ExtractOpts CompileEnv
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompileEnv -> ExtractOpts CompileEnv)
-> IO CompileEnv -> ExtractOpts CompileEnv
forall a b. (a -> b) -> a -> b
$ do
            ForeignPtr Pcre2_compile_context
ctx <- (Ptr Pcre2_compile_context -> IO ())
-> IO (Ptr Pcre2_compile_context)
-> IO (ForeignPtr Pcre2_compile_context)
forall a. (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr Pcre2_compile_context -> IO ()
pcre2_compile_context_free (IO (Ptr Pcre2_compile_context)
 -> IO (ForeignPtr Pcre2_compile_context))
-> IO (Ptr Pcre2_compile_context)
-> IO (ForeignPtr Pcre2_compile_context)
forall a b. (a -> b) -> a -> b
$
                Ptr Pcre2_general_context -> IO (Ptr Pcre2_compile_context)
pcre2_compile_context_create Ptr Pcre2_general_context
forall a. Ptr a
nullPtr

            [ForeignPtr Pcre2_compile_context -> IO ()]
-> ((ForeignPtr Pcre2_compile_context -> IO ()) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ForeignPtr Pcre2_compile_context -> IO ()]
ctxUpds (((ForeignPtr Pcre2_compile_context -> IO ()) -> IO ()) -> IO ())
-> ((ForeignPtr Pcre2_compile_context -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Pcre2_compile_context -> IO ()
update -> ForeignPtr Pcre2_compile_context -> IO ()
update ForeignPtr Pcre2_compile_context
ctx

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
xtraOpts CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Pcre2_compile_context
-> (Ptr Pcre2_compile_context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_compile_context
ctx ((Ptr Pcre2_compile_context -> IO ()) -> IO ())
-> (Ptr Pcre2_compile_context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_compile_context
ctxPtr ->
                Ptr Pcre2_compile_context -> CUInt -> IO CInt
pcre2_set_compile_extra_options Ptr Pcre2_compile_context
ctxPtr CUInt
xtraOpts IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

            Maybe (IORef (Maybe SomeException))
compileEnvERef <- Maybe (Int -> IO Bool)
-> ((Int -> IO Bool) -> IO (IORef (Maybe SomeException)))
-> IO (Maybe (IORef (Maybe SomeException)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Int -> IO Bool)
recGuard (((Int -> IO Bool) -> IO (IORef (Maybe SomeException)))
 -> IO (Maybe (IORef (Maybe SomeException))))
-> ((Int -> IO Bool) -> IO (IORef (Maybe SomeException)))
-> IO (Maybe (IORef (Maybe SomeException)))
forall a b. (a -> b) -> a -> b
$ \Int -> IO Bool
f -> do
                IORef (Maybe SomeException)
eRef <- Maybe SomeException -> IO (IORef (Maybe SomeException))
forall a. a -> IO (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing
                FunPtr (CUInt -> Ptr Any -> IO CInt)
funPtr <- ForeignPtr Pcre2_compile_context
-> IO (FunPtr (CUInt -> Ptr Any -> IO CInt))
-> IO (FunPtr (CUInt -> Ptr Any -> IO CInt))
forall b a. ForeignPtr b -> IO (FunPtr a) -> IO (FunPtr a)
mkFunPtr ForeignPtr Pcre2_compile_context
ctx (IO (FunPtr (CUInt -> Ptr Any -> IO CInt))
 -> IO (FunPtr (CUInt -> Ptr Any -> IO CInt)))
-> IO (FunPtr (CUInt -> Ptr Any -> IO CInt))
-> IO (FunPtr (CUInt -> Ptr Any -> IO CInt))
forall a b. (a -> b) -> a -> b
$ FfiWrapper (CUInt -> Ptr Any -> IO CInt)
forall a. FfiWrapper (CUInt -> Ptr a -> IO CInt)
mkRecursionGuard FfiWrapper (CUInt -> Ptr Any -> IO CInt)
-> FfiWrapper (CUInt -> Ptr Any -> IO CInt)
forall a b. (a -> b) -> a -> b
$ \CUInt
depth Ptr Any
_ -> do
                    Either SomeException Bool
resultOrE <- IO Bool -> IO (Either SomeException Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Bool -> IO (Either SomeException Bool))
-> IO Bool -> IO (Either SomeException Bool)
forall a b. (a -> b) -> a -> b
$ Int -> IO Bool
f (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
depth) IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO Bool
forall a. a -> IO a
evaluate
                    case Either SomeException Bool
resultOrE of
                        Right Bool
success -> CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ if Bool
success then CInt
0 else CInt
1
                        Left SomeException
e        -> IORef (Maybe SomeException) -> Maybe SomeException -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
eRef (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) IO () -> IO CInt -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
1
                ForeignPtr Pcre2_compile_context
-> (Ptr Pcre2_compile_context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_compile_context
ctx ((Ptr Pcre2_compile_context -> IO ()) -> IO ())
-> (Ptr Pcre2_compile_context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_compile_context
ctxPtr ->
                    Ptr Pcre2_compile_context
-> FunPtr (CUInt -> Ptr Any -> IO CInt) -> Ptr Any -> IO CInt
forall a.
Ptr Pcre2_compile_context
-> FunPtr (CUInt -> Ptr a -> IO CInt) -> Ptr a -> IO CInt
pcre2_set_compile_recursion_guard Ptr Pcre2_compile_context
ctxPtr FunPtr (CUInt -> Ptr Any -> IO CInt)
funPtr Ptr Any
forall a. Ptr a
nullPtr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
                IORef (Maybe SomeException) -> IO (IORef (Maybe SomeException))
forall (m :: * -> *) a. Monad m => a -> m a
return IORef (Maybe SomeException)
eRef

            CompileEnv -> IO CompileEnv
forall (m :: * -> *) a. Monad m => a -> m a
return CompileEnv :: Maybe (ForeignPtr Pcre2_compile_context)
-> Maybe (IORef (Maybe SomeException)) -> CompileEnv
CompileEnv{compileEnvCtx :: Maybe (ForeignPtr Pcre2_compile_context)
compileEnvCtx = ForeignPtr Pcre2_compile_context
-> Maybe (ForeignPtr Pcre2_compile_context)
forall a. a -> Maybe a
Just ForeignPtr Pcre2_compile_context
ctx, Maybe (IORef (Maybe SomeException))
compileEnvERef :: Maybe (IORef (Maybe SomeException))
compileEnvERef :: Maybe (IORef (Maybe SomeException))
..}

-- | Inputs to `Code` compilation besides the pattern.
data CompileEnv = CompileEnv{
    CompileEnv -> Maybe (ForeignPtr Pcre2_compile_context)
compileEnvCtx :: !(Maybe CompileContext),
    -- | A register for catching exceptions thrown in recursion guards, if
    -- needed.
    CompileEnv -> Maybe (IORef (Maybe SomeException))
compileEnvERef :: !(Maybe (IORef (Maybe SomeException)))}

-- | Compile a `Code`.
extractCode :: Text -> CompileEnv -> ExtractOpts Code
extractCode :: Text -> CompileEnv -> ExtractOpts Code
extractCode Text
patt CompileEnv{Maybe (ForeignPtr Pcre2_compile_context)
Maybe (IORef (Maybe SomeException))
compileEnvERef :: Maybe (IORef (Maybe SomeException))
compileEnvCtx :: Maybe (ForeignPtr Pcre2_compile_context)
compileEnvERef :: CompileEnv -> Maybe (IORef (Maybe SomeException))
compileEnvCtx :: CompileEnv -> Maybe (ForeignPtr Pcre2_compile_context)
..} = do
    CUInt
opts <- [CUInt] -> CUInt
forall (t :: * -> *) a. (Foldable t, Bits a) => t a -> a
bitOr ([CUInt] -> CUInt)
-> StateT [AppliedOption] IO [CUInt]
-> StateT [AppliedOption] IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First CUInt) AppliedOption CUInt
-> StateT [AppliedOption] IO [CUInt]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting (First CUInt) AppliedOption CUInt
forall (f :: * -> *).
Applicative f =>
(CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_CompileOption

    IO Code -> ExtractOpts Code
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Code -> ExtractOpts Code) -> IO Code -> ExtractOpts Code
forall a b. (a -> b) -> a -> b
$ (Ptr Pcre2_code -> IO ()) -> IO (Ptr Pcre2_code) -> IO Code
forall a. (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr Pcre2_code -> IO ()
pcre2_code_free (IO (Ptr Pcre2_code) -> IO Code) -> IO (Ptr Pcre2_code) -> IO Code
forall a b. (a -> b) -> a -> b
$
        Text
-> (Ptr Word8 -> I8 -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
Text.useAsPtr Text
patt ((Ptr Word8 -> I8 -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code))
-> (Ptr Word8 -> I8 -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pattPtr I8
pattCUs ->
        (Ptr CInt -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code))
-> (Ptr CInt -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errorCodePtr ->
        (Ptr PCRE2_SIZE -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PCRE2_SIZE -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code))
-> (Ptr PCRE2_SIZE -> IO (Ptr Pcre2_code)) -> IO (Ptr Pcre2_code)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE2_SIZE
errorOffPtr ->
        Maybe (ForeignPtr Pcre2_compile_context)
-> (Ptr Pcre2_compile_context -> IO (Ptr Pcre2_code))
-> IO (Ptr Pcre2_code)
forall a b. Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr Maybe (ForeignPtr Pcre2_compile_context)
compileEnvCtx ((Ptr Pcre2_compile_context -> IO (Ptr Pcre2_code))
 -> IO (Ptr Pcre2_code))
-> (Ptr Pcre2_compile_context -> IO (Ptr Pcre2_code))
-> IO (Ptr Pcre2_code)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_compile_context
ctxPtr -> do
            Ptr Pcre2_code
codePtr <- Ptr CUChar
-> PCRE2_SIZE
-> CUInt
-> Ptr CInt
-> Ptr PCRE2_SIZE
-> Ptr Pcre2_compile_context
-> IO (Ptr Pcre2_code)
pcre2_compile
                (Ptr Word8 -> Ptr CUChar
toCUs Ptr Word8
pattPtr)
                (I8 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
pattCUs)
                (CUInt
opts CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
pcre2_UTF)
                Ptr CInt
errorCodePtr
                Ptr PCRE2_SIZE
errorOffPtr
                Ptr Pcre2_compile_context
ctxPtr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Pcre2_code
codePtr Ptr Pcre2_code -> Ptr Pcre2_code -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Pcre2_code
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                -- Re-throw exception (if any) from recursion guard (if any)
                Maybe (IORef (Maybe SomeException))
-> (IORef (Maybe SomeException) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (IORef (Maybe SomeException))
compileEnvERef ((IORef (Maybe SomeException) -> IO ()) -> IO ())
-> (IORef (Maybe SomeException) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe SomeException) -> IO (Maybe SomeException)
forall a. IORef a -> IO a
readIORef (IORef (Maybe SomeException) -> IO (Maybe SomeException))
-> (Maybe SomeException -> IO ())
-> IORef (Maybe SomeException)
-> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (SomeException -> IO Any) -> Maybe SomeException -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeException -> IO Any
forall e a. Exception e => e -> IO a
throwIO
                -- Otherwise throw PCRE2 error
                CInt
errorCode <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errorCodePtr
                PCRE2_SIZE
offCUs <- Ptr PCRE2_SIZE -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> IO a
peek Ptr PCRE2_SIZE
errorOffPtr
                Pcre2CompileException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Pcre2CompileException -> IO ()) -> Pcre2CompileException -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> Text -> PCRE2_SIZE -> Pcre2CompileException
Pcre2CompileException CInt
errorCode Text
patt PCRE2_SIZE
offCUs

            Ptr Pcre2_code -> IO (Ptr Pcre2_code)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pcre2_code
codePtr

-- | `Code` and auxiliary compiled data used in preparation for a match or
-- substitution.  This remains constant for the lifetime of a `Matcher` or
-- `Subber`.
data MatchEnv = MatchEnv{
    MatchEnv -> Code
matchEnvCode       :: Code,
    MatchEnv -> CUInt
matchEnvOpts       :: CUInt,
    MatchEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchEnvCtx        :: Maybe MatchContext,
    MatchEnv -> Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCallout    :: Maybe (CalloutInfo -> IO CalloutResult),
    MatchEnv -> Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)}

-- | Prepare a matching function after compiling the underlying @pcre2_code@.
extractMatchEnv :: Code -> ExtractOpts MatchEnv
extractMatchEnv :: Code -> ExtractOpts MatchEnv
extractMatchEnv Code
matchEnvCode = do
    CUInt
matchEnvOpts <- [CUInt] -> CUInt
forall (t :: * -> *) a. (Foldable t, Bits a) => t a -> a
bitOr ([CUInt] -> CUInt)
-> StateT [AppliedOption] IO [CUInt]
-> StateT [AppliedOption] IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First CUInt) AppliedOption CUInt
-> StateT [AppliedOption] IO [CUInt]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting (First CUInt) AppliedOption CUInt
forall (f :: * -> *).
Applicative f =>
(CUInt -> f CUInt) -> AppliedOption -> f AppliedOption
_MatchOption

    Maybe (ForeignPtr Pcre2_match_context)
matchEnvCtx <- Getting
  (First (ForeignPtr Pcre2_match_context -> IO ()))
  AppliedOption
  (ForeignPtr Pcre2_match_context -> IO ())
-> ExtractOpts [ForeignPtr Pcre2_match_context -> IO ()]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting
  (First (ForeignPtr Pcre2_match_context -> IO ()))
  AppliedOption
  (ForeignPtr Pcre2_match_context -> IO ())
forall (f :: * -> *).
Applicative f =>
((ForeignPtr Pcre2_match_context -> IO ())
 -> f (ForeignPtr Pcre2_match_context -> IO ()))
-> AppliedOption -> f AppliedOption
_MatchContextOption ExtractOpts [ForeignPtr Pcre2_match_context -> IO ()]
-> ([ForeignPtr Pcre2_match_context -> IO ()]
    -> StateT
         [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context)))
-> StateT
     [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        []      -> Maybe (ForeignPtr Pcre2_match_context)
-> StateT
     [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForeignPtr Pcre2_match_context)
forall a. Maybe a
Nothing
        [ForeignPtr Pcre2_match_context -> IO ()]
ctxUpds -> IO (Maybe (ForeignPtr Pcre2_match_context))
-> StateT
     [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ForeignPtr Pcre2_match_context))
 -> StateT
      [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context)))
-> IO (Maybe (ForeignPtr Pcre2_match_context))
-> StateT
     [AppliedOption] IO (Maybe (ForeignPtr Pcre2_match_context))
forall a b. (a -> b) -> a -> b
$ ForeignPtr Pcre2_match_context
-> Maybe (ForeignPtr Pcre2_match_context)
forall a. a -> Maybe a
Just (ForeignPtr Pcre2_match_context
 -> Maybe (ForeignPtr Pcre2_match_context))
-> IO (ForeignPtr Pcre2_match_context)
-> IO (Maybe (ForeignPtr Pcre2_match_context))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            ForeignPtr Pcre2_match_context
ctx <- (Ptr Pcre2_match_context -> IO ())
-> IO (Ptr Pcre2_match_context)
-> IO (ForeignPtr Pcre2_match_context)
forall a. (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr Pcre2_match_context -> IO ()
pcre2_match_context_free (IO (Ptr Pcre2_match_context)
 -> IO (ForeignPtr Pcre2_match_context))
-> IO (Ptr Pcre2_match_context)
-> IO (ForeignPtr Pcre2_match_context)
forall a b. (a -> b) -> a -> b
$
                Ptr Pcre2_general_context -> IO (Ptr Pcre2_match_context)
pcre2_match_context_create Ptr Pcre2_general_context
forall a. Ptr a
nullPtr
            [ForeignPtr Pcre2_match_context -> IO ()]
-> ((ForeignPtr Pcre2_match_context -> IO ()) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ForeignPtr Pcre2_match_context -> IO ()]
ctxUpds (((ForeignPtr Pcre2_match_context -> IO ()) -> IO ()) -> IO ())
-> ((ForeignPtr Pcre2_match_context -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Pcre2_match_context -> IO ()
update -> ForeignPtr Pcre2_match_context -> IO ()
update ForeignPtr Pcre2_match_context
ctx
            ForeignPtr Pcre2_match_context
-> IO (ForeignPtr Pcre2_match_context)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Pcre2_match_context
ctx

    Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCallout <- Getting
  (First (CalloutInfo -> IO CalloutResult))
  [CalloutInfo -> IO CalloutResult]
  (CalloutInfo -> IO CalloutResult)
-> [CalloutInfo -> IO CalloutResult]
-> Maybe (CalloutInfo -> IO CalloutResult)
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting
  (First (CalloutInfo -> IO CalloutResult))
  [CalloutInfo -> IO CalloutResult]
  (CalloutInfo -> IO CalloutResult)
forall s a. Snoc s s a a => Traversal' s a
_last ([CalloutInfo -> IO CalloutResult]
 -> Maybe (CalloutInfo -> IO CalloutResult))
-> StateT [AppliedOption] IO [CalloutInfo -> IO CalloutResult]
-> StateT
     [AppliedOption] IO (Maybe (CalloutInfo -> IO CalloutResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (First (CalloutInfo -> IO CalloutResult))
  AppliedOption
  (CalloutInfo -> IO CalloutResult)
-> StateT [AppliedOption] IO [CalloutInfo -> IO CalloutResult]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting
  (First (CalloutInfo -> IO CalloutResult))
  AppliedOption
  (CalloutInfo -> IO CalloutResult)
forall (f :: * -> *).
Applicative f =>
((CalloutInfo -> IO CalloutResult)
 -> f (CalloutInfo -> IO CalloutResult))
-> AppliedOption -> f AppliedOption
_CalloutOption
    Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout <- Getting
  (First (SubCalloutInfo -> IO SubCalloutResult))
  [SubCalloutInfo -> IO SubCalloutResult]
  (SubCalloutInfo -> IO SubCalloutResult)
-> [SubCalloutInfo -> IO SubCalloutResult]
-> Maybe (SubCalloutInfo -> IO SubCalloutResult)
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting
  (First (SubCalloutInfo -> IO SubCalloutResult))
  [SubCalloutInfo -> IO SubCalloutResult]
  (SubCalloutInfo -> IO SubCalloutResult)
forall s a. Snoc s s a a => Traversal' s a
_last ([SubCalloutInfo -> IO SubCalloutResult]
 -> Maybe (SubCalloutInfo -> IO SubCalloutResult))
-> StateT
     [AppliedOption] IO [SubCalloutInfo -> IO SubCalloutResult]
-> StateT
     [AppliedOption] IO (Maybe (SubCalloutInfo -> IO SubCalloutResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (First (SubCalloutInfo -> IO SubCalloutResult))
  AppliedOption
  (SubCalloutInfo -> IO SubCalloutResult)
-> StateT
     [AppliedOption] IO [SubCalloutInfo -> IO SubCalloutResult]
forall a. Getting (First a) AppliedOption a -> ExtractOpts [a]
extractOptsOf Getting
  (First (SubCalloutInfo -> IO SubCalloutResult))
  AppliedOption
  (SubCalloutInfo -> IO SubCalloutResult)
forall (f :: * -> *).
Applicative f =>
((SubCalloutInfo -> IO SubCalloutResult)
 -> f (SubCalloutInfo -> IO SubCalloutResult))
-> AppliedOption -> f AppliedOption
_SubCalloutOption

    MatchEnv -> ExtractOpts MatchEnv
forall (m :: * -> *) a. Monad m => a -> m a
return MatchEnv :: Code
-> CUInt
-> Maybe (ForeignPtr Pcre2_match_context)
-> Maybe (CalloutInfo -> IO CalloutResult)
-> Maybe (SubCalloutInfo -> IO SubCalloutResult)
-> MatchEnv
MatchEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (SubCalloutInfo -> IO SubCalloutResult)
Maybe (CalloutInfo -> IO CalloutResult)
Code
CUInt
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: CUInt
matchEnvCode :: Code
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: CUInt
matchEnvCode :: Code
..}

-- | Generate, from user-supplied `Option`s and pattern, a `MatchEnv` that can
-- be reused for matching or substituting.
userMatchEnv :: Option -> Text -> IO MatchEnv
userMatchEnv :: Option -> Text -> IO MatchEnv
userMatchEnv Option
option Text
patt = ExtractOpts MatchEnv
-> [AppliedOption] -> IO (MatchEnv, [AppliedOption])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ExtractOpts MatchEnv
extractAll (Option -> [AppliedOption]
applyOption Option
option) IO (MatchEnv, [AppliedOption])
-> ((MatchEnv, [AppliedOption]) -> MatchEnv) -> IO MatchEnv
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    (MatchEnv
matchEnv, []) -> MatchEnv
matchEnv
    (MatchEnv, [AppliedOption])
_              -> String -> MatchEnv
forall a. HasCallStack => String -> a
error String
"BUG! Options not fully extracted"
    where
    extractAll :: ExtractOpts MatchEnv
extractAll = ExtractOpts CompileEnv
extractCompileEnv ExtractOpts CompileEnv
-> (CompileEnv -> ExtractOpts Code) -> ExtractOpts Code
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> CompileEnv -> ExtractOpts Code
extractCode Text
patt ExtractOpts Code
-> (Code -> ExtractOpts MatchEnv) -> ExtractOpts MatchEnv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Code -> ExtractOpts MatchEnv
extractMatchEnv

-- | A `MatchEnv` is sufficient to fully implement a matching function.
matcherWithEnv :: MatchEnv -> Matcher
matcherWithEnv :: MatchEnv -> Matcher
matcherWithEnv matchEnv :: MatchEnv
matchEnv@MatchEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (SubCalloutInfo -> IO SubCalloutResult)
Maybe (CalloutInfo -> IO CalloutResult)
Code
CUInt
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: CUInt
matchEnvCode :: Code
matchEnvSubCallout :: MatchEnv -> Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: MatchEnv -> Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: MatchEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: MatchEnv -> CUInt
matchEnvCode :: MatchEnv -> Code
..} Text
subject = IO (Stream (Ptr Pcre2_match_data) IO Void)
-> Stream (Ptr Pcre2_match_data) IO Void
forall b (m :: * -> *) a. m (Stream b m a) -> Stream b m a
StreamEffect (IO (Stream (Ptr Pcre2_match_data) IO Void)
 -> Stream (Ptr Pcre2_match_data) IO Void)
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
-> Stream (Ptr Pcre2_match_data) IO Void
forall a b. (a -> b) -> a -> b
$
    Code
-> (Ptr Pcre2_code -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Code
matchEnvCode ((Ptr Pcre2_code -> IO (Stream (Ptr Pcre2_match_data) IO Void))
 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> (Ptr Pcre2_code -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_code
codePtr ->
    Ptr Pcre2_code
-> (Ptr Pcre2_match_data
    -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall b. Ptr Pcre2_code -> (Ptr Pcre2_match_data -> IO b) -> IO b
withMatchDataFromCode Ptr Pcre2_code
codePtr ((Ptr Pcre2_match_data
  -> IO (Stream (Ptr Pcre2_match_data) IO Void))
 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> (Ptr Pcre2_match_data
    -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_data
matchDataPtr ->
    Text
-> (Ptr Word8 -> I8 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
Text.useAsPtr Text
subject ((Ptr Word8 -> I8 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> (Ptr Word8 -> I8 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
subjPtr I8
subjCUs -> do
        MatchTempEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (IORef CalloutState)
matchTempEnvRef :: MatchTempEnv -> Maybe (IORef CalloutState)
matchTempEnvCtx :: MatchTempEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvRef :: Maybe (IORef CalloutState)
matchTempEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
..} <- MatchEnv -> Text -> IO MatchTempEnv
mkMatchTempEnv MatchEnv
matchEnv Text
subject

        -- Loop over the subject, emitting match data until stopping.
        Stream (Ptr Pcre2_match_data) IO Void
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Ptr Pcre2_match_data) IO Void
 -> IO (Stream (Ptr Pcre2_match_data) IO Void))
-> Stream (Ptr Pcre2_match_data) IO Void
-> IO (Stream (Ptr Pcre2_match_data) IO Void)
forall a b. (a -> b) -> a -> b
$ PCRE2_SIZE
-> ((PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
    -> PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
-> Stream (Ptr Pcre2_match_data) IO Void
forall a b. a -> ((a -> b) -> a -> b) -> b
fix1 PCRE2_SIZE
0 (((PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
  -> PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
 -> Stream (Ptr Pcre2_match_data) IO Void)
-> ((PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
    -> PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void)
-> Stream (Ptr Pcre2_match_data) IO Void
forall a b. (a -> b) -> a -> b
$ \PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void
continue PCRE2_SIZE
curOff -> do
            CInt
result <- IO CInt -> Stream (Ptr Pcre2_match_data) IO CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Stream (Ptr Pcre2_match_data) IO CInt)
-> IO CInt -> Stream (Ptr Pcre2_match_data) IO CInt
forall a b. (a -> b) -> a -> b
$ Maybe (ForeignPtr Pcre2_match_context)
-> (Ptr Pcre2_match_context -> IO CInt) -> IO CInt
forall a b. Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx ((Ptr Pcre2_match_context -> IO CInt) -> IO CInt)
-> (Ptr Pcre2_match_context -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_context
ctxPtr ->
                Ptr Pcre2_code
-> Ptr CUChar
-> PCRE2_SIZE
-> PCRE2_SIZE
-> CUInt
-> Ptr Pcre2_match_data
-> Ptr Pcre2_match_context
-> IO CInt
pcre2_match
                    Ptr Pcre2_code
codePtr
                    (Ptr Word8 -> Ptr CUChar
toCUs Ptr Word8
subjPtr)
                    (I8 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
subjCUs)
                    PCRE2_SIZE
curOff
                    CUInt
matchEnvOpts
                    Ptr Pcre2_match_data
matchDataPtr
                    Ptr Pcre2_match_context
ctxPtr

            -- Handle no match and errors
            Bool
-> Stream (Ptr Pcre2_match_data) IO ()
-> Stream (Ptr Pcre2_match_data) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
pcre2_ERROR_NOMATCH) Stream (Ptr Pcre2_match_data) IO ()
forall b (m :: * -> *) a. Stream b m a
StreamStop
            Bool
-> Stream (Ptr Pcre2_match_data) IO ()
-> Stream (Ptr Pcre2_match_data) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
pcre2_ERROR_CALLOUT) (Stream (Ptr Pcre2_match_data) IO ()
 -> Stream (Ptr Pcre2_match_data) IO ())
-> Stream (Ptr Pcre2_match_data) IO ()
-> Stream (Ptr Pcre2_match_data) IO ()
forall a b. (a -> b) -> a -> b
$
                IO () -> Stream (Ptr Pcre2_match_data) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Ptr Pcre2_match_data) IO ())
-> IO () -> Stream (Ptr Pcre2_match_data) IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (IORef CalloutState) -> IO ()
maybeRethrow Maybe (IORef CalloutState)
matchTempEnvRef
            IO () -> Stream (Ptr Pcre2_match_data) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Ptr Pcre2_match_data) IO ())
-> IO () -> Stream (Ptr Pcre2_match_data) IO ()
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0) CInt
result

            Ptr Pcre2_match_data -> Stream (Ptr Pcre2_match_data) IO ()
forall b (m :: * -> *). b -> Stream b m ()
streamYield Ptr Pcre2_match_data
matchDataPtr

            -- Determine next starting offset
            PCRE2_SIZE
nextOff <- IO PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO PCRE2_SIZE
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO PCRE2_SIZE)
-> IO PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO PCRE2_SIZE
forall a b. (a -> b) -> a -> b
$ do
                Ptr PCRE2_SIZE
ovecPtr <- Ptr Pcre2_match_data -> IO (Ptr PCRE2_SIZE)
pcre2_get_ovector_pointer Ptr Pcre2_match_data
matchDataPtr
                PCRE2_SIZE
curOffEnd <- Ptr PCRE2_SIZE -> Int -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PCRE2_SIZE
ovecPtr Int
1
                -- Prevent infinite loop upon empty match
                PCRE2_SIZE -> IO PCRE2_SIZE
forall (m :: * -> *) a. Monad m => a -> m a
return (PCRE2_SIZE -> IO PCRE2_SIZE) -> PCRE2_SIZE -> IO PCRE2_SIZE
forall a b. (a -> b) -> a -> b
$ PCRE2_SIZE -> PCRE2_SIZE -> PCRE2_SIZE
forall a. Ord a => a -> a -> a
max PCRE2_SIZE
curOffEnd (PCRE2_SIZE
curOff PCRE2_SIZE -> PCRE2_SIZE -> PCRE2_SIZE
forall a. Num a => a -> a -> a
+ PCRE2_SIZE
1)

            -- Handle end of subject
            Bool
-> Stream (Ptr Pcre2_match_data) IO ()
-> Stream (Ptr Pcre2_match_data) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PCRE2_SIZE
nextOff PCRE2_SIZE -> PCRE2_SIZE -> Bool
forall a. Ord a => a -> a -> Bool
> I8 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
subjCUs) Stream (Ptr Pcre2_match_data) IO ()
forall b (m :: * -> *) a. Stream b m a
StreamStop

            PCRE2_SIZE -> Stream (Ptr Pcre2_match_data) IO Void
continue PCRE2_SIZE
nextOff

    where
    withMatchDataFromCode :: Ptr Pcre2_code -> (Ptr Pcre2_match_data -> IO b) -> IO b
withMatchDataFromCode Ptr Pcre2_code
codePtr Ptr Pcre2_match_data -> IO b
action = do
        ForeignPtr Pcre2_match_data
matchData <- (Ptr Pcre2_match_data -> IO ())
-> IO (Ptr Pcre2_match_data) -> IO (ForeignPtr Pcre2_match_data)
forall a. (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr Pcre2_match_data -> IO ()
pcre2_match_data_free (IO (Ptr Pcre2_match_data) -> IO (ForeignPtr Pcre2_match_data))
-> IO (Ptr Pcre2_match_data) -> IO (ForeignPtr Pcre2_match_data)
forall a b. (a -> b) -> a -> b
$
            Ptr Pcre2_code
-> Ptr Pcre2_general_context -> IO (Ptr Pcre2_match_data)
pcre2_match_data_create_from_pattern Ptr Pcre2_code
codePtr Ptr Pcre2_general_context
forall a. Ptr a
nullPtr
        ForeignPtr Pcre2_match_data
-> (Ptr Pcre2_match_data -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_match_data
matchData Ptr Pcre2_match_data -> IO b
action

-- | Helper to generate public matching functions.
pureUserMatcher :: Option -> Text -> Matcher
pureUserMatcher :: Option -> Text -> Matcher
pureUserMatcher Option
option Text
patt =
    MatchEnv -> Matcher
matcherWithEnv (MatchEnv -> Matcher) -> MatchEnv -> Matcher
forall a b. (a -> b) -> a -> b
$ IO MatchEnv -> MatchEnv
forall a. IO a -> a
unsafePerformIO (IO MatchEnv -> MatchEnv) -> IO MatchEnv -> MatchEnv
forall a b. (a -> b) -> a -> b
$ Option -> Text -> IO MatchEnv
userMatchEnv Option
option Text
patt

-- | A `Subber` works by first writing results to a reasonably-sized buffer.  If
-- we run out of room, PCRE2 allows us to simulate the rest of the substitution
-- without writing anything, in order to calculate how big the buffer actually
-- has to be.  In this event, we rerun the substitution with a new,
-- exactly-sized buffer.
--
-- One potential issue arising from two attempts is running effectful callouts
-- twice.  We mitigate this by skipping callouts the second time:
--
-- * all regular callouts, since they had run during the simulation, and
--
-- * those substitution callouts that had run the first time.
--
-- Therefore, the first time, log the substitution callout indexes that had run
-- along with their results, and replay the log the second time, returning those
-- same results without re-incurring effects.
subberWithEnv :: MatchEnv -> Text -> Subber
subberWithEnv :: MatchEnv -> Text -> Subber
subberWithEnv firstMatchEnv :: MatchEnv
firstMatchEnv@MatchEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (SubCalloutInfo -> IO SubCalloutResult)
Maybe (CalloutInfo -> IO CalloutResult)
Code
CUInt
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: CUInt
matchEnvCode :: Code
matchEnvSubCallout :: MatchEnv -> Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: MatchEnv -> Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: MatchEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: MatchEnv -> CUInt
matchEnvCode :: MatchEnv -> Code
..} Text
replacement Text
subject =
    Code -> (Ptr Pcre2_code -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Code
matchEnvCode ((Ptr Pcre2_code -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr Pcre2_code -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_code
codePtr ->
    Text -> (Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text)
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
Text.useAsPtr Text
subject ((Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
subjPtr I8
subjCUs ->
    Text -> (Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text)
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
Text.useAsPtr Text
replacement ((Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr Word8 -> I8 -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
replPtr I8
replCUs ->
    PCRE2_SIZE
-> (Ptr PCRE2_SIZE -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
initOutLen) ((Ptr PCRE2_SIZE -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr PCRE2_SIZE -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE2_SIZE
outLenPtr -> do
        let run :: CUInt -> Ptr Pcre2_match_context -> PCRE2_SPTR -> IO CInt
            run :: CUInt -> Ptr Pcre2_match_context -> Ptr CUChar -> IO CInt
run CUInt
curOpts Ptr Pcre2_match_context
ctxPtr Ptr CUChar
outBufPtr = Ptr Pcre2_code
-> Ptr CUChar
-> PCRE2_SIZE
-> PCRE2_SIZE
-> CUInt
-> Ptr Pcre2_match_data
-> Ptr Pcre2_match_context
-> Ptr CUChar
-> PCRE2_SIZE
-> Ptr CUChar
-> Ptr PCRE2_SIZE
-> IO CInt
pcre2_substitute
                Ptr Pcre2_code
codePtr
                (Ptr Word8 -> Ptr CUChar
toCUs Ptr Word8
subjPtr)
                (I8 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
subjCUs)
                PCRE2_SIZE
0
                (CUInt
matchEnvOpts CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
curOpts)
                Ptr Pcre2_match_data
forall a. Ptr a
nullPtr
                Ptr Pcre2_match_context
ctxPtr
                (Ptr Word8 -> Ptr CUChar
toCUs Ptr Word8
replPtr)
                (I8 -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
replCUs)
                Ptr CUChar
outBufPtr
                Ptr PCRE2_SIZE
outLenPtr

            checkAndGetOutput :: CInt -> PCRE2_SPTR -> IO (CInt, Text)
            checkAndGetOutput :: CInt -> Ptr CUChar -> IO (CInt, Text)
checkAndGetOutput CInt
0      Ptr CUChar
_         = (CInt, Text) -> IO (CInt, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
0, Text
subject)
            checkAndGetOutput CInt
result Ptr CUChar
outBufPtr = do
                (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0) CInt
result
                PCRE2_SIZE
outLen <- Ptr PCRE2_SIZE -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> IO a
peek Ptr PCRE2_SIZE
outLenPtr
                Text
out <- Ptr Word8 -> I8 -> IO Text
Text.fromPtr (Ptr CUChar -> Ptr Word8
fromCUs Ptr CUChar
outBufPtr) (PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
outLen)
                (CInt, Text) -> IO (CInt, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
result, Text
out)

        MatchTempEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (IORef CalloutState)
matchTempEnvRef :: Maybe (IORef CalloutState)
matchTempEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvRef :: MatchTempEnv -> Maybe (IORef CalloutState)
matchTempEnvCtx :: MatchTempEnv -> Maybe (ForeignPtr Pcre2_match_context)
..} <- MatchEnv -> Text -> IO MatchTempEnv
mkMatchTempEnv MatchEnv
firstMatchEnv Text
subject
        Either (IntMap SubCalloutResult) (CInt, Text)
firstAttempt <- Maybe (ForeignPtr Pcre2_match_context)
-> (Ptr Pcre2_match_context
    -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall a b. Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx ((Ptr Pcre2_match_context
  -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
 -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> (Ptr Pcre2_match_context
    -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_context
ctxPtr ->
            Int
-> (Ptr CUChar
    -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
initOutLen ((Ptr CUChar -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
 -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> (Ptr CUChar
    -> IO (Either (IntMap SubCalloutResult) (CInt, Text)))
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
outBufPtr -> do
                CInt
result <- CUInt -> Ptr Pcre2_match_context -> Ptr CUChar -> IO CInt
run CUInt
pcre2_SUBSTITUTE_OVERFLOW_LENGTH Ptr Pcre2_match_context
ctxPtr Ptr CUChar
outBufPtr
                Maybe (IORef CalloutState) -> IO ()
maybeRethrow Maybe (IORef CalloutState)
matchTempEnvRef
                if CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
pcre2_ERROR_NOMEMORY
                    then IntMap SubCalloutResult
-> Either (IntMap SubCalloutResult) (CInt, Text)
forall a b. a -> Either a b
Left (IntMap SubCalloutResult
 -> Either (IntMap SubCalloutResult) (CInt, Text))
-> IO (IntMap SubCalloutResult)
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (IORef CalloutState)
matchTempEnvRef of
                        Maybe (IORef CalloutState)
Nothing  -> IntMap SubCalloutResult -> IO (IntMap SubCalloutResult)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap SubCalloutResult
forall a. IntMap a
IM.empty
                        Just IORef CalloutState
ref -> CalloutState -> IntMap SubCalloutResult
calloutStateSubsLog (CalloutState -> IntMap SubCalloutResult)
-> IO CalloutState -> IO (IntMap SubCalloutResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CalloutState -> IO CalloutState
forall a. IORef a -> IO a
readIORef IORef CalloutState
ref
                    else (CInt, Text) -> Either (IntMap SubCalloutResult) (CInt, Text)
forall a b. b -> Either a b
Right ((CInt, Text) -> Either (IntMap SubCalloutResult) (CInt, Text))
-> IO (CInt, Text)
-> IO (Either (IntMap SubCalloutResult) (CInt, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> Ptr CUChar -> IO (CInt, Text)
checkAndGetOutput CInt
result Ptr CUChar
outBufPtr

        case Either (IntMap SubCalloutResult) (CInt, Text)
firstAttempt of
            Right (CInt, Text)
resultAndOutput -> (CInt, Text) -> IO (CInt, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt, Text)
resultAndOutput
            Left IntMap SubCalloutResult
subsLog          -> do
                -- The output was bigger than we guessed.  Try again.
                Int
computedOutLen <- PCRE2_SIZE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PCRE2_SIZE -> Int) -> IO PCRE2_SIZE -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PCRE2_SIZE -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> IO a
peek Ptr PCRE2_SIZE
outLenPtr
                let finalMatchEnv :: MatchEnv
finalMatchEnv = MatchEnv
firstMatchEnv{
                        -- Do not run regular callouts again.
                        matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCallout = Maybe (CalloutInfo -> IO CalloutResult)
forall a. Maybe a
Nothing,
                        -- Do not run any substitution callouts run previously.
                        matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout = (SubCalloutInfo -> IO SubCalloutResult)
-> SubCalloutInfo -> IO SubCalloutResult
forall (m :: * -> *).
Monad m =>
(SubCalloutInfo -> m SubCalloutResult)
-> SubCalloutInfo -> m SubCalloutResult
fastFwd ((SubCalloutInfo -> IO SubCalloutResult)
 -> SubCalloutInfo -> IO SubCalloutResult)
-> Maybe (SubCalloutInfo -> IO SubCalloutResult)
-> Maybe (SubCalloutInfo -> IO SubCalloutResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout}
                    fastFwd :: (SubCalloutInfo -> m SubCalloutResult)
-> SubCalloutInfo -> m SubCalloutResult
fastFwd SubCalloutInfo -> m SubCalloutResult
f = \SubCalloutInfo
info ->
                        case IntMap SubCalloutResult
subsLog IntMap SubCalloutResult -> Int -> Maybe SubCalloutResult
forall a. IntMap a -> Int -> Maybe a
IM.!? SubCalloutInfo -> Int
subCalloutSubsCount SubCalloutInfo
info of
                            Just SubCalloutResult
result -> SubCalloutResult -> m SubCalloutResult
forall (m :: * -> *) a. Monad m => a -> m a
return SubCalloutResult
result
                            Maybe SubCalloutResult
Nothing     -> SubCalloutInfo -> m SubCalloutResult
f SubCalloutInfo
info
                MatchTempEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (IORef CalloutState)
matchTempEnvRef :: Maybe (IORef CalloutState)
matchTempEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvRef :: MatchTempEnv -> Maybe (IORef CalloutState)
matchTempEnvCtx :: MatchTempEnv -> Maybe (ForeignPtr Pcre2_match_context)
..} <- MatchEnv -> Text -> IO MatchTempEnv
mkMatchTempEnv MatchEnv
finalMatchEnv Text
subject
                Maybe (ForeignPtr Pcre2_match_context)
-> (Ptr Pcre2_match_context -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. Maybe (ForeignPtr a) -> (Ptr a -> IO b) -> IO b
withForeignOrNullPtr Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx ((Ptr Pcre2_match_context -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr Pcre2_match_context -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_context
ctxPtr ->
                    Int -> (Ptr CUChar -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
computedOutLen ((Ptr CUChar -> IO (CInt, Text)) -> IO (CInt, Text))
-> (Ptr CUChar -> IO (CInt, Text)) -> IO (CInt, Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
outBufPtr -> do
                        CInt
result <- CUInt -> Ptr Pcre2_match_context -> Ptr CUChar -> IO CInt
run CUInt
0 Ptr Pcre2_match_context
ctxPtr Ptr CUChar
outBufPtr
                        Maybe (IORef CalloutState) -> IO ()
maybeRethrow Maybe (IORef CalloutState)
matchTempEnvRef
                        CInt -> Ptr CUChar -> IO (CInt, Text)
checkAndGetOutput CInt
result Ptr CUChar
outBufPtr

    where
    -- Guess the size of the output to be <= 2x that of the subject.
    initOutLen :: Int
initOutLen = Text -> Int
Text.length Text
subject Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2

-- | Helper to generate substitution function.  For consistency with
-- `pureUserMatcher`.
pureUserSubber :: Option -> Text -> Text -> Subber
pureUserSubber :: Option -> Text -> Text -> Subber
pureUserSubber Option
option Text
patt =
    MatchEnv -> Text -> Subber
subberWithEnv (MatchEnv -> Text -> Subber) -> MatchEnv -> Text -> Subber
forall a b. (a -> b) -> a -> b
$ IO MatchEnv -> MatchEnv
forall a. IO a -> a
unsafePerformIO (IO MatchEnv -> MatchEnv) -> IO MatchEnv -> MatchEnv
forall a b. (a -> b) -> a -> b
$ Option -> Text -> IO MatchEnv
userMatchEnv Option
option Text
patt

-- | Generate per-call data for @pcre2_match()@ etc., to accommodate callouts.
--
-- We need to save and inspect state that occurs in potentially concurrent
-- matches.  This means a new state ref for each match, which means a new
-- `FunPtr` to close on it, which means a new match context to set it to.
mkMatchTempEnv
    :: MatchEnv
    -> Text -- ^ Callout info requires access to the original subject.
    -> IO MatchTempEnv
mkMatchTempEnv :: MatchEnv -> Text -> IO MatchTempEnv
mkMatchTempEnv MatchEnv{Maybe (ForeignPtr Pcre2_match_context)
Maybe (SubCalloutInfo -> IO SubCalloutResult)
Maybe (CalloutInfo -> IO CalloutResult)
Code
CUInt
matchEnvSubCallout :: Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: CUInt
matchEnvCode :: Code
matchEnvSubCallout :: MatchEnv -> Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvCallout :: MatchEnv -> Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCtx :: MatchEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchEnvOpts :: MatchEnv -> CUInt
matchEnvCode :: MatchEnv -> Code
..} Text
subject
    | Maybe (CalloutInfo -> IO CalloutResult) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCallout Bool -> Bool -> Bool
&& Maybe (SubCalloutInfo -> IO SubCalloutResult) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout = MatchTempEnv -> IO MatchTempEnv
forall (m :: * -> *) a. Monad m => a -> m a
return MatchTempEnv :: Maybe (ForeignPtr Pcre2_match_context)
-> Maybe (IORef CalloutState) -> MatchTempEnv
MatchTempEnv{
        matchTempEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx = Maybe (ForeignPtr Pcre2_match_context)
matchEnvCtx,
        matchTempEnvRef :: Maybe (IORef CalloutState)
matchTempEnvRef = Maybe (IORef CalloutState)
forall a. Maybe a
Nothing}

    | Bool
otherwise = do
        IORef CalloutState
stateRef <- CalloutState -> IO (IORef CalloutState)
forall a. a -> IO (IORef a)
newIORef CalloutState :: Maybe SomeException -> IntMap SubCalloutResult -> CalloutState
CalloutState{
            calloutStateException :: Maybe SomeException
calloutStateException = Maybe SomeException
forall a. Maybe a
Nothing,
            calloutStateSubsLog :: IntMap SubCalloutResult
calloutStateSubsLog   = IntMap SubCalloutResult
forall a. IntMap a
IM.empty}

        ForeignPtr Pcre2_match_context
ctx <- (Ptr Pcre2_match_context -> IO ())
-> IO (Ptr Pcre2_match_context)
-> IO (ForeignPtr Pcre2_match_context)
forall a. (Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)
mkForeignPtr Ptr Pcre2_match_context -> IO ()
pcre2_match_context_free (IO (Ptr Pcre2_match_context)
 -> IO (ForeignPtr Pcre2_match_context))
-> IO (Ptr Pcre2_match_context)
-> IO (ForeignPtr Pcre2_match_context)
forall a b. (a -> b) -> a -> b
$ case Maybe (ForeignPtr Pcre2_match_context)
matchEnvCtx of
            -- No pre-existing match context, so create one afresh.
            Maybe (ForeignPtr Pcre2_match_context)
Nothing -> Ptr Pcre2_general_context -> IO (Ptr Pcre2_match_context)
pcre2_match_context_create Ptr Pcre2_general_context
forall a. Ptr a
nullPtr
            -- Pre-existing match context, so copy it.
            Just ForeignPtr Pcre2_match_context
ctx -> ForeignPtr Pcre2_match_context
-> (Ptr Pcre2_match_context -> IO (Ptr Pcre2_match_context))
-> IO (Ptr Pcre2_match_context)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_match_context
ctx Ptr Pcre2_match_context -> IO (Ptr Pcre2_match_context)
pcre2_match_context_copy

        -- Install C function pointers in the @pcre2_match_context@.  When
        -- dereferenced and called, they will force the user-supplied Haskell
        -- callout functions and their results, catching any exceptions and
        -- saving them.

        -- Install callout, if any
        Maybe (CalloutInfo -> IO CalloutResult)
-> ((CalloutInfo -> IO CalloutResult) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (CalloutInfo -> IO CalloutResult)
matchEnvCallout (((CalloutInfo -> IO CalloutResult) -> IO ()) -> IO ())
-> ((CalloutInfo -> IO CalloutResult) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CalloutInfo -> IO CalloutResult
f -> do
            FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
funPtr <- ForeignPtr Pcre2_match_context
-> IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt))
-> IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt))
forall b a. ForeignPtr b -> IO (FunPtr a) -> IO (FunPtr a)
mkFunPtr ForeignPtr Pcre2_match_context
ctx (IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt))
 -> IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)))
-> IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt))
-> IO (FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt))
forall a b. (a -> b) -> a -> b
$ FfiWrapper (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
forall block a. FfiWrapper (Ptr block -> Ptr a -> IO CInt)
mkCallout FfiWrapper (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
-> FfiWrapper (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_callout_block
blockPtr Ptr Any
_ -> do
                CalloutInfo
info <- Text -> Ptr Pcre2_callout_block -> IO CalloutInfo
getCalloutInfo Text
subject Ptr Pcre2_callout_block
blockPtr
                Either SomeException CalloutResult
resultOrE <- IO CalloutResult -> IO (Either SomeException CalloutResult)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO CalloutResult -> IO (Either SomeException CalloutResult))
-> IO CalloutResult -> IO (Either SomeException CalloutResult)
forall a b. (a -> b) -> a -> b
$ CalloutInfo -> IO CalloutResult
f CalloutInfo
info IO CalloutResult
-> (CalloutResult -> IO CalloutResult) -> IO CalloutResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CalloutResult -> IO CalloutResult
forall a. a -> IO a
evaluate
                case Either SomeException CalloutResult
resultOrE of
                    Right CalloutResult
result -> CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ case CalloutResult
result of
                        CalloutResult
CalloutProceed     -> CInt
0
                        CalloutResult
CalloutNoMatchHere -> CInt
1
                        CalloutResult
CalloutNoMatch     -> CInt
pcre2_ERROR_NOMATCH
                    Left SomeException
e -> do
                        IORef CalloutState -> (CalloutState -> CalloutState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef CalloutState
stateRef ((CalloutState -> CalloutState) -> IO ())
-> (CalloutState -> CalloutState) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe SomeException -> Identity (Maybe SomeException))
-> CalloutState -> Identity CalloutState
forall (f :: * -> *).
Functor f =>
(Maybe SomeException -> f (Maybe SomeException))
-> CalloutState -> f CalloutState
_calloutStateException ((Maybe SomeException -> Identity (Maybe SomeException))
 -> CalloutState -> Identity CalloutState)
-> SomeException -> CalloutState -> CalloutState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SomeException
e
                        CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
pcre2_ERROR_CALLOUT
            ForeignPtr Pcre2_match_context
-> (Ptr Pcre2_match_context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_match_context
ctx ((Ptr Pcre2_match_context -> IO ()) -> IO ())
-> (Ptr Pcre2_match_context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_context
ctxPtr ->
                Ptr Pcre2_match_context
-> FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
-> Ptr Any
-> IO CInt
forall a.
Ptr Pcre2_match_context
-> FunPtr (Ptr Pcre2_callout_block -> Ptr a -> IO CInt)
-> Ptr a
-> IO CInt
pcre2_set_callout Ptr Pcre2_match_context
ctxPtr FunPtr (Ptr Pcre2_callout_block -> Ptr Any -> IO CInt)
funPtr Ptr Any
forall a. Ptr a
nullPtr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

        -- Install substitution callout, if any
        Maybe (SubCalloutInfo -> IO SubCalloutResult)
-> ((SubCalloutInfo -> IO SubCalloutResult) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (SubCalloutInfo -> IO SubCalloutResult)
matchEnvSubCallout (((SubCalloutInfo -> IO SubCalloutResult) -> IO ()) -> IO ())
-> ((SubCalloutInfo -> IO SubCalloutResult) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SubCalloutInfo -> IO SubCalloutResult
f -> do
            FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
funPtr <- ForeignPtr Pcre2_match_context
-> IO
     (FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt))
-> IO
     (FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt))
forall b a. ForeignPtr b -> IO (FunPtr a) -> IO (FunPtr a)
mkFunPtr ForeignPtr Pcre2_match_context
ctx (IO
   (FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt))
 -> IO
      (FunPtr
         (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)))
-> IO
     (FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt))
-> IO
     (FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt))
forall a b. (a -> b) -> a -> b
$ FfiWrapper
  (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
forall block a. FfiWrapper (Ptr block -> Ptr a -> IO CInt)
mkCallout FfiWrapper
  (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
-> FfiWrapper
     (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_substitute_callout_block
blockPtr Ptr Any
_ -> do
                SubCalloutInfo
info <- Text -> Ptr Pcre2_substitute_callout_block -> IO SubCalloutInfo
getSubCalloutInfo Text
subject Ptr Pcre2_substitute_callout_block
blockPtr
                Either SomeException SubCalloutResult
resultOrE <- IO SubCalloutResult -> IO (Either SomeException SubCalloutResult)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO SubCalloutResult -> IO (Either SomeException SubCalloutResult))
-> IO SubCalloutResult
-> IO (Either SomeException SubCalloutResult)
forall a b. (a -> b) -> a -> b
$ SubCalloutInfo -> IO SubCalloutResult
f SubCalloutInfo
info IO SubCalloutResult
-> (SubCalloutResult -> IO SubCalloutResult) -> IO SubCalloutResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SubCalloutResult -> IO SubCalloutResult
forall a. a -> IO a
evaluate
                case Either SomeException SubCalloutResult
resultOrE of
                    Right SubCalloutResult
result -> do
                        IORef CalloutState -> (CalloutState -> CalloutState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef CalloutState
stateRef ((CalloutState -> CalloutState) -> IO ())
-> (CalloutState -> CalloutState) -> IO ()
forall a b. (a -> b) -> a -> b
$ ASetter
  CalloutState
  CalloutState
  (IntMap SubCalloutResult)
  (IntMap SubCalloutResult)
-> (IntMap SubCalloutResult -> IntMap SubCalloutResult)
-> CalloutState
-> CalloutState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  CalloutState
  CalloutState
  (IntMap SubCalloutResult)
  (IntMap SubCalloutResult)
forall (f :: * -> *).
Functor f =>
(IntMap SubCalloutResult -> f (IntMap SubCalloutResult))
-> CalloutState -> f CalloutState
_calloutStateSubsLog ((IntMap SubCalloutResult -> IntMap SubCalloutResult)
 -> CalloutState -> CalloutState)
-> (IntMap SubCalloutResult -> IntMap SubCalloutResult)
-> CalloutState
-> CalloutState
forall a b. (a -> b) -> a -> b
$
                            Int
-> SubCalloutResult
-> IntMap SubCalloutResult
-> IntMap SubCalloutResult
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (SubCalloutInfo -> Int
subCalloutSubsCount SubCalloutInfo
info) SubCalloutResult
result
                        CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ case SubCalloutResult
result of
                            SubCalloutResult
SubCalloutAccept ->  CInt
0
                            SubCalloutResult
SubCalloutSkip   ->  CInt
1
                            SubCalloutResult
SubCalloutAbort  -> -CInt
1
                    Left SomeException
e -> do
                        IORef CalloutState -> (CalloutState -> CalloutState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef CalloutState
stateRef ((CalloutState -> CalloutState) -> IO ())
-> (CalloutState -> CalloutState) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe SomeException -> Identity (Maybe SomeException))
-> CalloutState -> Identity CalloutState
forall (f :: * -> *).
Functor f =>
(Maybe SomeException -> f (Maybe SomeException))
-> CalloutState -> f CalloutState
_calloutStateException ((Maybe SomeException -> Identity (Maybe SomeException))
 -> CalloutState -> Identity CalloutState)
-> SomeException -> CalloutState -> CalloutState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SomeException
e
                        CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (-CInt
1)
            ForeignPtr Pcre2_match_context
-> (Ptr Pcre2_match_context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pcre2_match_context
ctx ((Ptr Pcre2_match_context -> IO ()) -> IO ())
-> (Ptr Pcre2_match_context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pcre2_match_context
ctxPtr ->
                Ptr Pcre2_match_context
-> FunPtr
     (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
-> Ptr Any
-> IO CInt
forall a.
Ptr Pcre2_match_context
-> FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr a -> IO CInt)
-> Ptr a
-> IO CInt
pcre2_set_substitute_callout Ptr Pcre2_match_context
ctxPtr FunPtr (Ptr Pcre2_substitute_callout_block -> Ptr Any -> IO CInt)
funPtr Ptr Any
forall a. Ptr a
nullPtr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (CInt -> Bool) -> CInt -> IO ()
check (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

        MatchTempEnv -> IO MatchTempEnv
forall (m :: * -> *) a. Monad m => a -> m a
return MatchTempEnv :: Maybe (ForeignPtr Pcre2_match_context)
-> Maybe (IORef CalloutState) -> MatchTempEnv
MatchTempEnv{
            matchTempEnvCtx :: Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx = ForeignPtr Pcre2_match_context
-> Maybe (ForeignPtr Pcre2_match_context)
forall a. a -> Maybe a
Just ForeignPtr Pcre2_match_context
ctx,
            matchTempEnvRef :: Maybe (IORef CalloutState)
matchTempEnvRef = IORef CalloutState -> Maybe (IORef CalloutState)
forall a. a -> Maybe a
Just IORef CalloutState
stateRef}

-- | Per-call data for @pcre2_match()@ etc.
data MatchTempEnv = MatchTempEnv{
    MatchTempEnv -> Maybe (ForeignPtr Pcre2_match_context)
matchTempEnvCtx :: !(Maybe MatchContext),
    MatchTempEnv -> Maybe (IORef CalloutState)
matchTempEnvRef :: !(Maybe (IORef CalloutState))}

-- | Data computed during callouts that will be stashed in an IORef and
-- inspected after @pcre2_match()@ or similar completes.  `Lens'`s included.
data CalloutState = CalloutState{
    CalloutState -> Maybe SomeException
calloutStateException :: !(Maybe SomeException),
    CalloutState -> IntMap SubCalloutResult
calloutStateSubsLog   :: !(IntMap SubCalloutResult)}

_calloutStateException :: (Maybe SomeException -> f (Maybe SomeException))
-> CalloutState -> f CalloutState
_calloutStateException Maybe SomeException -> f (Maybe SomeException)
f CalloutState{Maybe SomeException
IntMap SubCalloutResult
calloutStateSubsLog :: IntMap SubCalloutResult
calloutStateException :: Maybe SomeException
calloutStateException :: CalloutState -> Maybe SomeException
calloutStateSubsLog :: CalloutState -> IntMap SubCalloutResult
..} =
    Maybe SomeException -> f (Maybe SomeException)
f Maybe SomeException
calloutStateException f (Maybe SomeException)
-> (Maybe SomeException -> CalloutState) -> f CalloutState
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe SomeException
calloutStateException -> CalloutState :: Maybe SomeException -> IntMap SubCalloutResult -> CalloutState
CalloutState{Maybe SomeException
IntMap SubCalloutResult
calloutStateException :: Maybe SomeException
calloutStateSubsLog :: IntMap SubCalloutResult
calloutStateException :: Maybe SomeException
calloutStateSubsLog :: IntMap SubCalloutResult
..}
_calloutStateSubsLog :: (IntMap SubCalloutResult -> f (IntMap SubCalloutResult))
-> CalloutState -> f CalloutState
_calloutStateSubsLog IntMap SubCalloutResult -> f (IntMap SubCalloutResult)
f CalloutState{Maybe SomeException
IntMap SubCalloutResult
calloutStateSubsLog :: IntMap SubCalloutResult
calloutStateException :: Maybe SomeException
calloutStateException :: CalloutState -> Maybe SomeException
calloutStateSubsLog :: CalloutState -> IntMap SubCalloutResult
..} =
    IntMap SubCalloutResult -> f (IntMap SubCalloutResult)
f IntMap SubCalloutResult
calloutStateSubsLog f (IntMap SubCalloutResult)
-> (IntMap SubCalloutResult -> CalloutState) -> f CalloutState
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \IntMap SubCalloutResult
calloutStateSubsLog -> CalloutState :: Maybe SomeException -> IntMap SubCalloutResult -> CalloutState
CalloutState{Maybe SomeException
IntMap SubCalloutResult
calloutStateSubsLog :: IntMap SubCalloutResult
calloutStateException :: Maybe SomeException
calloutStateException :: Maybe SomeException
calloutStateSubsLog :: IntMap SubCalloutResult
..}

foreign import ccall "wrapper" mkRecursionGuard :: FfiWrapper
    (CUInt -> Ptr a -> IO CInt)

foreign import ccall "wrapper" mkCallout :: FfiWrapper
    (Ptr block -> Ptr a -> IO CInt)

-- | Within a callout, marshal the original subject and @pcre2_callout_block@
-- data to Haskell and present to the user function.  Ensure no pointers are
-- leaked!
getCalloutInfo :: Text -> Ptr Pcre2_callout_block -> IO CalloutInfo
getCalloutInfo :: Text -> Ptr Pcre2_callout_block -> IO CalloutInfo
getCalloutInfo Text
calloutSubject Ptr Pcre2_callout_block
blockPtr = do
    CalloutIndex
calloutIndex <- do
        Ptr CUChar
str <- Ptr Pcre2_callout_block -> IO (Ptr CUChar)
pcre2_callout_block_callout_string Ptr Pcre2_callout_block
blockPtr
        if Ptr CUChar
str Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
nullPtr
            then Ptr Pcre2_callout_block -> IO CUInt
pcre2_callout_block_callout_number Ptr Pcre2_callout_block
blockPtr IO CUInt -> (CUInt -> IO CalloutIndex) -> IO CalloutIndex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                -- Auto callout
                CUInt
255 -> (Int -> Int -> CalloutIndex) -> IO Int -> IO Int -> IO CalloutIndex
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> Int -> CalloutIndex
CalloutAuto IO Int
pattPos IO Int
itemLen where
                    pattPos :: IO Int
pattPos = (Ptr Pcre2_callout_block -> IO PCRE2_SIZE) -> IO Int
forall (f :: * -> *) a b.
(Functor f, Integral a, Num b) =>
(Ptr Pcre2_callout_block -> f a) -> f b
intVia Ptr Pcre2_callout_block -> IO PCRE2_SIZE
pcre2_callout_block_pattern_position
                    itemLen :: IO Int
itemLen = (Ptr Pcre2_callout_block -> IO PCRE2_SIZE) -> IO Int
forall (f :: * -> *) a b.
(Functor f, Integral a, Num b) =>
(Ptr Pcre2_callout_block -> f a) -> f b
intVia Ptr Pcre2_callout_block -> IO PCRE2_SIZE
pcre2_callout_block_next_item_length
                    intVia :: (Ptr Pcre2_callout_block -> f a) -> f b
intVia Ptr Pcre2_callout_block -> f a
getter = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Pcre2_callout_block -> f a
getter Ptr Pcre2_callout_block
blockPtr
                -- Numerical callout
                CUInt
number -> CalloutIndex -> IO CalloutIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (CalloutIndex -> IO CalloutIndex)
-> CalloutIndex -> IO CalloutIndex
forall a b. (a -> b) -> a -> b
$ Int -> CalloutIndex
CalloutNumber (Int -> CalloutIndex) -> Int -> CalloutIndex
forall a b. (a -> b) -> a -> b
$ CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
number
            else do
                -- String callout
                PCRE2_SIZE
len <- Ptr Pcre2_callout_block -> IO PCRE2_SIZE
pcre2_callout_block_callout_string_length Ptr Pcre2_callout_block
blockPtr
                Text -> CalloutIndex
CalloutName (Text -> CalloutIndex) -> IO Text -> IO CalloutIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> I8 -> IO Text
Text.fromPtr (Ptr CUChar -> Ptr Word8
fromCUs Ptr CUChar
str) (PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
len)

    NonEmpty (Maybe Text)
calloutCaptures <- do
        Ptr PCRE2_SIZE
ovecPtr <- Ptr Pcre2_callout_block -> IO (Ptr PCRE2_SIZE)
pcre2_callout_block_offset_vector Ptr Pcre2_callout_block
blockPtr
        CUInt
top <- Ptr Pcre2_callout_block -> IO CUInt
pcre2_callout_block_capture_top Ptr Pcre2_callout_block
blockPtr
        NonEmpty Int
-> (Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Int
0 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int
1 .. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
top Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) ((Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text)))
-> (Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text))
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
            [I8
start, I8
end] <- [Int] -> (Int -> IO I8) -> IO [I8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0, Int
1] ((Int -> IO I8) -> IO [I8]) -> (Int -> IO I8) -> IO [I8]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
                PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PCRE2_SIZE -> I8) -> IO PCRE2_SIZE -> IO I8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PCRE2_SIZE -> Int -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PCRE2_SIZE
ovecPtr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
            Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
evaluate (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Slice -> Maybe Text
maybeSmartSlice Text
calloutSubject (Slice -> Maybe Text) -> Slice -> Maybe Text
forall a b. (a -> b) -> a -> b
$ I8 -> I8 -> Slice
Slice I8
start I8
end

    Maybe Text
calloutMark <- do
        Ptr CUChar
ptr <- Ptr Pcre2_callout_block -> IO (Ptr CUChar)
pcre2_callout_block_mark Ptr Pcre2_callout_block
blockPtr
        if Ptr CUChar
ptr Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
nullPtr
            then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
            else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                Int
len <- CUChar -> Ptr CUChar -> IO Int
forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 CUChar
0 Ptr CUChar
ptr
                Ptr Word8 -> I8 -> IO Text
Text.fromPtr (Ptr CUChar -> Ptr Word8
fromCUs Ptr CUChar
ptr) (Int -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

    CUInt
flags <- Ptr Pcre2_callout_block -> IO CUInt
pcre2_callout_block_callout_flags Ptr Pcre2_callout_block
blockPtr
    let calloutIsFirst :: Bool
calloutIsFirst = CUInt
flags CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
pcre2_CALLOUT_STARTMATCH CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0
        calloutBacktracked :: Bool
calloutBacktracked = CUInt
flags CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
pcre2_CALLOUT_BACKTRACK CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0

    CalloutInfo -> IO CalloutInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CalloutInfo :: CalloutIndex
-> NonEmpty (Maybe Text)
-> Text
-> Maybe Text
-> Bool
-> Bool
-> CalloutInfo
CalloutInfo{Bool
Maybe Text
NonEmpty (Maybe Text)
Text
CalloutIndex
calloutBacktracked :: Bool
calloutIsFirst :: Bool
calloutMark :: Maybe Text
calloutCaptures :: NonEmpty (Maybe Text)
calloutIndex :: CalloutIndex
calloutSubject :: Text
calloutBacktracked :: Bool
calloutIsFirst :: Bool
calloutMark :: Maybe Text
calloutSubject :: Text
calloutCaptures :: NonEmpty (Maybe Text)
calloutIndex :: CalloutIndex
..}

-- | Within a substitution callout, marshal the original subject and
-- @pcre2_substitute_callout_block@ data to Haskell and present to the user
-- function.  Ensure no pointers are leaked!
getSubCalloutInfo
    :: Text -> Ptr Pcre2_substitute_callout_block -> IO SubCalloutInfo
getSubCalloutInfo :: Text -> Ptr Pcre2_substitute_callout_block -> IO SubCalloutInfo
getSubCalloutInfo Text
subCalloutSubject Ptr Pcre2_substitute_callout_block
blockPtr = do
    Int
subCalloutSubsCount <-
        CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Pcre2_substitute_callout_block -> IO CUInt
pcre2_substitute_callout_block_subscount Ptr Pcre2_substitute_callout_block
blockPtr

    NonEmpty (Maybe Text)
subCalloutCaptures <- do
        Ptr PCRE2_SIZE
ovecPtr <- Ptr Pcre2_substitute_callout_block -> IO (Ptr PCRE2_SIZE)
pcre2_substitute_callout_block_ovector Ptr Pcre2_substitute_callout_block
blockPtr
        CUInt
ovecCount <- Ptr Pcre2_substitute_callout_block -> IO CUInt
pcre2_substitute_callout_block_oveccount Ptr Pcre2_substitute_callout_block
blockPtr
        NonEmpty Int
-> (Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Int
0 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int
1 .. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
ovecCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) ((Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text)))
-> (Int -> IO (Maybe Text)) -> IO (NonEmpty (Maybe Text))
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
            [I8
start, I8
end] <- [Int] -> (Int -> IO I8) -> IO [I8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0, Int
1] ((Int -> IO I8) -> IO [I8]) -> (Int -> IO I8) -> IO [I8]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
                PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PCRE2_SIZE -> I8) -> IO PCRE2_SIZE -> IO I8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PCRE2_SIZE -> Int -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PCRE2_SIZE
ovecPtr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
            Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
evaluate (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Slice -> Maybe Text
maybeSmartSlice Text
subCalloutSubject (Slice -> Maybe Text) -> Slice -> Maybe Text
forall a b. (a -> b) -> a -> b
$ I8 -> I8 -> Slice
Slice I8
start I8
end

    Text
subCalloutReplacement <- do
        Ptr CUChar
outPtr <- Ptr Pcre2_substitute_callout_block -> IO (Ptr CUChar)
pcre2_substitute_callout_block_output Ptr Pcre2_substitute_callout_block
blockPtr
        Ptr PCRE2_SIZE
offsetsPtr <- Ptr Pcre2_substitute_callout_block -> IO (Ptr PCRE2_SIZE)
pcre2_substitute_callout_block_output_offsets Ptr Pcre2_substitute_callout_block
blockPtr
        [PCRE2_SIZE
start, PCRE2_SIZE
end] <- [Int] -> (Int -> IO PCRE2_SIZE) -> IO [PCRE2_SIZE]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0, Int
1] ((Int -> IO PCRE2_SIZE) -> IO [PCRE2_SIZE])
-> (Int -> IO PCRE2_SIZE) -> IO [PCRE2_SIZE]
forall a b. (a -> b) -> a -> b
$ Ptr PCRE2_SIZE -> Int -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PCRE2_SIZE
offsetsPtr
        Ptr Word8 -> I8 -> IO Text
Text.fromPtr
            (Ptr CUChar -> Ptr Word8
fromCUs (Ptr CUChar -> Ptr Word8) -> Ptr CUChar -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> Int -> Ptr CUChar
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CUChar
outPtr (Int -> Ptr CUChar) -> Int -> Ptr CUChar
forall a b. (a -> b) -> a -> b
$ PCRE2_SIZE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
start)
            (PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PCRE2_SIZE -> I8) -> PCRE2_SIZE -> I8
forall a b. (a -> b) -> a -> b
$ PCRE2_SIZE
end PCRE2_SIZE -> PCRE2_SIZE -> PCRE2_SIZE
forall a. Num a => a -> a -> a
- PCRE2_SIZE
start)

    SubCalloutInfo -> IO SubCalloutInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SubCalloutInfo :: Int -> NonEmpty (Maybe Text) -> Text -> Text -> SubCalloutInfo
SubCalloutInfo{Int
NonEmpty (Maybe Text)
Text
subCalloutReplacement :: Text
subCalloutCaptures :: NonEmpty (Maybe Text)
subCalloutSubsCount :: Int
subCalloutSubject :: Text
subCalloutReplacement :: Text
subCalloutSubject :: Text
subCalloutCaptures :: NonEmpty (Maybe Text)
subCalloutSubsCount :: Int
..}

-- | If there was a callout and it threw an exception, rethrow it.
maybeRethrow :: Maybe (IORef CalloutState) -> IO ()
maybeRethrow :: Maybe (IORef CalloutState) -> IO ()
maybeRethrow = (IORef CalloutState -> IO ())
-> Maybe (IORef CalloutState) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((IORef CalloutState -> IO ())
 -> Maybe (IORef CalloutState) -> IO ())
-> (IORef CalloutState -> IO ())
-> Maybe (IORef CalloutState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ IORef CalloutState -> IO CalloutState
forall a. IORef a -> IO a
readIORef (IORef CalloutState -> IO CalloutState)
-> (CalloutState -> IO ()) -> IORef CalloutState -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (SomeException -> IO Any) -> Maybe SomeException -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SomeException -> IO Any
forall e a. Exception e => e -> IO a
throwIO (Maybe SomeException -> IO ())
-> (CalloutState -> Maybe SomeException) -> CalloutState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalloutState -> Maybe SomeException
calloutStateException

-- * Packaging @Matcher@s and @Subber@s as public API functions

-- | The most general form of a matching function, which can also be used as a
-- @Setter'@ to perform substitutions at the Haskell level.
_gcaptures :: (Traversable t) =>
    Matcher -> FromMatch t -> Traversal' Text (t Text)
_gcaptures :: Matcher -> FromMatch t -> Traversal' Text (t Text)
_gcaptures Matcher
matcher FromMatch t
fromMatch t Text -> f (t Text)
f Text
subject = (t Text -> f (t Text)) -> [t Text] -> f [t Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t Text -> f (t Text)
f [t Text]
captureTs f [t Text] -> ([t Text] -> Text) -> f Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[t Text]
captureTs' ->
    -- Swag foldl-as-foldr to create only as many segments as we need to stitch
    -- back together and no more.
    let beforeAndAfter :: [((Slice, Text), Text)]
beforeAndAfter = [(Slice, Text)] -> [Text] -> [((Slice, Text), Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip
            ((t (Slice, Text) -> [(Slice, Text)])
-> [t (Slice, Text)] -> [(Slice, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap t (Slice, Text) -> [(Slice, Text)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [t (Slice, Text)]
sliceAndCaptureTs)
            ((t Text -> [Text]) -> [t Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap t Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [t Text]
captureTs')
    in [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((Slice, Text), Text) -> (I8 -> [Text]) -> I8 -> [Text])
-> (I8 -> [Text]) -> [((Slice, Text), Text)] -> I8 -> [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Slice, Text), Text) -> (I8 -> [Text]) -> I8 -> [Text]
mkSegments I8 -> [Text]
termSegments [((Slice, Text), Text)]
beforeAndAfter I8
0

    where
    sliceAndCaptureTs :: [t (Slice, Text)]
sliceAndCaptureTs = Stream (t (Slice, Text)) IO Void -> [t (Slice, Text)]
forall b. Stream b IO Void -> [b]
unsafeLazyStreamToList (Stream (t (Slice, Text)) IO Void -> [t (Slice, Text)])
-> Stream (t (Slice, Text)) IO Void -> [t (Slice, Text)]
forall a b. (a -> b) -> a -> b
$
        (Ptr Pcre2_match_data -> IO (t (Slice, Text)))
-> Stream (Ptr Pcre2_match_data) IO Void
-> Stream (t (Slice, Text)) IO Void
forall (m :: * -> *) b c a.
Functor m =>
(b -> m c) -> Stream b m a -> Stream c m a
mapMS (FromMatch t
fromMatch FromMatch t
-> (t Slice -> IO (t (Slice, Text)))
-> Ptr Pcre2_match_data
-> IO (t (Slice, Text))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Slice -> IO (Slice, Text)) -> t Slice -> IO (t (Slice, Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Slice -> IO (Slice, Text)
enrichWithCapture) (Stream (Ptr Pcre2_match_data) IO Void
 -> Stream (t (Slice, Text)) IO Void)
-> Stream (Ptr Pcre2_match_data) IO Void
-> Stream (t (Slice, Text)) IO Void
forall a b. (a -> b) -> a -> b
$ Matcher
matcher Text
subject
    enrichWithCapture :: Slice -> IO (Slice, Text)
enrichWithCapture Slice
slice = do
        Text
capture <- Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Slice -> Text
smartSlice Text
subject Slice
slice
        (Slice, Text) -> IO (Slice, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Slice
slice, Text
capture)
    captureTs :: [t Text]
captureTs = (t (Slice, Text) -> t Text) -> [t (Slice, Text)] -> [t Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Slice, Text) -> Text
forall a b. (a, b) -> b
snd ((Slice, Text) -> Text) -> t (Slice, Text) -> t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [t (Slice, Text)]
sliceAndCaptureTs

    mkSegments :: ((Slice, Text), Text) -> (I8 -> [Text]) -> I8 -> [Text]
mkSegments ((Slice I8
off I8
offEnd, Text
c), Text
c') I8 -> [Text]
r I8
prevOffEnd
        | I8
off I8 -> I8 -> Bool
forall a. Eq a => a -> a -> Bool
== PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
pcre2_UNSET Bool -> Bool -> Bool
|| Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c' =
            -- This substring is unset or unchanged.  Keep going without making
            -- cuts.
            I8 -> [Text]
r I8
prevOffEnd
        | Bool
otherwise =
            -- Emit the subject up until here, and the new substring, and keep
            -- going, remembering where we are now.
            Text -> Slice -> Text
thinSlice Text
subject (I8 -> I8 -> Slice
Slice I8
prevOffEnd I8
off) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
c' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: I8 -> [Text]
r I8
offEnd
    termSegments :: I8 -> [Text]
termSegments I8
off =
        let offEnd :: I8
offEnd = Int -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> I8) -> Int -> I8
forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
subject
        -- If the terminal segment is empty, omit it altogether.  That way,
        -- Text.concat can just return the subject without copying anything in
        -- cases where no substring is changed.
        in [Text -> Slice -> Text
thinSlice Text
subject (I8 -> I8 -> Slice
Slice I8
off I8
offEnd) | I8
off I8 -> I8 -> Bool
forall a. Eq a => a -> a -> Bool
/= I8
offEnd]

-- | A function that takes a C match result and extracts captures into a
-- container.  We need to pass this effectful callback to `_gcaptures` because
-- of the latter's imperative loop that reuses the same @pcre2_match_data@
-- block.
--
-- The container type is polymorphic and in practice carries a `Traversable`
-- constraint.  Currently the following containers are used:
--
-- * `NonEmpty` when we want multiple capture groups;
--
-- * `Identity` when we only want the 0th;
--
-- * `Proxy` when we are only checking if a match succeeded;
--
-- * @[]@ when we want to easily pattern match specific capture groups via
--   Template Haskell-generated @ViewPatterns@.
type FromMatch t = Ptr Pcre2_match_data -> IO (t Slice)

-- | Read all specifically indexed captures' offsets from match results.
getWhitelistedSlices :: (Traversable t) => t Int -> FromMatch t
getWhitelistedSlices :: t Int -> FromMatch t
getWhitelistedSlices t Int
whitelist Ptr Pcre2_match_data
matchDataPtr = do
    Ptr PCRE2_SIZE
ovecPtr <- Ptr Pcre2_match_data -> IO (Ptr PCRE2_SIZE)
pcre2_get_ovector_pointer Ptr Pcre2_match_data
matchDataPtr
    let peekOvec :: Int -> IO Text.I8
        peekOvec :: Int -> IO I8
peekOvec = (PCRE2_SIZE -> I8) -> IO PCRE2_SIZE -> IO I8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PCRE2_SIZE -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO PCRE2_SIZE -> IO I8) -> (Int -> IO PCRE2_SIZE) -> Int -> IO I8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PCRE2_SIZE -> Int -> IO PCRE2_SIZE
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PCRE2_SIZE
ovecPtr

    t Int -> (Int -> IO Slice) -> IO (t Slice)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t Int
whitelist ((Int -> IO Slice) -> IO (t Slice))
-> (Int -> IO Slice) -> IO (t Slice)
forall a b. (a -> b) -> a -> b
$ \Int
i -> I8 -> I8 -> Slice
Slice
        (I8 -> I8 -> Slice) -> IO I8 -> IO (I8 -> Slice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO I8
peekOvec (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
        IO (I8 -> Slice) -> IO I8 -> IO Slice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO I8
peekOvec (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Read just the 0th capture's offsets from match results.
get0thSlice :: FromMatch Identity
get0thSlice :: FromMatch Identity
get0thSlice = Identity Int -> FromMatch Identity
forall (t :: * -> *). Traversable t => t Int -> FromMatch t
getWhitelistedSlices (Identity Int -> FromMatch Identity)
-> Identity Int -> FromMatch Identity
forall a b. (a -> b) -> a -> b
$ Int -> Identity Int
forall a. a -> Identity a
Identity Int
0

-- | Read all captures' offsets from match results.
getAllSlices :: FromMatch NonEmpty
getAllSlices :: FromMatch NonEmpty
getAllSlices Ptr Pcre2_match_data
matchDataPtr = do
    Int
count <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Pcre2_match_data -> IO CUInt
pcre2_get_ovector_count Ptr Pcre2_match_data
matchDataPtr
    let whitelist :: NonEmpty Int
whitelist = Int
0 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int
1 .. Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

    NonEmpty Int -> FromMatch NonEmpty
forall (t :: * -> *). Traversable t => t Int -> FromMatch t
getWhitelistedSlices NonEmpty Int
whitelist Ptr Pcre2_match_data
matchDataPtr

-- | Placeholder for building a `Traversal'` to be passed to `has`.
getNoSlices :: FromMatch Proxy
getNoSlices :: FromMatch Proxy
getNoSlices Ptr Pcre2_match_data
_ = Proxy Slice -> IO (Proxy Slice)
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy Slice
forall k (t :: k). Proxy t
Proxy

-- | Match a pattern to a subject and return some non-empty list(s) of captures
-- in an `Alternative`, or `empty` if no match.  The non-empty list constructor
-- `:|` serves as a cue to differentiate the 0th capture from the others:
--
-- > let parseDate = captures "(\\d{4})-(\\d{2})-(\\d{2})"
-- > in case parseDate "submitted 2020-10-20" of
-- >     Just (date :| [y, m, d]) -> ...
-- >     Nothing                  -> putStrLn "didn't match"
--
-- @since 2.0.0
captures :: (Alternative f) => Text -> Text -> f (NonEmpty Text)
captures :: Text -> Text -> f (NonEmpty Text)
captures = Option -> Text -> Text -> f (NonEmpty Text)
forall (f :: * -> *).
Alternative f =>
Option -> Text -> Text -> f (NonEmpty Text)
capturesOpt Option
forall a. Monoid a => a
mempty

-- | @capturesOpt mempty = captures@
--
-- @since 2.0.0
capturesOpt :: (Alternative f) => Option -> Text -> Text -> f (NonEmpty Text)
capturesOpt :: Option -> Text -> Text -> f (NonEmpty Text)
capturesOpt Option
option Text
patt = Getting (Alt f (NonEmpty Text)) Text (NonEmpty Text)
-> Text -> f (NonEmpty Text)
forall (f :: * -> *) a s.
Alternative f =>
Getting (Alt f a) s a -> s -> f a
toAlternativeOf (Getting (Alt f (NonEmpty Text)) Text (NonEmpty Text)
 -> Text -> f (NonEmpty Text))
-> Getting (Alt f (NonEmpty Text)) Text (NonEmpty Text)
-> Text
-> f (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ Option -> Text -> Traversal' Text (NonEmpty Text)
_capturesOpt Option
option Text
patt

-- | Does the pattern match the subject at least once?
matches :: Text -> Text -> Bool
matches :: Text -> Text -> Bool
matches = Option -> Text -> Text -> Bool
matchesOpt Option
forall a. Monoid a => a
mempty

-- | @matchesOpt mempty = matches@
matchesOpt :: Option -> Text -> Text -> Bool
matchesOpt :: Option -> Text -> Text -> Bool
matchesOpt Option
option Text
patt = Getting Any Text (Proxy Text) -> Text -> Bool
forall s a. Getting Any s a -> s -> Bool
has (Getting Any Text (Proxy Text) -> Text -> Bool)
-> Getting Any Text (Proxy Text) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$
    Matcher -> FromMatch Proxy -> Traversal' Text (Proxy Text)
forall (t :: * -> *).
Traversable t =>
Matcher -> FromMatch t -> Traversal' Text (t Text)
_gcaptures (Option -> Text -> Matcher
pureUserMatcher Option
option Text
patt) FromMatch Proxy
getNoSlices

-- | Match a pattern to a subject and return the portion(s) that matched in an
-- `Alternative`, or `empty` if no match.
--
-- @since 2.0.0
match :: (Alternative f) => Text -> Text -> f Text
match :: Text -> Text -> f Text
match = Option -> Text -> Text -> f Text
forall (f :: * -> *).
Alternative f =>
Option -> Text -> Text -> f Text
matchOpt Option
forall a. Monoid a => a
mempty

-- | @matchOpt mempty = match@
--
-- @since 2.0.0
matchOpt :: (Alternative f) => Option -> Text -> Text -> f Text
matchOpt :: Option -> Text -> Text -> f Text
matchOpt Option
option Text
patt = Getting (Alt f Text) Text Text -> Text -> f Text
forall (f :: * -> *) a s.
Alternative f =>
Getting (Alt f a) s a -> s -> f a
toAlternativeOf (Getting (Alt f Text) Text Text -> Text -> f Text)
-> Getting (Alt f Text) Text Text -> Text -> f Text
forall a b. (a -> b) -> a -> b
$ Option -> Text -> Traversal' Text Text
_matchOpt Option
option Text
patt

-- | Perform at most one substitution.  See
-- [the docs](https://pcre.org/current/doc/html/pcre2api.html#SEC36) for the
-- special syntax of /replacement/.
--
-- >>> sub "(\\w+) calling the (\\w+)" "$2 calling the $1" "the pot calling the kettle black"
-- "the kettle calling the pot black"
sub
    :: Text -- ^ pattern
    -> Text -- ^ replacement
    -> Text -- ^ subject
    -> Text -- ^ result
sub :: Text -> Text -> Text -> Text
sub = Option -> Text -> Text -> Text -> Text
subOpt Option
forall a. Monoid a => a
mempty

-- | Perform substitutions globally.
--
-- >>> gsub "a" "o" "apples and bananas"
-- "opples ond bononos"
gsub :: Text -> Text -> Text -> Text
gsub :: Text -> Text -> Text -> Text
gsub = Option -> Text -> Text -> Text -> Text
subOpt Option
SubGlobal

-- | @
-- subOpt mempty = sub
-- subOpt SubGlobal = gsub
-- @
subOpt :: Option -> Text -> Text -> Text -> Text
subOpt :: Option -> Text -> Text -> Text -> Text
subOpt Option
option Text
patt Text
replacement =
    (CInt, Text) -> Text
forall a b. (a, b) -> b
snd ((CInt, Text) -> Text) -> (Text -> (CInt, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (CInt, Text) -> (CInt, Text)
forall a. IO a -> a
unsafePerformIO (IO (CInt, Text) -> (CInt, Text)) -> Subber -> Text -> (CInt, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Text -> Text -> Subber
pureUserSubber Option
option Text
patt Text
replacement

-- | Given a pattern, produce a traversal (0 or more targets) that focuses from
-- a subject to each non-empty list of captures that pattern matches.
--
-- Substitution works in the following way:  If a capture is set such that the
-- new `Text` is not equal to the old one, a substitution occurs, otherwise it
-- doesn't.  This matters in cases where a capture encloses another
-- capture&#x2014;notably, /all/ parenthesized captures are enclosed by the 0th.
--
-- >>> threeAndMiddle = _captures ". (.) ."
-- >>> "A A A" & threeAndMiddle .~ "A A A" :| ["B"]
-- "A B A"
-- >>> "A A A" & threeAndMiddle .~ "A B A" :| ["A"]
-- "A B A"
--
-- Changing multiple overlapping captures won't do what you want and is
-- unsupported.
--
-- Changing an unset capture is unsupported because the PCRE2 match API does not
-- give location info about it.  Currently we ignore all such attempts.  (Native
-- substitution functions like `sub` do not have this limitation.  See also
-- `SubUnknownUnset` and `SubUnsetEmpty`.)
--
-- If the list becomes longer for some reason, the extra elements are ignored.
-- If it's shortened, the absent elements are considered to be unchanged.
--
-- It's recommended that the list be modified capture-wise, using `ix`.
--
-- > let madlibs = _captures "(\\w+) my (\\w+)"
-- >
-- > print $ "Well bust my buttons!" &~ do
-- >     zoom madlibs $ do
-- >         ix 1 . _head .= 'd'
-- >         ix 2 %= Text.reverse
-- >     _last .= '?'
-- >
-- > -- "Well dust my snottub?"
_captures :: Text -> Traversal' Text (NonEmpty Text)
_captures :: Text -> Traversal' Text (NonEmpty Text)
_captures = Option -> Text -> Traversal' Text (NonEmpty Text)
_capturesOpt Option
forall a. Monoid a => a
mempty

-- | @_capturesOpt mempty = _captures@
_capturesOpt :: Option -> Text -> Traversal' Text (NonEmpty Text)
_capturesOpt :: Option -> Text -> Traversal' Text (NonEmpty Text)
_capturesOpt Option
option Text
patt = Matcher -> FromMatch NonEmpty -> Traversal' Text (NonEmpty Text)
forall (t :: * -> *).
Traversable t =>
Matcher -> FromMatch t -> Traversal' Text (t Text)
_gcaptures (Option -> Text -> Matcher
pureUserMatcher Option
option Text
patt) FromMatch NonEmpty
getAllSlices

-- | Given a pattern, produce a traversal (0 or more targets) that focuses from
-- a subject to the non-overlapping portions of it that match.
--
-- Equivalent to @`_captures` patt . `ix` 0@, but more efficient.
_match :: Text -> Traversal' Text Text
_match :: Text -> Traversal' Text Text
_match = Option -> Text -> Traversal' Text Text
_matchOpt Option
forall a. Monoid a => a
mempty

-- | @_matchOpt mempty = _match@
_matchOpt :: Option -> Text -> Traversal' Text Text
_matchOpt :: Option -> Text -> Traversal' Text Text
_matchOpt Option
option Text
patt =
    Matcher -> FromMatch Identity -> Traversal' Text (Identity Text)
forall (t :: * -> *).
Traversable t =>
Matcher -> FromMatch t -> Traversal' Text (t Text)
_gcaptures (Option -> Text -> Matcher
pureUserMatcher Option
option Text
patt) FromMatch Identity
get0thSlice ((Identity Text -> f (Identity Text)) -> Text -> f Text)
-> ((Text -> f Text) -> Identity Text -> f (Identity Text))
-> (Text -> f Text)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Identity Text -> f (Identity Text)
forall a. Lens' (Identity a) a
_Identity

-- * Exceptions

-- | The root of the PCRE2 exception hierarchy.
data SomePcre2Exception = forall e. (Exception e) => SomePcre2Exception !e
instance Show SomePcre2Exception where
    show :: SomePcre2Exception -> String
show (SomePcre2Exception e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception SomePcre2Exception

-- | Vanilla PCRE2 exceptions with messages generated by the underlying C
-- library.
newtype Pcre2Exception = Pcre2Exception CInt
instance Show Pcre2Exception where
    show :: Pcre2Exception -> String
show (Pcre2Exception CInt
x) = String
"pcre2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (CInt -> Text
getErrorMessage CInt
x)
instance Exception Pcre2Exception where
    toException :: Pcre2Exception -> SomeException
toException = SomePcre2Exception -> SomeException
forall e. Exception e => e -> SomeException
toException (SomePcre2Exception -> SomeException)
-> (Pcre2Exception -> SomePcre2Exception)
-> Pcre2Exception
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pcre2Exception -> SomePcre2Exception
forall e. Exception e => e -> SomePcre2Exception
SomePcre2Exception
    fromException :: SomeException -> Maybe Pcre2Exception
fromException = SomeException -> Maybe SomePcre2Exception
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SomePcre2Exception)
-> (SomePcre2Exception -> Maybe Pcre2Exception)
-> SomeException
-> Maybe Pcre2Exception
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(SomePcre2Exception e
e) -> e -> Maybe Pcre2Exception
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

-- | PCRE2 compile exceptions.  Along with a message stating the cause, we show
-- the pattern with a cursor pointing at where the error is (if not after the
-- last character).
data Pcre2CompileException = Pcre2CompileException !CInt !Text !PCRE2_SIZE
instance Show Pcre2CompileException where
    show :: Pcre2CompileException -> String
show (Pcre2CompileException CInt
x Text
patt PCRE2_SIZE
offset) =
        String
"pcre2_compile: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (CInt -> Text
getErrorMessage CInt
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
            (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
tab Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
pattLinesMaybeWithCaret
        where
        tab :: Int
tab = Int
20
        pattLinesMaybeWithCaret :: [String]
pattLinesMaybeWithCaret
            | Int
offset' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
Text.length Text
patt = [String]
pattLines
            | Bool
otherwise                   = [(Int, String)] -> [String]
insertCaretLine [(Int, String)]
numberedPattLines
        offset' :: Int
offset' = PCRE2_SIZE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PCRE2_SIZE
offset
        pattLines :: [String]
pattLines = String -> [String]
unchompedLines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
patt
        numberedPattLines :: [(Int, String)]
numberedPattLines = [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [String]
pattLines
        (Int
caretRow, Int
caretCol) = ([(Int, Int)] -> Int -> (Int, Int)
forall a. [a] -> Int -> a
!! Int
offset') ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
            (Int
row, String
line) <- [(Int, String)]
numberedPattLines
            (Int
col, Char
_) <- [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] String
line
            (Int, Int) -> [(Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
row, Int
col)
        insertCaretLine :: [(Int, String)] -> [String]
insertCaretLine = ((Int, String) -> [String]) -> [(Int, String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Int, String) -> [String]) -> [(Int, String)] -> [String])
-> ((Int, String) -> [String]) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ \(Int
n, String
line) -> if
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
caretRow     -> [String
line]
            | String -> Char
forall a. [a] -> a
last String
line Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' -> [String
line, String
caretLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"]
            | Bool
otherwise         -> [String
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n", String
caretLine]
        caretLine :: String
caretLine = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
caretCol Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^"
instance Exception Pcre2CompileException where
    toException :: Pcre2CompileException -> SomeException
toException = SomePcre2Exception -> SomeException
forall e. Exception e => e -> SomeException
toException (SomePcre2Exception -> SomeException)
-> (Pcre2CompileException -> SomePcre2Exception)
-> Pcre2CompileException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pcre2CompileException -> SomePcre2Exception
forall e. Exception e => e -> SomePcre2Exception
SomePcre2Exception
    fromException :: SomeException -> Maybe Pcre2CompileException
fromException = SomeException -> Maybe SomePcre2Exception
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SomePcre2Exception)
-> (SomePcre2Exception -> Maybe Pcre2CompileException)
-> SomeException
-> Maybe Pcre2CompileException
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(SomePcre2Exception e
e) -> e -> Maybe Pcre2CompileException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

-- | Built-in message corresponding to the integer error code.
getErrorMessage :: CInt -> Text
getErrorMessage :: CInt -> Text
getErrorMessage CInt
errorCode = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
    let bufCUs :: Int
bufCUs = Int
120
    Int -> (Ptr CUChar -> IO Text) -> IO Text
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bufCUs ((Ptr CUChar -> IO Text) -> IO Text)
-> (Ptr CUChar -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
bufPtr -> do
        CInt
cus <- CInt -> Ptr CUChar -> PCRE2_SIZE -> IO CInt
pcre2_get_error_message CInt
errorCode Ptr CUChar
bufPtr (Int -> PCRE2_SIZE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufCUs)
        Ptr Word8 -> I8 -> IO Text
Text.fromPtr (Ptr CUChar -> Ptr Word8
fromCUs Ptr CUChar
bufPtr) (CInt -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cus)

-- | Most PCRE2 C functions return an @int@ indicating a possible error.  Test
-- it against a predicate, and throw an exception upon failure.
check :: (CInt -> Bool) -> CInt -> IO ()
check :: (CInt -> Bool) -> CInt -> IO ()
check CInt -> Bool
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> IO () -> IO ())
-> (CInt -> Bool) -> CInt -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Bool
p (CInt -> IO () -> IO ()) -> (CInt -> IO ()) -> CInt -> IO ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pcre2Exception -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Pcre2Exception -> IO ())
-> (CInt -> Pcre2Exception) -> CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Pcre2Exception
Pcre2Exception

-- * PCRE2 compile-time config

-- | Helper for getting PCRE2 compile-time config integers.
getConfigNumeric :: CUInt -> CUInt
getConfigNumeric :: CUInt -> CUInt
getConfigNumeric CUInt
what = IO CUInt -> CUInt
forall a. IO a -> a
unsafePerformIO (IO CUInt -> CUInt) -> IO CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$ (Ptr CUInt -> IO CUInt) -> IO CUInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO CUInt) -> IO CUInt)
-> (Ptr CUInt -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
ptr -> do
    CUInt -> Ptr CUInt -> IO CInt
forall a. CUInt -> Ptr a -> IO CInt
pcre2_config CUInt
what Ptr CUInt
ptr
    Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
ptr

-- | Helper for getting PCRE2 compile-time config strings.
getConfigString :: CUInt -> Maybe Text
getConfigString :: CUInt -> Maybe Text
getConfigString CUInt
what = IO (Maybe Text) -> Maybe Text
forall a. IO a -> a
unsafePerformIO (IO (Maybe Text) -> Maybe Text) -> IO (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ do
    CInt
len <- CUInt -> Ptr Any -> IO CInt
forall a. CUInt -> Ptr a -> IO CInt
pcre2_config CUInt
what Ptr Any
forall a. Ptr a
nullPtr
    if CInt
len CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
pcre2_ERROR_BADOPTION
        then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        -- FIXME Do we really need "+ 1" here?
        -- FIXME allocaBytes looks wrong
        else Int -> (Ptr Word8 -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
len CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) ((Ptr Word8 -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Word8 -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
            CUInt -> Ptr Word8 -> IO CInt
forall a. CUInt -> Ptr a -> IO CInt
pcre2_config CUInt
what Ptr Word8
ptr
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> I8 -> IO Text
Text.fromPtr Ptr Word8
ptr (CInt -> I8
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len I8 -> I8 -> I8
forall a. Num a => a -> a -> a
- I8
1)

-- | See t`Bsr`.
defaultBsr :: Bsr
defaultBsr :: Bsr
defaultBsr = CUInt -> Bsr
bsrFromC (CUInt -> Bsr) -> CUInt -> Bsr
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
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 :: [Int]
compiledWidths =
    let bitmap :: CUInt
bitmap = CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_COMPILED_WIDTHS
    in [Int
w | (CUInt
b, Int
w) <- [(CUInt
1, Int
8), (CUInt
2, Int
16), (CUInt
4, Int
32)], CUInt
b CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
bitmap CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0]

-- | See `DepthLimit`.
defaultDepthLimit :: Int
defaultDepthLimit :: Int
defaultDepthLimit = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_DEPTHLIMIT

-- | See `HeapLimit`.
defaultHeapLimit :: Int
defaultHeapLimit :: Int
defaultHeapLimit = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_HEAPLIMIT

-- | Was PCRE2 built with JIT support?
supportsJit :: Bool
supportsJit :: Bool
supportsJit = CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_JIT CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
1

-- | A nice description of the CPU architecture JIT support is compiled for, if
-- any.
jitTarget :: Maybe Text
jitTarget :: Maybe Text
jitTarget = CUInt -> Maybe Text
getConfigString CUInt
pcre2_CONFIG_JITTARGET

-- | Number of bytes used for internal linkage in compiled regexes.
linkSize :: Int
linkSize :: Int
linkSize = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_LINKSIZE

-- | See `MatchLimit`.
defaultMatchLimit :: Int
defaultMatchLimit :: Int
defaultMatchLimit = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_MATCHLIMIT

-- | See t`Newline`.
defaultNewline :: Newline
defaultNewline :: Newline
defaultNewline = CUInt -> Newline
newlineFromC (CUInt -> Newline) -> CUInt -> Newline
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_NEWLINE

-- | See `NeverBackslashC`.
defaultIsNeverBackslashC :: Bool
defaultIsNeverBackslashC :: Bool
defaultIsNeverBackslashC = CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_NEVER_BACKSLASH_C CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
1

-- | See `ParensLimit`.
defaultParensLimit :: Int
defaultParensLimit :: Int
defaultParensLimit = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_PARENSLIMIT

-- | Size in bytes of PCRE2's built-in character processing tables.
defaultTablesLength :: Int
defaultTablesLength :: Int
defaultTablesLength = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> CUInt -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_TABLES_LENGTH

-- | Unicode version string such as @8.0.0@, if Unicode is supported at all.
unicodeVersion :: Maybe Text
unicodeVersion :: Maybe Text
unicodeVersion = case CUInt -> Maybe Text
getConfigString CUInt
pcre2_CONFIG_UNICODE_VERSION of
    Just Text
v | Text -> String
Text.unpack Text
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Unicode not supported" -> Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
maybeV                                            -> Maybe Text
maybeV

-- | Was PCRE2 built with Unicode support?
supportsUnicode :: Bool
supportsUnicode :: Bool
supportsUnicode = CUInt -> CUInt
getConfigNumeric CUInt
pcre2_CONFIG_UNICODE CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
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 :: Text
pcreVersion = case CUInt -> Maybe Text
getConfigString CUInt
pcre2_CONFIG_VERSION of
    Just Text
v  -> Text
v
    Maybe Text
Nothing -> String -> Text
forall a. HasCallStack => String -> a
error String
"pcreVersion: unable to get string"