{-# OPTIONS_GHC -optc-DPCRE2_CODE_UNIT_WIDTH=8 #-}
{-# LINE 1 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
module Text.Regex.PCRE2.Wrap(
Regex,
CompOption(CompOption),
MatchOption(MatchOption),
(=~),
(=~~),
StartOffset,
EndOffset,
ReturnCode(ReturnCode),
WrapError,
wrapCompile,
wrapTest,
wrapMatch,
wrapMatchAll,
wrapCount,
getVersion,
getNumSubs,
unusedOffset,
compBlank,
compAnchored,
compEndAnchored,
compAllowEmptyClass,
compAltBSUX,
compAltExtendedClass,
compAltVerbnames,
compAutoCallout,
compCaseless,
compDollarEndOnly,
compDotAll,
compDupNames,
compExtended,
compExtendedMore,
compFirstLine,
compLiteral,
compMatchUnsetBackref,
compMultiline,
compNeverBackslashC,
compNoAutoCapture,
compNoAutoPossess,
compNoDotstarAnchor,
compNoUTFCheck,
compUngreedy,
compUTF,
matchBlank,
matchAnchored,
matchCopyMatchedSubject,
matchDisableRecurseLoopCheck,
matchEndAnchored,
matchNotBOL,
matchNotEOL,
matchNotEmpty,
matchNotEmptyAtStart,
matchNoUTFCheck,
matchPartialHard,
matchPartialSoft,
retOk,
retNoMatch,
retPartial,
retNull,
retBadOption,
retBadMagic,
retNoMemory,
retNoSubstring
) where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))
import Control.Exception(bracket)
import Control.Monad(when)
import Data.Array(Array,accumArray)
import Data.Bits(Bits((.|.)))
import Data.Word(Word32)
import System.IO.Unsafe(unsafePerformIO)
import Foreign(Ptr,ForeignPtr,FinalizerPtr
,alloca,allocaBytes,nullPtr
,mallocBytes,free
,peek,peekElemOff
,newForeignPtr,withForeignPtr)
{-# LINE 101 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
import Foreign.C(CInt(CInt),CSize(CSize))
{-# LINE 105 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
import Foreign.C.String(CString,CStringLen,peekCString)
import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray,MatchOffset)
{-# NOINLINE getVersion #-}
getVersion :: Maybe String
type PCRE = ()
type CompContext = ()
type MatchContext = ()
type MatchData = ()
type StartOffset = MatchOffset
type EndOffset = MatchOffset
type WrapError = (ReturnCode,String)
newtype CompOption = CompOption Word32 deriving (CompOption -> CompOption -> Bool
(CompOption -> CompOption -> Bool)
-> (CompOption -> CompOption -> Bool) -> Eq CompOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompOption -> CompOption -> Bool
== :: CompOption -> CompOption -> Bool
$c/= :: CompOption -> CompOption -> Bool
/= :: CompOption -> CompOption -> Bool
Eq,Int -> CompOption -> ShowS
[CompOption] -> ShowS
CompOption -> String
(Int -> CompOption -> ShowS)
-> (CompOption -> String)
-> ([CompOption] -> ShowS)
-> Show CompOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompOption -> ShowS
showsPrec :: Int -> CompOption -> ShowS
$cshow :: CompOption -> String
show :: CompOption -> String
$cshowList :: [CompOption] -> ShowS
showList :: [CompOption] -> ShowS
Show,Integer -> CompOption
CompOption -> CompOption
CompOption -> CompOption -> CompOption
(CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption)
-> (CompOption -> CompOption)
-> (CompOption -> CompOption)
-> (Integer -> CompOption)
-> Num CompOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: CompOption -> CompOption -> CompOption
+ :: CompOption -> CompOption -> CompOption
$c- :: CompOption -> CompOption -> CompOption
- :: CompOption -> CompOption -> CompOption
$c* :: CompOption -> CompOption -> CompOption
* :: CompOption -> CompOption -> CompOption
$cnegate :: CompOption -> CompOption
negate :: CompOption -> CompOption
$cabs :: CompOption -> CompOption
abs :: CompOption -> CompOption
$csignum :: CompOption -> CompOption
signum :: CompOption -> CompOption
$cfromInteger :: Integer -> CompOption
fromInteger :: Integer -> CompOption
Num,Eq CompOption
CompOption
Eq CompOption =>
(CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption -> CompOption)
-> (CompOption -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> CompOption
-> (Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> Bool)
-> (CompOption -> Maybe Int)
-> (CompOption -> Int)
-> (CompOption -> Bool)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int -> CompOption)
-> (CompOption -> Int)
-> Bits CompOption
Int -> CompOption
CompOption -> Bool
CompOption -> Int
CompOption -> Maybe Int
CompOption -> CompOption
CompOption -> Int -> Bool
CompOption -> Int -> CompOption
CompOption -> CompOption -> CompOption
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: CompOption -> CompOption -> CompOption
.&. :: CompOption -> CompOption -> CompOption
$c.|. :: CompOption -> CompOption -> CompOption
.|. :: CompOption -> CompOption -> CompOption
$cxor :: CompOption -> CompOption -> CompOption
xor :: CompOption -> CompOption -> CompOption
$ccomplement :: CompOption -> CompOption
complement :: CompOption -> CompOption
$cshift :: CompOption -> Int -> CompOption
shift :: CompOption -> Int -> CompOption
$crotate :: CompOption -> Int -> CompOption
rotate :: CompOption -> Int -> CompOption
$czeroBits :: CompOption
zeroBits :: CompOption
$cbit :: Int -> CompOption
bit :: Int -> CompOption
$csetBit :: CompOption -> Int -> CompOption
setBit :: CompOption -> Int -> CompOption
$cclearBit :: CompOption -> Int -> CompOption
clearBit :: CompOption -> Int -> CompOption
$ccomplementBit :: CompOption -> Int -> CompOption
complementBit :: CompOption -> Int -> CompOption
$ctestBit :: CompOption -> Int -> Bool
testBit :: CompOption -> Int -> Bool
$cbitSizeMaybe :: CompOption -> Maybe Int
bitSizeMaybe :: CompOption -> Maybe Int
$cbitSize :: CompOption -> Int
bitSize :: CompOption -> Int
$cisSigned :: CompOption -> Bool
isSigned :: CompOption -> Bool
$cshiftL :: CompOption -> Int -> CompOption
shiftL :: CompOption -> Int -> CompOption
$cunsafeShiftL :: CompOption -> Int -> CompOption
unsafeShiftL :: CompOption -> Int -> CompOption
$cshiftR :: CompOption -> Int -> CompOption
shiftR :: CompOption -> Int -> CompOption
$cunsafeShiftR :: CompOption -> Int -> CompOption
unsafeShiftR :: CompOption -> Int -> CompOption
$crotateL :: CompOption -> Int -> CompOption
rotateL :: CompOption -> Int -> CompOption
$crotateR :: CompOption -> Int -> CompOption
rotateR :: CompOption -> Int -> CompOption
$cpopCount :: CompOption -> Int
popCount :: CompOption -> Int
Bits)
newtype MatchOption = MatchOption Word32 deriving (MatchOption -> MatchOption -> Bool
(MatchOption -> MatchOption -> Bool)
-> (MatchOption -> MatchOption -> Bool) -> Eq MatchOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchOption -> MatchOption -> Bool
== :: MatchOption -> MatchOption -> Bool
$c/= :: MatchOption -> MatchOption -> Bool
/= :: MatchOption -> MatchOption -> Bool
Eq,Int -> MatchOption -> ShowS
[MatchOption] -> ShowS
MatchOption -> String
(Int -> MatchOption -> ShowS)
-> (MatchOption -> String)
-> ([MatchOption] -> ShowS)
-> Show MatchOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchOption -> ShowS
showsPrec :: Int -> MatchOption -> ShowS
$cshow :: MatchOption -> String
show :: MatchOption -> String
$cshowList :: [MatchOption] -> ShowS
showList :: [MatchOption] -> ShowS
Show,Integer -> MatchOption
MatchOption -> MatchOption
MatchOption -> MatchOption -> MatchOption
(MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption)
-> (MatchOption -> MatchOption)
-> (MatchOption -> MatchOption)
-> (Integer -> MatchOption)
-> Num MatchOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MatchOption -> MatchOption -> MatchOption
+ :: MatchOption -> MatchOption -> MatchOption
$c- :: MatchOption -> MatchOption -> MatchOption
- :: MatchOption -> MatchOption -> MatchOption
$c* :: MatchOption -> MatchOption -> MatchOption
* :: MatchOption -> MatchOption -> MatchOption
$cnegate :: MatchOption -> MatchOption
negate :: MatchOption -> MatchOption
$cabs :: MatchOption -> MatchOption
abs :: MatchOption -> MatchOption
$csignum :: MatchOption -> MatchOption
signum :: MatchOption -> MatchOption
$cfromInteger :: Integer -> MatchOption
fromInteger :: Integer -> MatchOption
Num,Eq MatchOption
MatchOption
Eq MatchOption =>
(MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption -> MatchOption)
-> (MatchOption -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> MatchOption
-> (Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> Bool)
-> (MatchOption -> Maybe Int)
-> (MatchOption -> Int)
-> (MatchOption -> Bool)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int -> MatchOption)
-> (MatchOption -> Int)
-> Bits MatchOption
Int -> MatchOption
MatchOption -> Bool
MatchOption -> Int
MatchOption -> Maybe Int
MatchOption -> MatchOption
MatchOption -> Int -> Bool
MatchOption -> Int -> MatchOption
MatchOption -> MatchOption -> MatchOption
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: MatchOption -> MatchOption -> MatchOption
.&. :: MatchOption -> MatchOption -> MatchOption
$c.|. :: MatchOption -> MatchOption -> MatchOption
.|. :: MatchOption -> MatchOption -> MatchOption
$cxor :: MatchOption -> MatchOption -> MatchOption
xor :: MatchOption -> MatchOption -> MatchOption
$ccomplement :: MatchOption -> MatchOption
complement :: MatchOption -> MatchOption
$cshift :: MatchOption -> Int -> MatchOption
shift :: MatchOption -> Int -> MatchOption
$crotate :: MatchOption -> Int -> MatchOption
rotate :: MatchOption -> Int -> MatchOption
$czeroBits :: MatchOption
zeroBits :: MatchOption
$cbit :: Int -> MatchOption
bit :: Int -> MatchOption
$csetBit :: MatchOption -> Int -> MatchOption
setBit :: MatchOption -> Int -> MatchOption
$cclearBit :: MatchOption -> Int -> MatchOption
clearBit :: MatchOption -> Int -> MatchOption
$ccomplementBit :: MatchOption -> Int -> MatchOption
complementBit :: MatchOption -> Int -> MatchOption
$ctestBit :: MatchOption -> Int -> Bool
testBit :: MatchOption -> Int -> Bool
$cbitSizeMaybe :: MatchOption -> Maybe Int
bitSizeMaybe :: MatchOption -> Maybe Int
$cbitSize :: MatchOption -> Int
bitSize :: MatchOption -> Int
$cisSigned :: MatchOption -> Bool
isSigned :: MatchOption -> Bool
$cshiftL :: MatchOption -> Int -> MatchOption
shiftL :: MatchOption -> Int -> MatchOption
$cunsafeShiftL :: MatchOption -> Int -> MatchOption
unsafeShiftL :: MatchOption -> Int -> MatchOption
$cshiftR :: MatchOption -> Int -> MatchOption
shiftR :: MatchOption -> Int -> MatchOption
$cunsafeShiftR :: MatchOption -> Int -> MatchOption
unsafeShiftR :: MatchOption -> Int -> MatchOption
$crotateL :: MatchOption -> Int -> MatchOption
rotateL :: MatchOption -> Int -> MatchOption
$crotateR :: MatchOption -> Int -> MatchOption
rotateR :: MatchOption -> Int -> MatchOption
$cpopCount :: MatchOption -> Int
popCount :: MatchOption -> Int
Bits)
newtype ReturnCode = ReturnCode CInt deriving (ReturnCode -> ReturnCode -> Bool
(ReturnCode -> ReturnCode -> Bool)
-> (ReturnCode -> ReturnCode -> Bool) -> Eq ReturnCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReturnCode -> ReturnCode -> Bool
== :: ReturnCode -> ReturnCode -> Bool
$c/= :: ReturnCode -> ReturnCode -> Bool
/= :: ReturnCode -> ReturnCode -> Bool
Eq,Int -> ReturnCode -> ShowS
[ReturnCode] -> ShowS
ReturnCode -> String
(Int -> ReturnCode -> ShowS)
-> (ReturnCode -> String)
-> ([ReturnCode] -> ShowS)
-> Show ReturnCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReturnCode -> ShowS
showsPrec :: Int -> ReturnCode -> ShowS
$cshow :: ReturnCode -> String
show :: ReturnCode -> String
$cshowList :: [ReturnCode] -> ShowS
showList :: [ReturnCode] -> ShowS
Show)
data Regex = Regex (ForeignPtr PCRE) CompOption MatchOption Int
compBlank :: CompOption
matchBlank :: MatchOption
unusedOffset :: MatchOffset
retOk :: ReturnCode
wrapCompile :: CompOption
-> MatchOption
-> CStringLen
-> IO (Either (MatchOffset,String) Regex)
wrapTest :: StartOffset
-> Regex
-> CStringLen
-> IO (Either WrapError Bool)
wrapMatch :: StartOffset
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(StartOffset,EndOffset)]))
wrapMatchAll :: Regex -> CStringLen -> IO (Either WrapError [ MatchArray ])
wrapCount :: Regex -> CStringLen -> IO (Either WrapError Int)
getNumSubs :: Regex -> Int
(=~) :: (RegexMaker Regex CompOption MatchOption source,RegexContext Regex source1 target)
=> source1 -> source -> target
(=~~) :: (RegexMaker Regex CompOption MatchOption source,RegexContext Regex source1 target,MonadFail m)
=> source1 -> source -> m target
instance RegexOptions Regex CompOption MatchOption where
blankCompOpt :: CompOption
blankCompOpt = CompOption
compBlank
blankExecOpt :: MatchOption
blankExecOpt = MatchOption
matchBlank
defaultCompOpt :: CompOption
defaultCompOpt = CompOption
compMultiline
defaultExecOpt :: MatchOption
defaultExecOpt = MatchOption
matchBlank
setExecOpts :: MatchOption -> Regex -> Regex
setExecOpts MatchOption
e' (Regex ForeignPtr PCRE
r CompOption
c MatchOption
_ Int
n) = ForeignPtr PCRE -> CompOption -> MatchOption -> Int -> Regex
Regex ForeignPtr PCRE
r CompOption
c MatchOption
e' Int
n
getExecOpts :: Regex -> MatchOption
getExecOpts (Regex ForeignPtr PCRE
_ CompOption
_ MatchOption
e Int
_) = MatchOption
e
=~ :: forall source source1 target.
(RegexMaker Regex CompOption MatchOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) source1
x source
r = let q :: Regex
q :: Regex
q = source -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex source
r
in Regex -> source1 -> target
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
q source1
x
=~~ :: forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption MatchOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
(=~~) source1
x source
r = do (Regex
q :: Regex) <- source -> m Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
source -> m regex
forall (m :: * -> *). MonadFail m => source -> m Regex
makeRegexM source
r
Regex -> source1 -> m target
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
forall (m :: * -> *). MonadFail m => Regex -> source1 -> m target
matchM Regex
q source1
x
fi :: (Integral i,Num n) => i -> n
fi :: forall i n. (Integral i, Num n) => i -> n
fi i
x = i -> n
forall i n. (Integral i, Num n) => i -> n
fromIntegral i
x
compBlank :: CompOption
compBlank = Word32 -> CompOption
CompOption Word32
0
matchBlank :: MatchOption
matchBlank = Word32 -> MatchOption
MatchOption Word32
0
unusedOffset :: Int
unusedOffset = (-Int
1)
retOk :: ReturnCode
retOk = CInt -> ReturnCode
ReturnCode CInt
0
newtype InfoWhat = InfoWhat Word32 deriving (InfoWhat -> InfoWhat -> Bool
(InfoWhat -> InfoWhat -> Bool)
-> (InfoWhat -> InfoWhat -> Bool) -> Eq InfoWhat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InfoWhat -> InfoWhat -> Bool
== :: InfoWhat -> InfoWhat -> Bool
$c/= :: InfoWhat -> InfoWhat -> Bool
/= :: InfoWhat -> InfoWhat -> Bool
Eq,Int -> InfoWhat -> ShowS
[InfoWhat] -> ShowS
InfoWhat -> String
(Int -> InfoWhat -> ShowS)
-> (InfoWhat -> String) -> ([InfoWhat] -> ShowS) -> Show InfoWhat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InfoWhat -> ShowS
showsPrec :: Int -> InfoWhat -> ShowS
$cshow :: InfoWhat -> String
show :: InfoWhat -> String
$cshowList :: [InfoWhat] -> ShowS
showList :: [InfoWhat] -> ShowS
Show)
newtype ConfigWhat = ConfigWhat Word32 deriving (ConfigWhat -> ConfigWhat -> Bool
(ConfigWhat -> ConfigWhat -> Bool)
-> (ConfigWhat -> ConfigWhat -> Bool) -> Eq ConfigWhat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigWhat -> ConfigWhat -> Bool
== :: ConfigWhat -> ConfigWhat -> Bool
$c/= :: ConfigWhat -> ConfigWhat -> Bool
/= :: ConfigWhat -> ConfigWhat -> Bool
Eq,Int -> ConfigWhat -> ShowS
[ConfigWhat] -> ShowS
ConfigWhat -> String
(Int -> ConfigWhat -> ShowS)
-> (ConfigWhat -> String)
-> ([ConfigWhat] -> ShowS)
-> Show ConfigWhat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigWhat -> ShowS
showsPrec :: Int -> ConfigWhat -> ShowS
$cshow :: ConfigWhat -> String
show :: ConfigWhat -> String
$cshowList :: [ConfigWhat] -> ShowS
showList :: [ConfigWhat] -> ShowS
Show)
nullTest' :: Ptr a -> String -> IO (Either (MatchOffset,String) b) -> IO (Either (MatchOffset,String) b)
{-# INLINE nullTest' #-}
nullTest' :: forall a b.
Ptr a
-> String
-> IO (Either (Int, String) b)
-> IO (Either (Int, String) b)
nullTest' Ptr a
ptr String
msg IO (Either (Int, String) b)
io = do
if Ptr a
forall a. Ptr a
nullPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
ptr
then Either (Int, String) b -> IO (Either (Int, String) b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, String) -> Either (Int, String) b
forall a b. a -> Either a b
Left (Int
0,String
"Ptr parameter was nullPtr in Text.Regex.PCRE2.Wrap."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg))
else IO (Either (Int, String) b)
io
nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b)
{-# INLINE nullTest #-}
nullTest :: forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr a
ptr String
msg IO (Either WrapError b)
io = do
if Ptr a
forall a. Ptr a
nullPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
ptr
then Either WrapError b -> IO (Either WrapError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError b
forall a b. a -> Either a b
Left (ReturnCode
retOk,String
"Ptr parameter was nullPtr in Text.Regex.PCRE2.Wrap."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg))
else IO (Either WrapError b)
io
getErrMsg :: CInt -> IO String
{-# INLINE getErrMsg #-}
getErrMsg :: CInt -> IO String
getErrMsg CInt
errnum = do
Ptr CChar
errstr <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
1024
if Ptr CChar
forall a. Ptr a
nullPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
errstr
then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Ptr parameter was nullPtr in Text.Regex.PCRE2.Wrap.getErrMsg errstr"
else do
CInt
_ <- CInt -> Ptr CChar -> CSize -> IO CInt
c_pcre2_get_error_message CInt
errnum Ptr CChar
errstr CSize
1024
String
errstr' <- Ptr CChar -> IO String
peekCString Ptr CChar
errstr
Ptr CChar -> IO PCRE
forall a. Ptr a -> IO PCRE
free Ptr CChar
errstr
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
errstr'
wrapRC :: ReturnCode -> IO (Either WrapError b)
{-# INLINE wrapRC #-}
wrapRC :: forall b. ReturnCode -> IO (Either WrapError b)
wrapRC errnum :: ReturnCode
errnum@(ReturnCode CInt
errnum') = do
String
errstr <- CInt -> IO String
getErrMsg CInt
errnum'
Either WrapError b -> IO (Either WrapError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError b
forall a b. a -> Either a b
Left (ReturnCode
errnum,String
"Error in Text.Regex.PCRE2.Wrap: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
errstr))
wrapCompile :: CompOption
-> MatchOption -> CStringLen -> IO (Either (Int, String) Regex)
wrapCompile CompOption
flags MatchOption
e (Ptr CChar
pattern,Int
len) = do
Ptr CChar
-> String
-> IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex)
forall a b.
Ptr a
-> String
-> IO (Either (Int, String) b)
-> IO (Either (Int, String) b)
nullTest' Ptr CChar
pattern String
"wrapCompile pattern" (IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ do
(Ptr CSize -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex))
-> (Ptr CSize -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
errOffset -> (Ptr CInt -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex))
-> (Ptr CInt -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errPtr -> do
Ptr CInt
-> String
-> IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex)
forall a b.
Ptr a
-> String
-> IO (Either (Int, String) b)
-> IO (Either (Int, String) b)
nullTest' Ptr CInt
errPtr String
"wrapCompile errPtr" (IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ do
Ptr PCRE
pcre_ptr <- Ptr CChar
-> CSize
-> CompOption
-> Ptr CInt
-> Ptr CSize
-> Ptr PCRE
-> IO (Ptr PCRE)
c_pcre2_compile Ptr CChar
pattern (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
len) CompOption
flags Ptr CInt
errPtr Ptr CSize
errOffset Ptr PCRE
forall a. Ptr a
nullPtr
if Ptr PCRE
pcre_ptr Ptr PCRE -> Ptr PCRE -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr PCRE
forall a. Ptr a
nullPtr
then do
CSize
offset <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
errOffset
String
errstr <- CInt -> IO String
getErrMsg (CInt -> IO String) -> IO CInt -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errPtr
Either (Int, String) Regex -> IO (Either (Int, String) Regex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, String) -> Either (Int, String) Regex
forall a b. a -> Either a b
Left (CSize -> Int
forall i n. (Integral i, Num n) => i -> n
fi CSize
offset, String
errstr))
else do
(Ptr Int -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex))
-> (Ptr Int -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ \Ptr Int
st -> do
Bool -> IO PCRE -> IO PCRE
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (Ptr Int
st Ptr Int -> Ptr Int -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Int
forall a. Ptr a
nullPtr) (String -> IO PCRE
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Text.Regex.PCRE2.Wrap.wrapCompile could not allocate a CInt for the capture count.")
CInt
ok0 <- Ptr PCRE -> InfoWhat -> Ptr Int -> IO CInt
forall a. Ptr PCRE -> InfoWhat -> Ptr a -> IO CInt
c_pcre2_pattern_info Ptr PCRE
pcre_ptr InfoWhat
pcre2InfoCapturecount Ptr Int
st
Bool -> IO PCRE -> IO PCRE
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (CInt
ok0 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (String -> IO PCRE
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO PCRE) -> String -> IO PCRE
forall a b. (a -> b) -> a -> b
$ String
"Impossible/fatal: Haskell package regex-pcre2 error in Text.Posix.PCRE2.Wrap.getNumSubs' of ok0 /= 0. ok0 is from pcre2_pattern_info c-function which returned "String -> ShowS
forall a. [a] -> [a] -> [a]
++CInt -> String
forall a. Show a => a -> String
show CInt
ok0)
Int
n <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
st
ForeignPtr PCRE
regex <- FinalizerPtr PCRE -> Ptr PCRE -> IO (ForeignPtr PCRE)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr PCRE
c_pcre2_code_free Ptr PCRE
pcre_ptr
Either (Int, String) Regex -> IO (Either (Int, String) Regex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, String) Regex -> IO (Either (Int, String) Regex))
-> (Regex -> Either (Int, String) Regex)
-> Regex
-> IO (Either (Int, String) Regex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> Either (Int, String) Regex
forall a b. b -> Either a b
Right (Regex -> IO (Either (Int, String) Regex))
-> Regex -> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PCRE -> CompOption -> MatchOption -> Int -> Regex
Regex ForeignPtr PCRE
regex CompOption
flags MatchOption
e Int
n
getNumSubs :: Regex -> Int
getNumSubs (Regex ForeignPtr PCRE
_ CompOption
_ MatchOption
_ Int
n) = Int
n
withDataPtr :: IO (Ptr MatchData) -> String -> (Ptr MatchData -> IO (Either WrapError a)) -> IO (Either WrapError a)
withDataPtr :: forall a.
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
withDataPtr IO (Ptr PCRE)
data_create String
jobname Ptr PCRE -> IO (Either WrapError a)
job = IO (Ptr PCRE)
-> (Ptr PCRE -> IO PCRE)
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr PCRE)
data_create Ptr PCRE -> IO PCRE
c_pcre2_match_data_free Ptr PCRE -> IO (Either WrapError a)
job'
where
job' :: Ptr PCRE -> IO (Either WrapError a)
job' Ptr PCRE
dataPtr = Ptr PCRE
-> String -> IO (Either WrapError a) -> IO (Either WrapError a)
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr PCRE
dataPtr (String
jobnameString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" dataPtr") (Ptr PCRE -> IO (Either WrapError a)
job Ptr PCRE
dataPtr)
wrapTest :: Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
startOffset (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ MatchOption
flags Int
_) (Ptr CChar
cstr,Int
len) = do
Ptr CChar
-> String
-> IO (Either WrapError Bool)
-> IO (Either WrapError Bool)
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapTest cstr" (IO (Either WrapError Bool) -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool) -> IO (Either WrapError Bool)
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr PCRE
-> (Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr ((Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool))
-> (Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a.
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
withDataPtr (Word32 -> Ptr PCRE -> IO (Ptr PCRE)
c_pcre2_match_data_create Word32
1 Ptr PCRE
forall a. Ptr a
nullPtr) String
"wrapTest" ((Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool))
-> (Ptr PCRE -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
dataPtr -> do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr CChar
-> CSize
-> CSize
-> MatchOption
-> Ptr PCRE
-> Ptr PCRE
-> IO ReturnCode
c_pcre2_match Ptr PCRE
pcre_ptr Ptr CChar
cstr (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
len) (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
startOffset) MatchOption
flags Ptr PCRE
dataPtr Ptr PCRE
forall a. Ptr a
nullPtr
if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then Either WrapError Bool -> IO (Either WrapError Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either WrapError Bool
forall a b. b -> Either a b
Right Bool
False)
else if CInt
r' CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then ReturnCode -> IO (Either WrapError Bool)
forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else Either WrapError Bool -> IO (Either WrapError Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either WrapError Bool
forall a b. b -> Either a b
Right Bool
True)
wrapMatch :: Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
startOffset (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ MatchOption
flags Int
nsub) (Ptr CChar
cstr,Int
len) = do
Ptr CChar
-> String
-> IO (Either WrapError (Maybe [(Int, Int)]))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatch cstr" (IO (Either WrapError (Maybe [(Int, Int)]))
-> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr PCRE
-> (Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr ((Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)])))
-> (Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a.
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
withDataPtr (Ptr PCRE -> Ptr PCRE -> IO (Ptr PCRE)
c_pcre2_match_data_create_from_pattern Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr) String
"wrapMatch" ((Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)])))
-> (Ptr PCRE -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
dataPtr -> do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr CChar
-> CSize
-> CSize
-> MatchOption
-> Ptr PCRE
-> Ptr PCRE
-> IO ReturnCode
c_pcre2_match Ptr PCRE
pcre_ptr Ptr CChar
cstr (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
len) (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
startOffset) MatchOption
flags Ptr PCRE
dataPtr Ptr PCRE
forall a. Ptr a
nullPtr
if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then do
Either WrapError (Maybe [(Int, Int)])
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(Int, Int)] -> Either WrapError (Maybe [(Int, Int)])
forall a b. b -> Either a b
Right Maybe [(Int, Int)]
forall a. Maybe a
Nothing)
else if CInt
r' CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then ReturnCode -> IO (Either WrapError (Maybe [(Int, Int)]))
forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else do
Int
ovecsize <- Word32 -> Int
forall i n. (Integral i, Num n) => i -> n
fi (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PCRE -> IO Word32
c_pcre2_get_ovector_count Ptr PCRE
dataPtr
Ptr CSize
ovec <- Ptr PCRE -> IO (Ptr CSize)
c_pcre2_get_ovector_pointer Ptr PCRE
dataPtr
let extraPairs :: [(Int,Int)]
extraPairs :: [(Int, Int)]
extraPairs = Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate (Int
nsub Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ovecsize) (Int
unusedOffset,Int
unusedOffset)
[(Int, Int)]
pairs <- [(Int, Int)] -> IO [(Int, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> ([CSize] -> [(Int, Int)]) -> [CSize] -> IO [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CSize] -> [(Int, Int)]
toPairs ([CSize] -> IO [(Int, Int)]) -> IO [CSize] -> IO [(Int, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO CSize) -> [Int] -> IO [CSize]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CSize -> Int -> IO CSize
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSize
ovec) [Int
0 .. ((Int
ovecsizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
Either WrapError (Maybe [(Int, Int)])
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe [(Int, Int)])
-> IO (Either WrapError (Maybe [(Int, Int)])))
-> ([(Int, Int)] -> Either WrapError (Maybe [(Int, Int)]))
-> [(Int, Int)]
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [(Int, Int)] -> Either WrapError (Maybe [(Int, Int)])
forall a b. b -> Either a b
Right (Maybe [(Int, Int)] -> Either WrapError (Maybe [(Int, Int)]))
-> ([(Int, Int)] -> Maybe [(Int, Int)])
-> [(Int, Int)]
-> Either WrapError (Maybe [(Int, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just ([(Int, Int)] -> IO (Either WrapError (Maybe [(Int, Int)])))
-> [(Int, Int)] -> IO (Either WrapError (Maybe [(Int, Int)]))
forall a b. (a -> b) -> a -> b
$ ([(Int, Int)]
pairs [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
extraPairs)
wrapMatchAll :: Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ MatchOption
flags Int
nsub) (Ptr CChar
cstr,Int
len) = do
Ptr CChar
-> String
-> IO (Either WrapError [MatchArray])
-> IO (Either WrapError [MatchArray])
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatchAll cstr" (IO (Either WrapError [MatchArray])
-> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
-> IO (Either WrapError [MatchArray])
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr PCRE
-> (Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr ((Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray]))
-> (Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
let flags' :: MatchOption
flags' = (MatchOption
matchNotEmpty MatchOption -> MatchOption -> MatchOption
forall a. Bits a => a -> a -> a
.|. MatchOption
matchAnchored MatchOption -> MatchOption -> MatchOption
forall a. Bits a => a -> a -> a
.|. MatchOption
flags)
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a.
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
withDataPtr (Ptr PCRE -> Ptr PCRE -> IO (Ptr PCRE)
c_pcre2_match_data_create_from_pattern Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr) String
"wrapMatchAll" ((Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray]))
-> (Ptr PCRE -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
dataPtr ->
let loop :: ([MatchArray] -> b)
-> MatchOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc MatchOption
flags_in_use Int
pos = do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr CChar
-> CSize
-> CSize
-> MatchOption
-> Ptr PCRE
-> Ptr PCRE
-> IO ReturnCode
c_pcre2_match Ptr PCRE
pcre_ptr Ptr CChar
cstr (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
len) (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
pos) MatchOption
flags_in_use Ptr PCRE
dataPtr Ptr PCRE
forall a. Ptr a
nullPtr
if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then Either WrapError b -> IO (Either WrapError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either WrapError b
forall a b. b -> Either a b
Right ([MatchArray] -> b
acc []))
else if CInt
r' CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then ReturnCode -> IO (Either WrapError b)
forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else do
Int
ovecsize <- Word32 -> Int
forall i n. (Integral i, Num n) => i -> n
fi (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PCRE -> IO Word32
c_pcre2_get_ovector_count Ptr PCRE
dataPtr
Ptr CSize
ovec <- Ptr PCRE -> IO (Ptr CSize)
c_pcre2_get_ovector_pointer Ptr PCRE
dataPtr
[(Int, Int)]
pairs <- [(Int, Int)] -> IO [(Int, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> ([CSize] -> [(Int, Int)]) -> [CSize] -> IO [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CSize] -> [(Int, Int)]
toPairs ([CSize] -> IO [(Int, Int)]) -> IO [CSize] -> IO [(Int, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO CSize) -> [Int] -> IO [CSize]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CSize -> Int -> IO CSize
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSize
ovec) [Int
0 .. ((Int
ovecsizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
let acc' :: [MatchArray] -> b
acc' = [MatchArray] -> b
acc ([MatchArray] -> b)
-> ([MatchArray] -> [MatchArray]) -> [MatchArray] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [(Int, Int)] -> MatchArray
toMatchArray Int
nsub [(Int, Int)]
pairsMatchArray -> [MatchArray] -> [MatchArray]
forall a. a -> [a] -> [a]
:)
case [(Int, Int)]
pairs of
[] -> Either WrapError b -> IO (Either WrapError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either WrapError b
forall a b. b -> Either a b
Right ([MatchArray] -> b
acc' []))
((Int
s,Int
e):[(Int, Int)]
_) | Int
sInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
e -> if Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
then Either WrapError b -> IO (Either WrapError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either WrapError b
forall a b. b -> Either a b
Right ([MatchArray] -> b
acc' []))
else ([MatchArray] -> b)
-> MatchOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc' MatchOption
flags' Int
e
| Bool
otherwise -> ([MatchArray] -> b)
-> MatchOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc' MatchOption
flags Int
e
in ([MatchArray] -> [MatchArray])
-> MatchOption -> Int -> IO (Either WrapError [MatchArray])
forall {b}.
([MatchArray] -> b)
-> MatchOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> [MatchArray]
forall a. a -> a
id MatchOption
flags Int
0
toMatchArray :: Int -> [(Int,Int)] -> Array Int (Int,Int)
toMatchArray :: Int -> [(Int, Int)] -> MatchArray
toMatchArray Int
n [(Int, Int)]
pairs = ((Int, Int) -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> (Int, Int) -> [(Int, (Int, Int))] -> MatchArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (\(Int, Int)
_ (Int
s,Int
e) -> (Int
s,(Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s))) (-Int
1,Int
0) (Int
0,Int
n) ([Int] -> [(Int, Int)] -> [(Int, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Int, Int)]
pairs)
toPairs :: [CSize] -> [(Int,Int)]
toPairs :: [CSize] -> [(Int, Int)]
toPairs [] = []
toPairs (CSize
a:CSize
b:[CSize]
rest) = (CSize -> Int
forall i n. (Integral i, Num n) => i -> n
fi CSize
a,CSize -> Int
forall i n. (Integral i, Num n) => i -> n
fi CSize
b)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[CSize] -> [(Int, Int)]
toPairs [CSize]
rest
toPairs [CSize
_] = String -> [(Int, Int)]
forall a. HasCallStack => String -> a
error String
"Should not have just one element in Text.Regex.Wrap.PCRE2.toPairs"
wrapCount :: Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ MatchOption
flags Int
_) (Ptr CChar
cstr,Int
len) = do
Ptr CChar
-> String -> IO (Either WrapError Int) -> IO (Either WrapError Int)
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapCount cstr" (IO (Either WrapError Int) -> IO (Either WrapError Int))
-> IO (Either WrapError Int) -> IO (Either WrapError Int)
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr PCRE
-> (Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr ((Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int))
-> (Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a.
IO (Ptr PCRE)
-> String
-> (Ptr PCRE -> IO (Either WrapError a))
-> IO (Either WrapError a)
withDataPtr (Ptr PCRE -> Ptr PCRE -> IO (Ptr PCRE)
c_pcre2_match_data_create_from_pattern Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr) String
"wrapCount" ((Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int))
-> (Ptr PCRE -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
dataPtr ->
let act :: i -> IO ReturnCode
act i
pos = Ptr PCRE
-> Ptr CChar
-> CSize
-> CSize
-> MatchOption
-> Ptr PCRE
-> Ptr PCRE
-> IO ReturnCode
c_pcre2_match Ptr PCRE
pcre_ptr Ptr CChar
cstr (Int -> CSize
forall i n. (Integral i, Num n) => i -> n
fi Int
len) (i -> CSize
forall i n. (Integral i, Num n) => i -> n
fi i
pos) MatchOption
flags Ptr PCRE
dataPtr Ptr PCRE
forall a. Ptr a
nullPtr
loop :: t -> Int -> IO (Either WrapError t)
loop t
acc Int
pos | t
acc t -> Bool -> Bool
forall a b. a -> b -> b
`seq` Int
pos Int -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = IO (Either WrapError t)
forall a. HasCallStack => a
undefined
| Bool
otherwise = do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Int -> IO ReturnCode
forall {i}. Integral i => i -> IO ReturnCode
act Int
pos
if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then Either WrapError t -> IO (Either WrapError t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Either WrapError t
forall a b. b -> Either a b
Right t
acc)
else if CInt
r' CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then ReturnCode -> IO (Either WrapError t)
forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else do
Ptr CSize
ovec <- Ptr PCRE -> IO (Ptr CSize)
c_pcre2_get_ovector_pointer Ptr PCRE
dataPtr
[(Int, Int)]
pairs <- [(Int, Int)] -> IO [(Int, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> ([CSize] -> [(Int, Int)]) -> [CSize] -> IO [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CSize] -> [(Int, Int)]
toPairs ([CSize] -> IO [(Int, Int)]) -> IO [CSize] -> IO [(Int, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO CSize) -> [Int] -> IO [CSize]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CSize -> Int -> IO CSize
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSize
ovec) [Int
0,Int
1]
case [(Int, Int)]
pairs of
[] -> Either WrapError t -> IO (Either WrapError t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Either WrapError t
forall a b. b -> Either a b
Right (t -> t
forall a. Enum a => a -> a
succ t
acc))
((Int
s,Int
e):[(Int, Int)]
_) | Int
sInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
e -> Either WrapError t -> IO (Either WrapError t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Either WrapError t
forall a b. b -> Either a b
Right (t -> t
forall a. Enum a => a -> a
succ t
acc))
| Bool
otherwise -> t -> Int -> IO (Either WrapError t)
loop (t -> t
forall a. Enum a => a -> a
succ t
acc) Int
e
in Int -> Int -> IO (Either WrapError Int)
forall {t}. Enum t => t -> Int -> IO (Either WrapError t)
loop Int
0 Int
0
getVersion :: Maybe String
getVersion = IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (IO (Maybe String) -> Maybe String)
-> IO (Maybe String) -> Maybe String
forall a b. (a -> b) -> a -> b
$ do
Int
vsize <- ConfigWhat -> Ptr Any -> IO Int
forall a. ConfigWhat -> Ptr a -> IO Int
c_pcre2_config ConfigWhat
pcre2ConfigVersion Ptr Any
forall a. Ptr a
nullPtr
Int -> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
vsize ((Ptr CChar -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
v -> do
if Ptr CChar
v Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else do
Int
_ <- ConfigWhat -> Ptr CChar -> IO Int
forall a. ConfigWhat -> Ptr a -> IO Int
c_pcre2_config ConfigWhat
pcre2ConfigVersion Ptr CChar
v
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO String
peekCString Ptr CChar
v
foreign import ccall unsafe "pcre2.h pcre2_config_8"
c_pcre2_config :: ConfigWhat -> Ptr a -> IO Int
foreign import ccall unsafe "pcre2.h pcre2_compile_8"
c_pcre2_compile :: CString -> CSize -> CompOption -> Ptr CInt -> Ptr CSize -> Ptr CompContext -> IO (Ptr PCRE)
foreign import ccall unsafe "pcre2.h pcre2_get_error_message_8"
c_pcre2_get_error_message :: CInt -> CString -> CSize -> IO CInt
foreign import ccall unsafe "pcre2.h pcre2_pattern_info_8"
c_pcre2_pattern_info :: Ptr PCRE -> InfoWhat -> Ptr a -> IO CInt
foreign import ccall unsafe "pcre2.h &pcre2_code_free_8"
c_pcre2_code_free :: FinalizerPtr PCRE
foreign import ccall unsafe "pcre2.h pcre2_match_data_create_8"
c_pcre2_match_data_create :: Word32 -> Ptr MatchContext -> IO (Ptr MatchData)
foreign import ccall unsafe "pcre2.h pcre2_match_data_create_from_pattern_8"
c_pcre2_match_data_create_from_pattern :: Ptr PCRE -> Ptr MatchContext -> IO (Ptr MatchData)
foreign import ccall unsafe "pcre2.h pcre2_match_8"
c_pcre2_match :: Ptr PCRE -> CString -> CSize -> CSize -> MatchOption -> Ptr MatchData -> Ptr MatchContext -> IO ReturnCode
foreign import ccall unsafe "pcre2.h pcre2_get_ovector_count_8"
c_pcre2_get_ovector_count :: Ptr MatchData -> IO Word32
foreign import ccall unsafe "pcre2.h pcre2_get_ovector_pointer_8"
c_pcre2_get_ovector_pointer :: Ptr MatchData -> IO (Ptr CSize)
foreign import ccall unsafe "pcre2.h pcre2_match_data_free_8"
c_pcre2_match_data_free :: Ptr MatchData -> IO ()
compAllowEmptyClass :: CompOption
compAllowEmptyClass :: CompOption
compAllowEmptyClass = Word32 -> CompOption
CompOption Word32
1
compAltBSUX :: CompOption
compAltBSUX :: CompOption
compAltBSUX = Word32 -> CompOption
CompOption Word32
2
compAltExtendedClass :: CompOption
compAltExtendedClass :: CompOption
compAltExtendedClass = Word32 -> CompOption
CompOption Word32
134217728
compAltVerbnames :: CompOption
compAltVerbnames :: CompOption
compAltVerbnames = Word32 -> CompOption
CompOption Word32
4194304
compAnchored :: CompOption
compAnchored :: CompOption
compAnchored = Word32 -> CompOption
CompOption Word32
2147483648
compAutoCallout :: CompOption
compAutoCallout :: CompOption
compAutoCallout = Word32 -> CompOption
CompOption Word32
4
compCaseless :: CompOption
compCaseless :: CompOption
compCaseless = Word32 -> CompOption
CompOption Word32
8
compDollarEndOnly :: CompOption
compDollarEndOnly :: CompOption
compDollarEndOnly = Word32 -> CompOption
CompOption Word32
16
compDotAll :: CompOption
compDotAll :: CompOption
compDotAll = Word32 -> CompOption
CompOption Word32
32
compDupNames :: CompOption
compDupNames :: CompOption
compDupNames = Word32 -> CompOption
CompOption Word32
64
compEndAnchored :: CompOption
compEndAnchored :: CompOption
compEndAnchored = Word32 -> CompOption
CompOption Word32
536870912
compExtended :: CompOption
compExtended :: CompOption
compExtended = Word32 -> CompOption
CompOption Word32
128
compExtendedMore :: CompOption
compExtendedMore :: CompOption
compExtendedMore = Word32 -> CompOption
CompOption Word32
16777216
compFirstLine :: CompOption
compFirstLine :: CompOption
matchAnchored :: MatchOption
compFirstLine = Word32 -> CompOption
CompOption Word32
256
compLiteral :: CompOption
compLiteral :: CompOption
compLiteral = Word32 -> CompOption
CompOption Word32
33554432
compMatchUnsetBackref :: CompOption
compMatchUnsetBackref :: CompOption
compMatchUnsetBackref = Word32 -> CompOption
CompOption Word32
512
compMultiline :: CompOption
compMultiline :: CompOption
compMultiline = Word32 -> CompOption
CompOption Word32
1024
compNeverBackslashC :: CompOption
compNeverBackslashC :: CompOption
compNeverBackslashC = CompOption 1048576
compNoAutoCapture :: CompOption
compNoAutoCapture :: CompOption
compNoAutoCapture = Word32 -> CompOption
CompOption Word32
8192
compNoAutoPossess :: CompOption
compNoAutoPossess :: CompOption
compNoAutoPossess = Word32 -> CompOption
CompOption Word32
16384
compNoDotstarAnchor :: CompOption
compNoDotstarAnchor :: CompOption
compNoDotstarAnchor = CompOption Word32
32768
compNoUTFCheck :: CompOption
compNoUTFCheck :: CompOption
compNoUTFCheck = Word32 -> CompOption
CompOption Word32
1073741824
compUngreedy :: CompOption
compUngreedy :: CompOption
compUngreedy = CompOption Word32
262144
compUTF :: CompOption
compUTF :: CompOption
compUTF = CompOption Word32
524288
{-# LINE 392 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
matchAnchored :: MatchOption
matchAnchored = MatchOption 2147483648
matchCopyMatchedSubject :: MatchOption
matchCopyMatchedSubject = MatchOption 16384
matchDisableRecurseLoopCheck :: MatchOption
matchDisableRecurseLoopCheck = MatchOption 262144
matchEndAnchored :: MatchOption
matchEndAnchored = MatchOption 536870912
matchNotBOL :: MatchOption
matchNotBOL = MatchOption 1
matchNotEOL :: MatchOption
matchNotEOL = MatchOption 2
matchNotEmpty :: MatchOption
matchNotEmpty = MatchOption 4
matchNotEmptyAtStart :: MatchOption
matchNotEmptyAtStart = MatchOption 8
matchNoUTFCheck :: MatchOption
matchNoUTFCheck = MatchOption 1073741824
matchPartialHard :: MatchOption
matchPartialHard = MatchOption 32
matchPartialSoft :: MatchOption
matchPartialSoft = MatchOption 16
{-# LINE 405 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
retNoMatch :: ReturnCode
retNoMatch = ReturnCode (-1)
retPartial :: ReturnCode
retPartial = ReturnCode (-2)
retNull :: ReturnCode
retNull = ReturnCode (-51)
retBadOption :: ReturnCode
retBadOption = ReturnCode (-34)
retBadMagic :: ReturnCode
retBadMagic = ReturnCode (-31)
retNoMemory :: ReturnCode
retNoMemory :: ReturnCode
retNoMemory = CInt -> ReturnCode
ReturnCode (-CInt
48)
retNoSubstring :: ReturnCode
retNoSubstring :: ReturnCode
retNoSubstring = ReturnCode (-49)
{-# LINE 414 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
pcre2InfoCapturecount :: InfoWhat
pcre2InfoCapturecount = InfoWhat 4
{-# LINE 417 "src/Text/Regex/PCRE2/Wrap.hsc" #-}
pcre2ConfigVersion :: ConfigWhat
pcre2ConfigVersion = ConfigWhat 11
{-# LINE 420 "src/Text/Regex/PCRE2/Wrap.hsc" #-}