{-# LINE 1 "src/Text/Regex/PCRE/Wrap.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-- The exported symbols are the same whether HAVE_PCRE_H is defined,
-- but when if it is not defined then 'getVersion == Nothing' and all
-- other exported values will call error or fail.

-- | This will fail or error only if allocation fails or a nullPtr is passed in.

-- TODO :: Consider wrapMatchAll using list of start/end offsets and not MatchArray
--

{- Copyright   :  (c) Chris Kuklewicz 2007 -}
module Text.Regex.PCRE.Wrap(
  -- ** High-level interface
  Regex,
  CompOption(CompOption),
  ExecOption(ExecOption),
  (=~),
  (=~~),

  -- ** Low-level interface
  StartOffset,
  EndOffset,
  ReturnCode(ReturnCode),
  WrapError,
  wrapCompile,
  wrapTest,
  wrapMatch,
  wrapMatchAll,
  wrapCount,

  -- ** Miscellaneous
  getVersion,
  configUTF8,
  getNumSubs,
  unusedOffset,

  -- ** CompOption values
  compBlank,
  compAnchored,
  compAutoCallout,
  compCaseless,
  compDollarEndOnly,
  compDotAll,
  compExtended,
  compExtra,
  compFirstLine,
  compMultiline,
  compNoAutoCapture,
  compUngreedy,
  compUTF8,
  compNoUTF8Check,

  -- ** ExecOption values
  execBlank,
  execAnchored,
  execNotBOL,
  execNotEOL,
  execNotEmpty,
  execNoUTF8Check,
  execPartial,

  -- ** ReturnCode values
  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((.|.))) -- ((.&.),(.|.),complement))
import System.IO.Unsafe(unsafePerformIO)
import Foreign(Ptr,ForeignPtr,FinalizerPtr -- ,FunPtr
              ,alloca,allocaBytes,nullPtr
              ,peek,peekElemOff
              ,newForeignPtr,withForeignPtr)
import Foreign.C(CInt(..),CChar)
import Foreign.C.String(CString,CStringLen,peekCString)
import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray,MatchOffset)

-- | Version string of PCRE library
--
-- __NOTE__: The 'Maybe' type is used for historic reasons; practically, 'getVersion' is never 'Nothing'.
{-# 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
(CompOption -> CompOption -> Bool)
-> (CompOption -> CompOption -> Bool) -> Eq CompOption
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
(Int -> CompOption -> ShowS)
-> (CompOption -> String)
-> ([CompOption] -> ShowS)
-> Show CompOption
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
(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
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
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
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
$cp1Bits :: Eq CompOption
Bits)
newtype ExecOption = ExecOption CInt deriving (ExecOption -> ExecOption -> Bool
(ExecOption -> ExecOption -> Bool)
-> (ExecOption -> ExecOption -> Bool) -> Eq ExecOption
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
(Int -> ExecOption -> ShowS)
-> (ExecOption -> String)
-> ([ExecOption] -> ShowS)
-> Show ExecOption
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
(ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption)
-> (ExecOption -> ExecOption)
-> (ExecOption -> ExecOption)
-> (Integer -> ExecOption)
-> Num 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
Eq ExecOption
-> (ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption -> ExecOption)
-> (ExecOption -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> ExecOption
-> (Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> Bool)
-> (ExecOption -> Maybe Int)
-> (ExecOption -> Int)
-> (ExecOption -> Bool)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int -> ExecOption)
-> (ExecOption -> Int)
-> Bits 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
$cp1Bits :: Eq ExecOption
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
/= :: ReturnCode -> ReturnCode -> Bool
$c/= :: ReturnCode -> ReturnCode -> Bool
== :: ReturnCode -> ReturnCode -> Bool
$c== :: 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
showList :: [ReturnCode] -> ShowS
$cshowList :: [ReturnCode] -> ShowS
show :: ReturnCode -> String
$cshow :: ReturnCode -> String
showsPrec :: Int -> ReturnCode -> ShowS
$cshowsPrec :: Int -> ReturnCode -> ShowS
Show)

-- | A compiled regular expression
data Regex = Regex (ForeignPtr PCRE) CompOption ExecOption

compBlank :: CompOption
execBlank :: ExecOption
unusedOffset :: MatchOffset
retOk :: ReturnCode

wrapCompile :: CompOption -- ^ Flags (summed together)
            -> ExecOption -- ^ Flags (summed together)
            -> CString  -- ^ The regular expression to compile
            -> IO (Either (MatchOffset,String) Regex) -- ^ Returns: an error offset and string or the compiled regular expression
wrapTest :: StartOffset -- ^ Starting index in CStringLen
         -> Regex       -- ^ Compiled regular expression
         -> CStringLen  -- ^ String to match against and length in bytes
         -> IO (Either WrapError Bool)
wrapMatch :: StartOffset -- ^ Starting index in CStringLen
          -> Regex       -- ^ Compiled regular expression
          -> CStringLen  -- ^ String to match against and length in bytes
          -> IO (Either WrapError (Maybe [(StartOffset,EndOffset)]))
                -- ^ Returns: 'Right Nothing' if the regex did not match the
                -- string, or:
                --   'Right Just' an array of (offset,length) pairs where index 0 is whole match, and the rest are the captured subexpressions, or:
                --   'Left ReturnCode' if there is some strange error
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

-- (=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target) => source1 -> source -> 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

-- (=~~) ::(RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,MonadFail m) => source1 -> source -> m target
=~~ :: 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
makeRegexM source
r
               Regex -> source1 -> m target
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
q source1
x

type PCRE_Extra = ()

fi :: (Integral i,Num n ) => i -> n
fi :: i -> n
fi i
x = i -> n
forall a b. (Integral a, Num b) => a -> b
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
(InfoWhat -> InfoWhat -> Bool)
-> (InfoWhat -> InfoWhat -> Bool) -> Eq InfoWhat
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
(Int -> InfoWhat -> ShowS)
-> (InfoWhat -> String) -> ([InfoWhat] -> ShowS) -> Show InfoWhat
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
(ConfigWhat -> ConfigWhat -> Bool)
-> (ConfigWhat -> ConfigWhat -> Bool) -> Eq ConfigWhat
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
(Int -> ConfigWhat -> ShowS)
-> (ConfigWhat -> String)
-> ([ConfigWhat] -> ShowS)
-> Show ConfigWhat
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' :: 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 (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.PCRE.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 :: 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 (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.PCRE.Wrap."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg))
    else IO (Either WrapError b)
io

wrapRC :: ReturnCode -> IO (Either WrapError b)
{-# INLINE wrapRC #-}
wrapRC :: ReturnCode -> IO (Either WrapError b)
wrapRC ReturnCode
r = Either WrapError b -> IO (Either WrapError b)
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError b
forall a b. a -> Either a b
Left (ReturnCode
r,String
"Error in Text.Regex.PCRE.Wrap: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ReturnCode -> String
forall a. Show a => a -> String
show ReturnCode
r))

-- | Compiles a regular expression
wrapCompile :: CompOption
-> ExecOption -> CString -> IO (Either (Int, String) Regex)
wrapCompile CompOption
flags ExecOption
e CString
pattern = do
 CString
-> 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' CString
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 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
errOffset -> (Ptr CString -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Either (Int, String) Regex))
 -> IO (Either (Int, String) Regex))
-> (Ptr CString -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errPtr -> do
   Ptr CString
-> 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 CString
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 <- CString
-> CompOption
-> Ptr CString
-> Ptr CInt
-> CString
-> IO (Ptr PCRE)
c_pcre_compile CString
pattern CompOption
flags Ptr CString
errPtr Ptr CInt
errOffset CString
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
        -- No need to use c_ptr_free in the error case (e.g. pcredemo.c)
        CInt
offset <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errOffset
        String
string <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errPtr
        Either (Int, String) Regex -> IO (Either (Int, String) Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, String) -> Either (Int, String) Regex
forall a b. a -> Either a b
Left (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
offset,String
string))
      else do ForeignPtr PCRE
regex <- FinalizerPtr PCRE -> Ptr PCRE -> IO (ForeignPtr PCRE)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr PCRE
forall a. FinalizerPtr a
c_ptr_free Ptr PCRE
pcre_ptr
              Either (Int, String) Regex -> IO (Either (Int, String) Regex)
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 -> ExecOption -> Regex
Regex ForeignPtr PCRE
regex CompOption
flags ExecOption
e

getNumSubs :: Regex -> Int
getNumSubs (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
_) = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi (CInt -> Int) -> (IO CInt -> CInt) -> IO CInt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO (IO CInt -> Int) -> IO CInt -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr PCRE -> (Ptr PCRE -> IO CInt) -> IO CInt
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 =
  (Ptr CInt -> IO CInt) -> IO CInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO CInt) -> IO CInt)
-> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
st -> do -- (st :: Ptr CInt)
    Bool -> IO PCRE -> IO PCRE
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (Ptr CInt
st Ptr CInt -> Ptr CInt -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CInt
forall a. Ptr a
nullPtr) (String -> IO PCRE
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Text.Regex.PCRE.Wrap.getNumSubs' could not allocate a CInt!!!")
    Ptr PCRE -> Ptr PCRE -> InfoWhat -> Ptr CInt -> IO CInt
forall a. Ptr PCRE -> Ptr PCRE -> InfoWhat -> Ptr a -> IO CInt
c_pcre_fullinfo Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr InfoWhat
pcreInfoCapturecount Ptr CInt
st
    Ptr CInt -> IO CInt
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) (CString
cstr,Int
len) = do
 CString
-> String
-> IO (Either WrapError Bool)
-> IO (Either WrapError Bool)
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest CString
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
    r :: ReturnCode
r@(ReturnCode CInt
r') <- Ptr PCRE
-> Ptr PCRE
-> CString
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr CString
cstr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
len) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
startOffset) ExecOption
flags Ptr CInt
forall a. Ptr a
nullPtr CInt
0
    if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
      then Either WrapError Bool -> IO (Either WrapError Bool)
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 (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either WrapError Bool
forall a b. b -> Either a b
Right Bool
True)

-- | Matches a regular expression against a string
--
-- Should never return (Right (Just []))
wrapMatch :: Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
startOffset (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
flags) (CString
cstr,Int
len) = do
 CString
-> 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 CString
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
    CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
pcre_ptr
    let nsub_int :: Int
        nsub_int :: Int
nsub_int = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
nsub
        ovec_size :: CInt
        ovec_size :: CInt
ovec_size = ((CInt
nsub CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
3) -- "man pcreapi" for explanation
        ovec_bytes :: Int
        ovec_bytes :: Int
ovec_bytes = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
ovec_size) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 242 "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 -- if r == ReturnCode 0
                             then nsub_int + 1 -- should not happen
                             else fi r' -- implies pairsSet > 0
                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 is an improvement over wrapMatch since it only
-- allocates memory with allocaBytes once at the start.
--
--
wrapMatchAll :: Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll (Regex ForeignPtr PCRE
pcre_fptr CompOption
_ ExecOption
flags) (CString
cstr,Int
len) = do
 CString
-> String
-> IO (Either WrapError [MatchArray])
-> IO (Either WrapError [MatchArray])
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest CString
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
regex -> do
    CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
regex
    let nsub_int :: Int
        nsub_int :: Int
nsub_int = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
nsub
        ovec_size :: CInt
        ovec_size :: CInt
ovec_size = ((CInt
nsub CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
3) -- "man pcreapi" for explanation
        ovec_bytes :: Int
        ovec_bytes :: Int
ovec_bytes = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
ovec_size) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 274 "src/Text/Regex/PCRE/Wrap.hsc" #-}
        clen :: CInt
clen = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
len
        flags' :: ExecOption
flags' = (ExecOption
execNotEmpty ExecOption -> ExecOption -> ExecOption
forall a. Bits a => a -> a -> a
.|. ExecOption
execAnchored ExecOption -> ExecOption -> ExecOption
forall a. Bits a => a -> a -> a
.|. ExecOption
flags)
    Int
-> (Ptr CInt -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ovec_bytes ((Ptr CInt -> IO (Either WrapError [MatchArray]))
 -> IO (Either WrapError [MatchArray]))
-> (Ptr CInt -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ovec ->
     Ptr CInt
-> 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 CInt
ovec String
"wrapMatchAll ovec" (IO (Either WrapError [MatchArray])
 -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
-> IO (Either WrapError [MatchArray])
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
-> CString
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
regex Ptr PCRE
forall a. Ptr a
nullPtr CString
cstr CInt
clen (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
pos) ExecOption
flags_in_use Ptr CInt
ovec CInt
ovec_size
            if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
              then Either WrapError b -> IO (Either WrapError b)
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
                       let pairsSet :: Int
pairsSet = if ReturnCode
r ReturnCode -> ReturnCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReturnCode
retNeededMoreSpace then Int
nsub_intInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
r'
                       [(Int, Int)]
pairs <- [(Int, Int)] -> IO [(Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> ([CInt] -> [(Int, Int)]) -> [CInt] -> IO [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CInt] -> [(Int, Int)]
toPairs ([CInt] -> IO [(Int, Int)]) -> IO [CInt] -> IO [(Int, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO CInt) -> [Int] -> IO [CInt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr CInt -> Int -> IO CInt
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec) [Int
0 .. ((Int
pairsSetInt -> 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, Int)]
pairsMatchArray -> [MatchArray] -> [MatchArray]
forall a. a -> [a] -> [a]
:)
                       case [(Int, Int)]
pairs of
                         [] -> Either WrapError b -> IO (Either WrapError b)
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 (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) -> 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 ([MatchArray] -> [MatchArray])
-> ExecOption -> Int -> IO (Either WrapError [MatchArray])
forall b.
([MatchArray] -> b) -> ExecOption -> Int -> IO (Either WrapError b)
loop [MatchArray] -> [MatchArray]
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 = ((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 :: [CInt] -> [(Int,Int)]
toPairs :: [CInt] -> [(Int, Int)]
toPairs [] = []
toPairs (CInt
a:CInt
b:[CInt]
rest) = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
a,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
b)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[CInt] -> [(Int, Int)]
toPairs [CInt]
rest
toPairs [CInt
_] = String -> [(Int, Int)]
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) (CString
cstr,Int
len) = do
 CString
-> String -> IO (Either WrapError Int) -> IO (Either WrapError Int)
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest CString
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
    CInt
nsub <- Ptr PCRE -> IO CInt
getNumSubs' Ptr PCRE
pcre_ptr
    let ovec_size :: CInt
        ovec_size :: CInt
ovec_size = ((CInt
nsub CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
3) -- "man pcreapi" for explanation
        ovec_bytes :: Int
        ovec_bytes :: Int
ovec_bytes = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
ovec_size) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
4)
{-# LINE 311 "src/Text/Regex/PCRE/Wrap.hsc" #-}
        clen :: CInt
clen = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Int
len
    Int
-> (Ptr CInt -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ovec_bytes ((Ptr CInt -> IO (Either WrapError Int))
 -> IO (Either WrapError Int))
-> (Ptr CInt -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ovec ->
     Ptr CInt
-> 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 CInt
ovec String
"wrapCount ovec" (IO (Either WrapError Int) -> IO (Either WrapError Int))
-> IO (Either WrapError Int) -> IO (Either WrapError Int)
forall a b. (a -> b) -> a -> b
$
      let act :: i -> IO ReturnCode
act i
pos = Ptr PCRE
-> Ptr PCRE
-> CString
-> CInt
-> CInt
-> ExecOption
-> Ptr CInt
-> CInt
-> IO ReturnCode
c_pcre_exec Ptr PCRE
pcre_ptr Ptr PCRE
forall a. Ptr a
nullPtr CString
cstr CInt
clen (i -> CInt
forall a b. (Integral a, Num b) => a -> b
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 t -> Bool -> Bool
`seq` Int
pos Int -> Bool -> Bool
`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 (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
                  [(Int, Int)]
pairs <- [(Int, Int)] -> IO [(Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> ([CInt] -> [(Int, Int)]) -> [CInt] -> IO [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CInt] -> [(Int, Int)]
toPairs ([CInt] -> IO [(Int, Int)]) -> IO [CInt] -> IO [(Int, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO CInt) -> [Int] -> IO [CInt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr CInt -> Int -> IO CInt
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec) [Int
0,Int
1]
                  case [(Int, Int)]
pairs of
                    [] -> Either WrapError t -> IO (Either WrapError t)
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 (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
  CString
version <- IO CString
c_pcre_version
  if CString
version CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
"pcre_version was null")
    else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (String -> Maybe String) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> IO (Maybe String)) -> IO String -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> IO String
peekCString CString
version

configUTF8 :: Bool
configUTF8 = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Bool) -> IO Bool)
-> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptrVal -> do -- (ptrVal :: Ptr CInt)
    Bool -> IO PCRE -> IO PCRE
forall (f :: * -> *). Applicative f => Bool -> f PCRE -> f PCRE
when (Ptr CInt
ptrVal Ptr CInt -> Ptr CInt -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CInt
forall a. Ptr a
nullPtr) (String -> IO PCRE
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Text.Regex.PCRE.Wrap.configUTF8 could not alloca CInt!!!")
    ConfigWhat -> Ptr CInt -> IO CInt
forall a. ConfigWhat -> Ptr a -> IO CInt
c_pcre_config ConfigWhat
pcreConfigUtf8 Ptr CInt
ptrVal
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptrVal
    case CInt
val of
      (CInt
1 :: CInt) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      CInt
0 -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      CInt
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- should not happen

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 -- FunPtr (Ptr a -> IO ())
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
compExtra :: CompOption
compExtra  = 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 374 "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 382 "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 391 "src/Text/Regex/PCRE/Wrap.hsc" #-}

-- Comment out most of these to avoid unused binding warnings

-- PCRE_INFO_FIRSTCHAR is deprecated, use PCRE_INFO_FIRSTBYTE instead.
pcreInfoCapturecount :: InfoWhat
pcreInfoCapturecount = InfoWhat 2

{-# LINE 397 "src/Text/Regex/PCRE/Wrap.hsc" #-}
{-
  PCRE_INFO_BACKREFMAX, \
  PCRE_INFO_DEFAULT_TABLES, \
  PCRE_INFO_FIRSTBYTE, \
  PCRE_INFO_FIRSTCHAR, \
  PCRE_INFO_FIRSTTABLE, \
  PCRE_INFO_LASTLITERAL, \
  PCRE_INFO_NAMECOUNT, \
  PCRE_INFO_NAMEENTRYSIZE, \
  PCRE_INFO_NAMETABLE, \
  PCRE_INFO_OPTIONS, \
  PCRE_INFO_SIZE, \
  PCRE_INFO_STUDYSIZE
-}
pcreConfigUtf8 :: ConfigWhat
pcreConfigUtf8 :: ConfigWhat
pcreConfigUtf8 = CInt -> ConfigWhat
ConfigWhat CInt
0

{-# LINE 413 "src/Text/Regex/PCRE/Wrap.hsc" #-}
{-
  PCRE_CONFIG_UNICODE_PROPERTIES, \
  PCRE_CONFIG_NEWLINE, \
  PCRE_CONFIG_LINK_SIZE, \
  PCRE_CONFIG_POSIX_MALLOC_THRESHOLD, \
  PCRE_CONFIG_MATCH_LIMIT, \
  PCRE_CONFIG_MATCH_LIMIT_RECURSION, \
  PCRE_CONFIG_STACKRECURSE
-}