{-# OPTIONS_GHC -optc-DHAVE_REGCOMP=1 #-}
{-# LINE 1 "Text/Regex/Posix/Wrap.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Text.Regex.Posix.Wrap(
Regex,
RegOffset,
RegOffsetT,
(=~),
(=~~),
WrapError,
wrapCompile,
wrapTest,
wrapMatch,
wrapMatchAll,
wrapCount,
unusedRegOffset,
CompOption(CompOption),
compBlank,
compExtended,
compIgnoreCase,
compNoSub,
compNewline,
ExecOption(ExecOption),
execBlank,
execNotBOL,
execNotEOL,
ReturnCode(ReturnCode),
retBadbr,
retBadpat,
retBadrpt,
retEcollate,
retEctype,
retEescape,
retEsubreg,
retEbrack,
retEparen,
retEbrace,
retErange,
retEspace
) where
{-# LINE 93 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 100 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 111 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 113 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 124 "Text/Regex/Posix/Wrap.hsc" #-}
import Control.Monad(liftM)
import Data.Array(Array,listArray)
import Data.Bits(Bits(..))
import Data.Int(Int32,Int64)
import Data.Word(Word32,Word64)
import Foreign(Ptr, FunPtr, nullPtr, newForeignPtr,
addForeignPtrFinalizer, Storable(peekByteOff), allocaArray,
allocaBytes, withForeignPtr,ForeignPtr,plusPtr,peekElemOff)
import Foreign.Marshal.Alloc(mallocBytes)
import Foreign.C(CChar)
{-# LINE 136 "Text/Regex/Posix/Wrap.hsc" #-}
import Foreign.C(CSize(CSize),CInt(CInt))
{-# LINE 140 "Text/Regex/Posix/Wrap.hsc" #-}
import Foreign.C.String(peekCAString, CString)
import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray)
import qualified Control.Exception(try,IOException)
try :: IO a -> IO (Either Control.Exception.IOException a)
try = Control.Exception.try
type CRegex = ()
type RegOffset = Int64
type RegOffsetT = (Int32)
{-# LINE 167 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 189 "Text/Regex/Posix/Wrap.hsc" #-}
newtype CompOption = CompOption CInt deriving (Eq,Show,Num,Bits)
{-# LINE 211 "Text/Regex/Posix/Wrap.hsc" #-}
{-# LINE 224 "Text/Regex/Posix/Wrap.hsc" #-}
newtype ExecOption = ExecOption CInt deriving (Eq,Show,Num,Bits)
{-# LINE 246 "Text/Regex/Posix/Wrap.hsc" #-}
newtype ReturnCode = ReturnCode CInt deriving (Eq,Show)
data Regex = Regex (ForeignPtr CRegex) CompOption ExecOption
compBlank :: CompOption
compBlank = CompOption 0
execBlank :: ExecOption
execBlank = ExecOption 0
unusedRegOffset :: RegOffset
unusedRegOffset = (-1)
type WrapError = (ReturnCode,String)
wrapCompile :: CompOption
-> ExecOption
-> CString
-> IO (Either WrapError Regex)
wrapTest :: Regex -> CString
-> IO (Either WrapError Bool)
wrapMatch :: Regex -> CString
-> IO (Either WrapError (Maybe [(RegOffset,RegOffset)]))
wrapMatchAll :: Regex -> CString
-> IO (Either WrapError [MatchArray])
wrapCount :: Regex -> CString
-> IO (Either WrapError Int)
(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)
=> source1 -> source -> target
(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m)
=> source1 -> source -> m target
instance RegexOptions Regex CompOption ExecOption where
blankCompOpt = compBlank
blankExecOpt = execBlank
defaultCompOpt = compExtended .|. compNewline
defaultExecOpt = execBlank
setExecOpts e' (Regex r c _) = Regex r c e'
getExecOpts (Regex _ _ e) = e
(=~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex
make = makeRegex
in match (make r) x
(=~~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex
make = makeRegex
in matchM (make r) x
type CRegMatch = ()
foreign import ccall unsafe "memset"
c_memset :: Ptr CRegex -> CInt -> CSize -> IO (Ptr CRegex)
foreign import ccall unsafe "&myregfree"
c_myregfree :: FunPtr (Ptr CRegex -> IO ())
{-# LINE 357 "Text/Regex/Posix/Wrap.hsc" #-}
foreign import ccall unsafe "regcomp"
c_regcomp :: Ptr CRegex -> CString -> CompOption -> IO ReturnCode
foreign import ccall unsafe "regexec"
c_regexec :: Ptr CRegex -> CString -> CSize
-> Ptr CRegMatch -> ExecOption -> IO ReturnCode
foreign import ccall unsafe "regerror"
c_regerror :: ReturnCode -> Ptr CRegex
-> CString -> CSize -> IO CSize
{-# LINE 406 "Text/Regex/Posix/Wrap.hsc" #-}
retOk :: ReturnCode
retOk = ReturnCode 0
execNotBOL :: ExecOption
execNotBOL = ExecOption 1
execNotEOL :: ExecOption
execNotEOL = ExecOption 2
{-# LINE 414 "Text/Regex/Posix/Wrap.hsc" #-}
compExtended :: CompOption
compExtended = CompOption 1
compIgnoreCase :: CompOption
compIgnoreCase = CompOption 2
compNoSub :: CompOption
compNoSub = CompOption 8
compNewline :: CompOption
compNewline = CompOption 4
{-# LINE 421 "Text/Regex/Posix/Wrap.hsc" #-}
retNoMatch :: ReturnCode
retNoMatch = ReturnCode 1
retBadbr :: ReturnCode
retBadbr = ReturnCode 10
retBadpat :: ReturnCode
retBadpat = ReturnCode 2
retBadrpt :: ReturnCode
retBadrpt = ReturnCode 13
retEcollate :: ReturnCode
retEcollate = ReturnCode 3
retEctype :: ReturnCode
retEctype = ReturnCode 4
retEescape :: ReturnCode
retEescape = ReturnCode 5
retEsubreg :: ReturnCode
retEsubreg = ReturnCode 6
retEbrack :: ReturnCode
retEbrack = ReturnCode 7
retEparen :: ReturnCode
retEparen = ReturnCode 8
retEbrace :: ReturnCode
retEbrace = ReturnCode 9
retErange :: ReturnCode
retErange = ReturnCode 11
retEspace :: ReturnCode
retEspace = ReturnCode 12
{-# LINE 439 "Text/Regex/Posix/Wrap.hsc" #-}
nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b)
{-# INLINE nullTest #-}
nullTest ptr msg io = do
if nullPtr == ptr
then return (Left (retOk,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg))
else io
isNewline,isNull :: Ptr CChar -> Int -> IO Bool
isNewline cstr pos = liftM (newline ==) (peekElemOff cstr pos)
where newline = toEnum 10
isNull cstr pos = liftM (nullChar ==) (peekElemOff cstr pos)
where nullChar = toEnum 0
wrapError :: ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError errCode regex_ptr = do
errBufSize <- c_regerror errCode regex_ptr nullPtr 0
allocaArray (fromIntegral errBufSize) $ \errBuf -> do
nullTest errBuf "wrapError errBuf" $ do
_ <- c_regerror errCode regex_ptr errBuf errBufSize
msg <- peekCAString errBuf :: IO String
return (Left (errCode, msg))
wrapCompile flags e pattern = do
nullTest pattern "wrapCompile pattern" $ do
e_regex_ptr <- try $ mallocBytes (64)
{-# LINE 475 "Text/Regex/Posix/Wrap.hsc" #-}
case e_regex_ptr of
Left ioerror -> return (Left (retOk,"Text.Regex.Posix.Wrap.wrapCompile: IOError from mallocBytes(regex_t) : "++show ioerror))
Right raw_regex_ptr -> do
zero_regex_ptr <- c_memset raw_regex_ptr 0 (64)
{-# LINE 479 "Text/Regex/Posix/Wrap.hsc" #-}
regex_fptr <- newForeignPtr c_myregfree zero_regex_ptr
withForeignPtr regex_fptr $ \regex_ptr -> do
errCode <- c_regcomp regex_ptr pattern flags
if (errCode == retOk)
then return . Right $ Regex regex_fptr flags e
else wrapError errCode regex_ptr
wrapTest (Regex regex_fptr _ flags) cstr = do
nullTest cstr "wrapTest" $ do
withForeignPtr regex_fptr $ \regex_ptr -> do
r <- c_regexec regex_ptr cstr 0 nullPtr flags
if r == retOk
then return (Right True)
else if r == retNoMatch
then return (Right False)
else wrapError r regex_ptr
wrapMatch regex@(Regex regex_fptr compileOptions flags) cstr = do
nullTest cstr "wrapMatch cstr" $ do
if (0 /= compNoSub .&. compileOptions)
then do
r <- wrapTest regex cstr
case r of
Right True -> return (Right (Just []))
Right False -> return (Right Nothing)
Left err -> return (Left err)
else do
withForeignPtr regex_fptr $ \regex_ptr -> do
nsub <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) regex_ptr :: IO CSize
{-# LINE 510 "Text/Regex/Posix/Wrap.hsc" #-}
let nsub_int,nsub_bytes :: Int
nsub_int = fromIntegral nsub
nsub_bytes = ((1 + nsub_int) * (8))
{-# LINE 513 "Text/Regex/Posix/Wrap.hsc" #-}
allocaBytes nsub_bytes $ \p_match -> do
nullTest p_match "wrapMatch allocaBytes" $ do
doMatch regex_ptr cstr nsub p_match flags
doMatch :: Ptr CRegex -> CString -> CSize -> Ptr CRegMatch -> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset,RegOffset)]))
{-# INLINE doMatch #-}
doMatch regex_ptr cstr nsub p_match flags = do
r <- c_regexec regex_ptr cstr (1 + nsub) p_match flags
if r == retOk
then do
regions <- mapM getOffsets . take (1+fromIntegral nsub)
. iterate (`plusPtr` (8)) $ p_match
{-# LINE 530 "Text/Regex/Posix/Wrap.hsc" #-}
return (Right (Just regions))
else if r == retNoMatch
then return (Right Nothing)
else wrapError r regex_ptr
where
getOffsets :: Ptr CRegMatch -> IO (RegOffset,RegOffset)
{-# INLINE getOffsets #-}
getOffsets pmatch' = do
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pmatch' :: IO (Int32)
{-# LINE 539 "Text/Regex/Posix/Wrap.hsc" #-}
end <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pmatch' :: IO (Int32)
{-# LINE 540 "Text/Regex/Posix/Wrap.hsc" #-}
return (fromIntegral start,fromIntegral end)
wrapMatchAll regex@(Regex regex_fptr compileOptions flags) cstr = do
nullTest cstr "wrapMatchAll cstr" $ do
if (0 /= compNoSub .&. compileOptions)
then do
r <- wrapTest regex cstr
case r of
Right True -> return (Right [(toMA 0 [])])
Right False -> return (Right [])
Left err -> return (Left err)
else do
withForeignPtr regex_fptr $ \regex_ptr -> do
nsub <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) regex_ptr :: IO CSize
{-# LINE 554 "Text/Regex/Posix/Wrap.hsc" #-}
let nsub_int,nsub_bytes :: Int
nsub_int = fromIntegral nsub
nsub_bytes = ((1 + nsub_int) * (8))
{-# LINE 557 "Text/Regex/Posix/Wrap.hsc" #-}
allocaBytes nsub_bytes $ \p_match -> do
nullTest p_match "wrapMatchAll p_match" $ do
let flagsBOL = (complement execNotBOL) .&. flags
flagsMIDDLE = execNotBOL .|. flags
atBOL pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsBOL
atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsMIDDLE
loop acc old (s,e) | acc `seq` old `seq` False = undefined
| s == e = do
let pos = old + fromIntegral e
atEnd <- isNull cstr pos
if atEnd then return (Right (acc []))
else loop acc old (s,succ e)
| otherwise = do
let pos = old + fromIntegral e
prev'newline <- isNewline cstr (pred pos)
result <- if prev'newline then atBOL pos else atMIDDLE pos
case result of
Right Nothing -> return (Right (acc []))
Right (Just parts@(whole:_)) -> let ma = toMA pos parts
in loop (acc.(ma:)) pos whole
Left err -> return (Left err)
Right (Just []) -> return (Right (acc [(toMA pos [])]))
result <- doMatch regex_ptr cstr nsub p_match flags
case result of
Right Nothing -> return (Right [])
Right (Just parts@(whole:_)) -> let ma = toMA 0 parts
in loop (ma:) 0 whole
Left err -> return (Left err)
Right (Just []) -> return (Right [(toMA 0 [])])
where
toMA :: Int -> [(RegOffset,RegOffset)] -> Array Int (Int,Int)
toMA pos [] = listArray (0,0) [(pos,0)]
toMA pos parts = listArray (0,pred (length parts))
. map (\(s,e)-> if s>=0 then (pos+fromIntegral s, fromIntegral (e-s)) else (-1,0))
$ parts
wrapCount regex@(Regex regex_fptr compileOptions flags) cstr = do
nullTest cstr "wrapCount cstr" $ do
if (0 /= compNoSub .&. compileOptions)
then do
r <- wrapTest regex cstr
case r of
Right True -> return (Right 1)
Right False -> return (Right 0)
Left err -> return (Left err)
else do
withForeignPtr regex_fptr $ \regex_ptr -> do
let nsub_bytes = ((8))
{-# LINE 607 "Text/Regex/Posix/Wrap.hsc" #-}
allocaBytes nsub_bytes $ \p_match -> do
nullTest p_match "wrapCount p_match" $ do
let flagsBOL = (complement execNotBOL) .&. flags
flagsMIDDLE = execNotBOL .|. flags
atBOL pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsBOL
atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsMIDDLE
loop acc old (s,e) | acc `seq` old `seq` False = undefined
| s == e = do
let pos = old + fromIntegral e
atEnd <- isNull cstr pos
if atEnd then return (Right acc)
else loop acc old (s,succ e)
| otherwise = do
let pos = old + fromIntegral e
prev'newline <- isNewline cstr (pred pos)
result <- if prev'newline then atBOL pos else atMIDDLE pos
case result of
Right Nothing -> return (Right acc)
Right (Just (whole:_)) -> loop (succ acc) pos whole
Left err -> return (Left err)
Right (Just []) -> return (Right acc)
result <- doMatch regex_ptr cstr 0 p_match flags
case result of
Right Nothing -> return (Right 0)
Right (Just (whole:_)) -> loop 1 0 whole
Left err -> return (Left err)
Right (Just []) -> return (Right 0)