{-# LINE 1 "src/Text/Regex/PCRE/Wrap.hsc" #-}
module Text.Regex.PCRE.Wrap(
Regex,
CompOption(CompOption),
ExecOption(ExecOption),
(=~),
(=~~),
StartOffset,
EndOffset,
ReturnCode(ReturnCode),
WrapError,
wrapCompile,
wrapTest,
wrapMatch,
wrapMatchAll,
wrapCount,
getVersion,
configUTF8,
getNumSubs,
unusedOffset,
compBlank,
compAnchored,
compAutoCallout,
compCaseless,
compDollarEndOnly,
compDotAll,
compExtended,
compExtra,
compFirstLine,
compMultiline,
compNoAutoCapture,
compUngreedy,
compUTF8,
compNoUTF8Check,
execBlank,
execAnchored,
execNotBOL,
execNotEOL,
execNotEmpty,
execNoUTF8Check,
execPartial,
retOk,
retNoMatch,
retNull,
retBadOption,
retBadMagic,
retUnknownNode,
retNoMemory,
retNoSubstring
) where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))
import Control.Monad(when)
import Data.Array(Array,accumArray)
import Data.Bits(Bits((.|.)))
import System.IO.Unsafe(unsafePerformIO)
import Foreign(Ptr,ForeignPtr,FinalizerPtr
,alloca,allocaBytes,nullPtr
,peek,peekElemOff
,newForeignPtr,withForeignPtr)
import Foreign.C(CChar)
{-# LINE 85 "src/Text/Regex/PCRE/Wrap.hsc" #-}
import Foreign.C(CInt(CInt))
{-# LINE 89 "src/Text/Regex/PCRE/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 StartOffset = MatchOffset
type EndOffset = MatchOffset
type WrapError = (ReturnCode,String)
newtype CompOption = CompOption CInt deriving (CompOption -> CompOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompOption -> CompOption -> Bool
$c/= :: CompOption -> CompOption -> Bool
== :: CompOption -> CompOption -> Bool
$c== :: CompOption -> CompOption -> Bool
Eq,Int -> CompOption -> ShowS
[CompOption] -> ShowS
CompOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompOption] -> ShowS
$cshowList :: [CompOption] -> ShowS
show :: CompOption -> String
$cshow :: CompOption -> String
showsPrec :: Int -> CompOption -> ShowS
$cshowsPrec :: Int -> CompOption -> ShowS
Show,Integer -> CompOption
CompOption -> CompOption
CompOption -> CompOption -> CompOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CompOption
$cfromInteger :: Integer -> CompOption
signum :: CompOption -> CompOption
$csignum :: CompOption -> CompOption
abs :: CompOption -> CompOption
$cabs :: CompOption -> CompOption
negate :: CompOption -> CompOption
$cnegate :: CompOption -> CompOption
* :: CompOption -> CompOption -> CompOption
$c* :: CompOption -> CompOption -> CompOption
- :: CompOption -> CompOption -> CompOption
$c- :: CompOption -> CompOption -> CompOption
+ :: CompOption -> CompOption -> CompOption
$c+ :: CompOption -> CompOption -> CompOption
Num,Eq CompOption
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
popCount :: CompOption -> Int
$cpopCount :: CompOption -> Int
rotateR :: CompOption -> Int -> CompOption
$crotateR :: CompOption -> Int -> CompOption
rotateL :: CompOption -> Int -> CompOption
$crotateL :: CompOption -> Int -> CompOption
unsafeShiftR :: CompOption -> Int -> CompOption
$cunsafeShiftR :: CompOption -> Int -> CompOption
shiftR :: CompOption -> Int -> CompOption
$cshiftR :: CompOption -> Int -> CompOption
unsafeShiftL :: CompOption -> Int -> CompOption
$cunsafeShiftL :: CompOption -> Int -> CompOption
shiftL :: CompOption -> Int -> CompOption
$cshiftL :: CompOption -> Int -> CompOption
isSigned :: CompOption -> Bool
$cisSigned :: CompOption -> Bool
bitSize :: CompOption -> Int
$cbitSize :: CompOption -> Int
bitSizeMaybe :: CompOption -> Maybe Int
$cbitSizeMaybe :: CompOption -> Maybe Int
testBit :: CompOption -> Int -> Bool
$ctestBit :: CompOption -> Int -> Bool
complementBit :: CompOption -> Int -> CompOption
$ccomplementBit :: CompOption -> Int -> CompOption
clearBit :: CompOption -> Int -> CompOption
$cclearBit :: CompOption -> Int -> CompOption
setBit :: CompOption -> Int -> CompOption
$csetBit :: CompOption -> Int -> CompOption
bit :: Int -> CompOption
$cbit :: Int -> CompOption
zeroBits :: CompOption
$czeroBits :: CompOption
rotate :: CompOption -> Int -> CompOption
$crotate :: CompOption -> Int -> CompOption
shift :: CompOption -> Int -> CompOption
$cshift :: CompOption -> Int -> CompOption
complement :: CompOption -> CompOption
$ccomplement :: CompOption -> CompOption
xor :: CompOption -> CompOption -> CompOption
$cxor :: CompOption -> CompOption -> CompOption
.|. :: CompOption -> CompOption -> CompOption
$c.|. :: CompOption -> CompOption -> CompOption
.&. :: CompOption -> CompOption -> CompOption
$c.&. :: CompOption -> CompOption -> CompOption
Bits)
newtype ExecOption = ExecOption CInt deriving (ExecOption -> ExecOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecOption -> ExecOption -> Bool
$c/= :: ExecOption -> ExecOption -> Bool
== :: ExecOption -> ExecOption -> Bool
$c== :: ExecOption -> ExecOption -> Bool
Eq,Int -> ExecOption -> ShowS
[ExecOption] -> ShowS
ExecOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecOption] -> ShowS
$cshowList :: [ExecOption] -> ShowS
show :: ExecOption -> String
$cshow :: ExecOption -> String
showsPrec :: Int -> ExecOption -> ShowS
$cshowsPrec :: Int -> ExecOption -> ShowS
Show,Integer -> ExecOption
ExecOption -> ExecOption
ExecOption -> ExecOption -> ExecOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ExecOption
$cfromInteger :: Integer -> ExecOption
signum :: ExecOption -> ExecOption
$csignum :: ExecOption -> ExecOption
abs :: ExecOption -> ExecOption
$cabs :: ExecOption -> ExecOption
negate :: ExecOption -> ExecOption
$cnegate :: ExecOption -> ExecOption
* :: ExecOption -> ExecOption -> ExecOption
$c* :: ExecOption -> ExecOption -> ExecOption
- :: ExecOption -> ExecOption -> ExecOption
$c- :: ExecOption -> ExecOption -> ExecOption
+ :: ExecOption -> ExecOption -> ExecOption
$c+ :: ExecOption -> ExecOption -> ExecOption
Num,Eq ExecOption
ExecOption
Int -> ExecOption
ExecOption -> Bool
ExecOption -> Int
ExecOption -> Maybe Int
ExecOption -> ExecOption
ExecOption -> Int -> Bool
ExecOption -> Int -> ExecOption
ExecOption -> ExecOption -> ExecOption
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
popCount :: ExecOption -> Int
$cpopCount :: ExecOption -> Int
rotateR :: ExecOption -> Int -> ExecOption
$crotateR :: ExecOption -> Int -> ExecOption
rotateL :: ExecOption -> Int -> ExecOption
$crotateL :: ExecOption -> Int -> ExecOption
unsafeShiftR :: ExecOption -> Int -> ExecOption
$cunsafeShiftR :: ExecOption -> Int -> ExecOption
shiftR :: ExecOption -> Int -> ExecOption
$cshiftR :: ExecOption -> Int -> ExecOption
unsafeShiftL :: ExecOption -> Int -> ExecOption
$cunsafeShiftL :: ExecOption -> Int -> ExecOption
shiftL :: ExecOption -> Int -> ExecOption
$cshiftL :: ExecOption -> Int -> ExecOption
isSigned :: ExecOption -> Bool
$cisSigned :: ExecOption -> Bool
bitSize :: ExecOption -> Int
$cbitSize :: ExecOption -> Int
bitSizeMaybe :: ExecOption -> Maybe Int
$cbitSizeMaybe :: ExecOption -> Maybe Int
testBit :: ExecOption -> Int -> Bool
$ctestBit :: ExecOption -> Int -> Bool
complementBit :: ExecOption -> Int -> ExecOption
$ccomplementBit :: ExecOption -> Int -> ExecOption
clearBit :: ExecOption -> Int -> ExecOption
$cclearBit :: ExecOption -> Int -> ExecOption
setBit :: ExecOption -> Int -> ExecOption
$csetBit :: ExecOption -> Int -> ExecOption
bit :: Int -> ExecOption
$cbit :: Int -> ExecOption
zeroBits :: ExecOption
$czeroBits :: ExecOption
rotate :: ExecOption -> Int -> ExecOption
$crotate :: ExecOption -> Int -> ExecOption
shift :: ExecOption -> Int -> ExecOption
$cshift :: ExecOption -> Int -> ExecOption
complement :: ExecOption -> ExecOption
$ccomplement :: ExecOption -> ExecOption
xor :: ExecOption -> ExecOption -> ExecOption
$cxor :: ExecOption -> ExecOption -> ExecOption
.|. :: ExecOption -> ExecOption -> ExecOption
$c.|. :: ExecOption -> ExecOption -> ExecOption
.&. :: ExecOption -> ExecOption -> ExecOption
$c.&. :: ExecOption -> ExecOption -> ExecOption
Bits)
newtype ReturnCode = ReturnCode CInt deriving (ReturnCode -> ReturnCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnCode -> ReturnCode -> Bool
$c/= :: ReturnCode -> ReturnCode -> Bool
== :: ReturnCode -> ReturnCode -> Bool
$c== :: ReturnCode -> ReturnCode -> Bool
Eq,Int -> ReturnCode -> ShowS
[ReturnCode] -> ShowS
ReturnCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnCode] -> ShowS
$cshowList :: [ReturnCode] -> ShowS
show :: ReturnCode -> String
$cshow :: ReturnCode -> String
showsPrec :: Int -> ReturnCode -> ShowS
$cshowsPrec :: Int -> ReturnCode -> ShowS
Show)
data Regex = Regex (ForeignPtr PCRE) CompOption ExecOption
compBlank :: CompOption
execBlank :: ExecOption
unusedOffset :: MatchOffset
retOk :: ReturnCode
wrapCompile :: CompOption
-> ExecOption
-> CString
-> 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
{-# NOINLINE configUTF8 #-}
configUTF8 :: Bool
(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)
=> source1 -> source -> target
(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,MonadFail m)
=> source1 -> source -> m target
instance RegexOptions Regex CompOption ExecOption where
blankCompOpt :: CompOption
blankCompOpt = CompOption
compBlank
blankExecOpt :: ExecOption
blankExecOpt = ExecOption
execBlank
defaultCompOpt :: CompOption
defaultCompOpt = CompOption
compMultiline
defaultExecOpt :: ExecOption
defaultExecOpt = ExecOption
execBlank
setExecOpts :: ExecOption -> Regex -> Regex
setExecOpts ExecOption
e' (Regex ForeignPtr PCRE
r CompOption
c ExecOption
_) = ForeignPtr PCRE -> CompOption -> ExecOption -> Regex
Regex ForeignPtr PCRE
r CompOption
c ExecOption
e'
getExecOpts :: Regex -> ExecOption
getExecOpts (Regex ForeignPtr PCRE
_ CompOption
_ ExecOption
e) = ExecOption
e
=~ :: forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) source1
x source
r = let q :: Regex
q :: Regex
q = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex source
r
in forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
q source1
x
=~~ :: forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
(=~~) source1
x source
r = do (Regex
q :: Regex) <- forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
source -> m regex
makeRegexM source
r
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
q source1
x
type = ()
fi :: (Integral i,Num n ) => i -> n
fi :: forall i n. (Integral i, Num n) => i -> n
fi i
x = forall i n. (Integral i, Num n) => i -> n
fromIntegral i
x
compBlank :: CompOption
compBlank = CInt -> CompOption
CompOption CInt
0
execBlank :: ExecOption
execBlank = CInt -> ExecOption
ExecOption CInt
0
unusedOffset :: Int
unusedOffset = (-Int
1)
retOk :: ReturnCode
retOk = CInt -> ReturnCode
ReturnCode CInt
0
retNeededMoreSpace :: ReturnCode
retNeededMoreSpace :: ReturnCode
retNeededMoreSpace = CInt -> ReturnCode
ReturnCode CInt
0
newtype InfoWhat = InfoWhat CInt deriving (InfoWhat -> InfoWhat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoWhat -> InfoWhat -> Bool
$c/= :: InfoWhat -> InfoWhat -> Bool
== :: InfoWhat -> InfoWhat -> Bool
$c== :: InfoWhat -> InfoWhat -> Bool
Eq,Int -> InfoWhat -> ShowS
[InfoWhat] -> ShowS
InfoWhat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfoWhat] -> ShowS
$cshowList :: [InfoWhat] -> ShowS
show :: InfoWhat -> String
$cshow :: InfoWhat -> String
showsPrec :: Int -> InfoWhat -> ShowS
$cshowsPrec :: Int -> InfoWhat -> ShowS
Show)
newtype ConfigWhat = ConfigWhat CInt deriving (ConfigWhat -> ConfigWhat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigWhat -> ConfigWhat -> Bool
$c/= :: ConfigWhat -> ConfigWhat -> Bool
== :: ConfigWhat -> ConfigWhat -> Bool
$c== :: ConfigWhat -> ConfigWhat -> Bool
Eq,Int -> ConfigWhat -> ShowS
[ConfigWhat] -> ShowS
ConfigWhat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigWhat] -> ShowS
$cshowList :: [ConfigWhat] -> ShowS
show :: ConfigWhat -> String
$cshow :: ConfigWhat -> String
showsPrec :: Int -> ConfigWhat -> ShowS
$cshowsPrec :: Int -> 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 forall a. Ptr a
nullPtr forall a. Eq a => a -> a -> Bool
== Ptr a
ptr
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Int
0,String
"Ptr parameter was nullPtr in Text.Regex.PCRE.Wrap."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 forall a. Ptr a
nullPtr forall a. Eq a => a -> a -> Bool
== Ptr a
ptr
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (ReturnCode
retOk,String
"Ptr parameter was nullPtr in Text.Regex.PCRE.Wrap."forall a. [a] -> [a] -> [a]
++String
msg))
else IO (Either WrapError b)
io
wrapRC :: ReturnCode -> IO (Either WrapError b)
{-# INLINE wrapRC #-}
wrapRC :: forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (ReturnCode
r,String
"Error in Text.Regex.PCRE.Wrap: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show ReturnCode
r))
wrapCompile :: CompOption
-> ExecOption -> Ptr CChar -> IO (Either (Int, String) Regex)
wrapCompile CompOption
flags ExecOption
e Ptr CChar
pattern = do
forall a b.
Ptr a
-> String
-> IO (Either (Int, String) b)
-> IO (Either (Int, String) b)
nullTest' Ptr CChar
pattern String
"wrapCompile pattern" forall a b. (a -> b) -> a -> b
$ do
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errOffset -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
errPtr -> do
forall a b.
Ptr a
-> String
-> IO (Either (Int, String) b)
-> IO (Either (Int, String) b)
nullTest' Ptr (Ptr CChar)
errPtr String
"wrapCompile errPtr" forall a b. (a -> b) -> a -> b
$ do
Ptr PCRE
pcre_ptr <- Ptr CChar
-> CompOption
-> Ptr (Ptr CChar)
-> Ptr CInt
-> Ptr CChar
-> IO (Ptr PCRE)
c_pcre_compile Ptr CChar
pattern CompOption
flags Ptr (Ptr CChar)
errPtr Ptr CInt
errOffset forall a. Ptr a
nullPtr
if Ptr PCRE
pcre_ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
then do
CInt
offset <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errOffset
String
string <- Ptr CChar -> IO String
peekCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
errPtr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall i n. (Integral i, Num n) => i -> n
fi CInt
offset,String
string))
else do ForeignPtr PCRE
regex <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FinalizerPtr a
c_ptr_free Ptr PCRE
pcre_ptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ForeignPtr PCRE -> CompOption -> ExecOption -> Regex
Regex ForeignPtr PCRE
regex CompOption
flags ExecOption
e
getNumSubs :: Regex -> Int
getNumSubs (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
_) = forall i n. (Integral i, Num n) => i -> n
fi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr Ptr PCRE -> IO CInt
getNumSubs'
getNumSubs' :: Ptr PCRE -> IO CInt
{-# INLINE getNumSubs' #-}
getNumSubs' :: Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
pcre_ptr =
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
st -> do
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (Ptr CInt
st forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Text.Regex.PCRE.Wrap.getNumSubs' could not allocate a CInt!!!")
CInt
ok0 <- forall a. Ptr PCRE -> Ptr PCRE -> InfoWhat -> Ptr a -> IO CInt
c_pcre_fullinfo Ptr PCRE
pcre_ptr forall a. Ptr a
nullPtr InfoWhat
pcreInfoCapturecount Ptr CInt
st
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (CInt
ok0 forall a. Eq a => a -> a -> Bool
/= CInt
0) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Impossible/fatal: Haskell package regex-pcre error in Text.Posix.PCRE.Wrap.getNumSubs' of ok0 /= 0. ok0 is from pcre_fullinfo c-function which returned "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show CInt
ok0)
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
st
wrapTest :: Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
startOffset (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
flags) (Ptr CChar
cstr,Int
len) = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapTest cstr" forall a b. (a -> b) -> a -> b
$ do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr PCRE
-> Ptr CChar
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
pcre_ptr forall a. Ptr a
nullPtr Ptr CChar
cstr (forall i n. (Integral i, Num n) => i -> n
fi Int
len) (forall i n. (Integral i, Num n) => i -> n
fi Int
startOffset) ExecOption
flags forall a. Ptr a
nullPtr CInt
0
if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Bool
False)
else if CInt
r' forall a. Ord a => a -> a -> Bool
< CInt
0
then forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else forall (m :: * -> *) a. Monad m => a -> m a
return (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
_ ExecOption
flags) (Ptr CChar
cstr,Int
len) = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatch cstr" forall a b. (a -> b) -> a -> b
$ do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
pcre_ptr
let nsub_int :: Int
nsub_int :: Int
nsub_int = forall i n. (Integral i, Num n) => i -> n
fi CInt
nsub
ovec_size :: CInt
ovec_size :: CInt
ovec_size = ((CInt
nsub forall a. Num a => a -> a -> a
+ CInt
1) forall a. Num a => a -> a -> a
* CInt
3)
ovec_bytes :: Int
ovec_bytes :: Int
ovec_bytes = (forall i n. (Integral i, Num n) => i -> n
fi CInt
ovec_size) forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 247 "src/Text/Regex/PCRE/Wrap.hsc" #-}
allocaBytes ovec_bytes $ \ovec -> do
nullTest ovec "wrapMatch ovec" $ do
r@(ReturnCode r') <- c_pcre_exec pcre_ptr nullPtr cstr (fi len) (fi startOffset) flags ovec ovec_size
if r == retNoMatch
then return (Right Nothing)
else if r' < 0
then wrapRC r
else do
let pairsSet :: Int
pairsSet = if r == retNeededMoreSpace
then nsub_int + 1
else fi r'
extraPairs :: [(Int,Int)]
extraPairs = replicate (nsub_int + 1 - pairsSet)
(unusedOffset,unusedOffset)
pairs <- return . toPairs =<< mapM (peekElemOff ovec) [0 .. ((pairsSet*2)-1)]
return . Right . Just $ (pairs ++ extraPairs)
wrapMatchAll :: Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
flags) (Ptr CChar
cstr,Int
len) = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatchAll cstr" forall a b. (a -> b) -> a -> b
$ do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
regex -> do
CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
regex
let nsub_int :: Int
nsub_int :: Int
nsub_int = forall i n. (Integral i, Num n) => i -> n
fi CInt
nsub
ovec_size :: CInt
ovec_size :: CInt
ovec_size = ((CInt
nsub forall a. Num a => a -> a -> a
+ CInt
1) forall a. Num a => a -> a -> a
* CInt
3)
ovec_bytes :: Int
ovec_bytes :: Int
ovec_bytes = (forall i n. (Integral i, Num n) => i -> n
fi CInt
ovec_size) forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 279 "src/Text/Regex/PCRE/Wrap.hsc" #-}
clen :: CInt
clen = forall i n. (Integral i, Num n) => i -> n
fi Int
len
flags' :: ExecOption
flags' = (ExecOption
execNotEmpty forall a. Bits a => a -> a -> a
.|. ExecOption
execAnchored forall a. Bits a => a -> a -> a
.|. ExecOption
flags)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ovec_bytes forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ovec ->
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CInt
ovec String
"wrapMatchAll ovec" forall a b. (a -> b) -> a -> b
$
let loop :: ([MatchArray] -> b) -> ExecOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc ExecOption
flags_in_use Int
pos = do
r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr PCRE
-> Ptr CChar
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
regex forall a. Ptr a
nullPtr Ptr CChar
cstr CInt
clen (forall i n. (Integral i, Num n) => i -> n
fi Int
pos) ExecOption
flags_in_use Ptr CInt
ovec CInt
ovec_size
if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc []))
else if CInt
r' forall a. Ord a => a -> a -> Bool
< CInt
0
then forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else do
let pairsSet :: Int
pairsSet = if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNeededMoreSpace then Int
nsub_intforall a. Num a => a -> a -> a
+Int
1 else forall i n. (Integral i, Num n) => i -> n
fi CInt
r'
[(Int, Int)]
pairs <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CInt] -> [(Int, Int)]
toPairs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec) [Int
0 .. ((Int
pairsSetforall a. Num a => a -> a -> a
*Int
2)forall a. Num a => a -> a -> a
-Int
1)]
let acc' :: [MatchArray] -> b
acc' = [MatchArray] -> b
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [(Int, Int)] -> MatchArray
toMatchArray Int
nsub_int [(Int, Int)]
pairsforall a. a -> [a] -> [a]
:)
case [(Int, Int)]
pairs of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc' []))
((Int
s,Int
e):[(Int, Int)]
_) | Int
sforall a. Eq a => a -> a -> Bool
==Int
e -> if Int
s forall a. Eq a => a -> a -> Bool
== Int
len
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc' []))
else ([MatchArray] -> b) -> ExecOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc' ExecOption
flags' Int
e
| Bool
otherwise -> ([MatchArray] -> b) -> ExecOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> b
acc' ExecOption
flags Int
e
in forall {b}.
([MatchArray] -> b) -> ExecOption -> Int -> IO (Either WrapError b)
loop forall a. a -> a
id ExecOption
flags Int
0
toMatchArray :: Int -> [(Int,Int)] -> Array Int (Int,Int)
toMatchArray :: Int -> [(Int, Int)] -> MatchArray
toMatchArray Int
n [(Int, Int)]
pairs = 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
eforall a. Num a => a -> a -> a
-Int
s))) (-Int
1,Int
0) (Int
0,Int
n) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Int, Int)]
pairs)
toPairs :: [CInt] -> [(Int,Int)]
toPairs :: [CInt] -> [(Int, Int)]
toPairs [] = []
toPairs (CInt
a:CInt
b:[CInt]
rest) = (forall i n. (Integral i, Num n) => i -> n
fi CInt
a,forall i n. (Integral i, Num n) => i -> n
fi CInt
b)forall a. a -> [a] -> [a]
:[CInt] -> [(Int, Int)]
toPairs [CInt]
rest
toPairs [CInt
_] = forall a. HasCallStack => String -> a
error String
"Should not have just one element in WrapPCRE.wrapMatchAll.toPairs"
wrapCount :: Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
flags) (Ptr CChar
cstr,Int
len) = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapCount cstr" forall a b. (a -> b) -> a -> b
$ do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcre_fptr forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcre_ptr -> do
CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
pcre_ptr
let ovec_size :: CInt
ovec_size :: CInt
ovec_size = ((CInt
nsub forall a. Num a => a -> a -> a
+ CInt
1) forall a. Num a => a -> a -> a
* CInt
3)
ovec_bytes :: Int
ovec_bytes :: Int
ovec_bytes = (forall i n. (Integral i, Num n) => i -> n
fi CInt
ovec_size) forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 316 "src/Text/Regex/PCRE/Wrap.hsc" #-}
clen :: CInt
clen = forall i n. (Integral i, Num n) => i -> n
fi Int
len
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ovec_bytes forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ovec ->
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CInt
ovec String
"wrapCount ovec" forall a b. (a -> b) -> a -> b
$
let act :: i -> IO ReturnCode
act i
pos = Ptr PCRE
-> Ptr PCRE
-> Ptr CChar
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
pcre_ptr forall a. Ptr a
nullPtr Ptr CChar
cstr CInt
clen (forall i n. (Integral i, Num n) => i -> n
fi i
pos) ExecOption
flags Ptr CInt
ovec CInt
ovec_size
loop :: t -> Int -> IO (Either WrapError t)
loop t
acc Int
pos | t
acc seq :: forall a b. a -> b -> b
`seq` Int
pos seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
| Bool
otherwise = do
r :: ReturnCode
r@(ReturnCode CInt
r') <- forall {i}. Integral i => i -> IO ReturnCode
act Int
pos
if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right t
acc)
else if CInt
r' forall a. Ord a => a -> a -> Bool
< CInt
0
then forall b. ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r
else do
[(Int, Int)]
pairs <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CInt] -> [(Int, Int)]
toPairs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec) [Int
0,Int
1]
case [(Int, Int)]
pairs of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall a. Enum a => a -> a
succ t
acc))
((Int
s,Int
e):[(Int, Int)]
_) | Int
sforall a. Eq a => a -> a -> Bool
==Int
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall a. Enum a => a -> a
succ t
acc))
| Bool
otherwise -> t -> Int -> IO (Either WrapError t)
loop (forall a. Enum a => a -> a
succ t
acc) Int
e
in forall {t}. Enum t => t -> Int -> IO (Either WrapError t)
loop Int
0 Int
0
getVersion :: Maybe String
getVersion = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Ptr CChar
version <- IO (Ptr CChar)
c_pcre_version
if Ptr CChar
version forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
"pcre_version was null")
else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CChar -> IO String
peekCString Ptr CChar
version
configUTF8 :: Bool
configUTF8 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptrVal -> do
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (Ptr CInt
ptrVal forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Text.Regex.PCRE.Wrap.configUTF8 could not alloca CInt!!!")
CInt
_unicodeSupported <- forall a. ConfigWhat -> Ptr a -> IO CInt
c_pcre_config ConfigWhat
pcreConfigUtf8 Ptr CInt
ptrVal
CInt
val <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptrVal
case CInt
val of
(CInt
1 :: CInt) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
CInt
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
CInt
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
foreign import ccall unsafe "pcre.h pcre_compile"
c_pcre_compile :: CString -> CompOption -> Ptr CString -> Ptr CInt -> CString -> IO (Ptr PCRE)
foreign import ccall unsafe "&free"
c_ptr_free :: FinalizerPtr a
foreign import ccall unsafe "pcre.h pcre_exec"
c_pcre_exec :: Ptr PCRE -> Ptr PCRE_Extra -> CString -> CInt -> CInt -> ExecOption -> Ptr CInt -> CInt -> IO ReturnCode
foreign import ccall unsafe "pcre.h pcre_fullinfo"
c_pcre_fullinfo :: Ptr PCRE -> Ptr PCRE_Extra -> InfoWhat -> Ptr a -> IO CInt
foreign import ccall unsafe "pcre.h pcre_version"
c_pcre_version :: IO (Ptr CChar)
foreign import ccall unsafe "pcre.h pcre_config"
c_pcre_config :: ConfigWhat -> Ptr a -> IO CInt
compAnchored :: CompOption
compAnchored :: CompOption
compAnchored = CInt -> CompOption
CompOption CInt
16
compAutoCallout :: CompOption
compAutoCallout :: CompOption
compAutoCallout = CInt -> CompOption
CompOption CInt
16384
compCaseless :: CompOption
compCaseless :: CompOption
compCaseless = CInt -> CompOption
CompOption CInt
1
compDollarEndOnly :: CompOption
compDollarEndOnly :: CompOption
compDollarEndOnly = CInt -> CompOption
CompOption CInt
32
compDotAll :: CompOption
compDotAll :: CompOption
compDotAll = CInt -> CompOption
CompOption CInt
4
compExtended :: CompOption
compExtended :: CompOption
compExtended = CInt -> CompOption
CompOption CInt
8
compExtra :: CompOption
= CInt -> CompOption
CompOption CInt
64
compFirstLine :: CompOption
compFirstLine :: CompOption
compFirstLine = CompOption CInt
262144
compMultiline :: CompOption
compMultiline :: CompOption
compMultiline = CInt -> CompOption
CompOption CInt
2
compNoAutoCapture :: CompOption
compNoAutoCapture :: CompOption
compNoAutoCapture = CInt -> CompOption
CompOption CInt
4096
compUngreedy :: CompOption
compUngreedy :: CompOption
compUngreedy = CompOption CInt
512
compUTF8 :: CompOption
compUTF8 :: CompOption
compUTF8 = CompOption 2048
execNoUTF8Check :: ExecOption
compNoUTF8Check :: CompOption
compNoUTF8Check :: CompOption
compNoUTF8Check = CInt -> CompOption
CompOption CInt
8192
{-# LINE 380 "src/Text/Regex/PCRE/Wrap.hsc" #-}
execAnchored :: ExecOption
execAnchored = ExecOption 16
execNotBOL :: ExecOption
execNotBOL = ExecOption 128
execNotEOL :: ExecOption
execNotEOL = ExecOption 256
execNotEmpty :: ExecOption
execNotEmpty = ExecOption 1024
execNoUTF8Check :: ExecOption
execNoUTF8Check = ExecOption 8192
execPartial :: ExecOption
execPartial = ExecOption 32768
{-# LINE 388 "src/Text/Regex/PCRE/Wrap.hsc" #-}
retNoMatch :: ReturnCode
retNoMatch = ReturnCode (-1)
retNull :: ReturnCode
retNull = ReturnCode (-2)
retBadOption :: ReturnCode
retBadOption = ReturnCode (-3)
retBadMagic :: ReturnCode
retBadMagic :: ReturnCode
retBadMagic = CInt -> ReturnCode
ReturnCode (-CInt
4)
retUnknownNode :: ReturnCode
retUnknownNode :: ReturnCode
retUnknownNode = CInt -> ReturnCode
ReturnCode (-CInt
5)
retNoMemory :: ReturnCode
retNoMemory :: ReturnCode
retNoMemory = CInt -> ReturnCode
ReturnCode (-CInt
6)
retNoSubstring :: ReturnCode
retNoSubstring :: ReturnCode
retNoSubstring = ReturnCode (-7)
{-# LINE 397 "src/Text/Regex/PCRE/Wrap.hsc" #-}
pcreInfoCapturecount :: InfoWhat
pcreInfoCapturecount = InfoWhat 2
{-# LINE 403 "src/Text/Regex/PCRE/Wrap.hsc" #-}
pcreConfigUtf8 :: ConfigWhat
pcreConfigUtf8 :: ConfigWhat
pcreConfigUtf8 = CInt -> ConfigWhat
ConfigWhat CInt
0
{-# LINE 419 "src/Text/Regex/PCRE/Wrap.hsc" #-}