{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.PCRE.ByteString(
Regex,
MatchOffset,
MatchLength,
CompOption(CompOption),
ExecOption(ExecOption),
ReturnCode,
WrapError,
unusedOffset,
getVersion,
compile,
execute,
regexec,
compBlank,
compAnchored,
compAutoCallout,
compCaseless,
compDollarEndOnly,
compDotAll,
compExtended,
compExtra,
compFirstLine,
compMultiline,
compNoAutoCapture,
compUngreedy,
compUTF8,
compNoUTF8Check,
execBlank,
execAnchored,
execNotBOL,
execNotEOL,
execNotEmpty,
execNoUTF8Check,
execPartial
) where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))
import Text.Regex.PCRE.Wrap
import Data.Array(Array,listArray)
import Data.ByteString(ByteString)
import qualified Data.ByteString as B(empty,useAsCString,last,take,drop,null,pack)
import qualified Data.ByteString.Unsafe as B(unsafeUseAsCString,unsafeUseAsCStringLen)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..),MatchOffset,MatchLength)
import Text.Regex.Base.Impl(polymatch,polymatchM)
import Foreign.C.String(CStringLen)
import Foreign(nullPtr)
instance RegexContext Regex ByteString ByteString where
match :: Regex -> ByteString -> ByteString
match = forall a b. RegexLike a b => a -> b -> b
polymatch
matchM :: forall (m :: * -> *).
MonadFail m =>
Regex -> ByteString -> m ByteString
matchM = forall a b (m :: * -> *).
(RegexLike a b, MonadFail m) =>
a -> b -> m b
polymatchM
unwrap :: (Show e) => Either e v -> IO v
unwrap :: forall e v. Show e => Either e v -> IO v
unwrap Either e v
x = case Either e v
x of Left e
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.PCRE.ByteString died: "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show e
err)
Right v
v -> forall (m :: * -> *) a. Monad m => a -> m a
return v
v
{-# INLINE asCStringLen #-}
asCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
s CStringLen -> IO a
op = forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
s CStringLen -> IO a
checked
where checked :: CStringLen -> IO a
checked cs :: CStringLen
cs@(Ptr CChar
ptr,Int
_) | Ptr CChar
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
myEmpty (CStringLen -> IO a
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {a} {b}. Num b => (a, b) -> (a, b)
trim)
| Bool
otherwise = CStringLen -> IO a
op CStringLen
cs
myEmpty :: ByteString
myEmpty = [Word8] -> ByteString
B.pack [Word8
0]
trim :: (a, b) -> (a, b)
trim (a
ptr,b
_) = (a
ptr,b
0)
instance RegexMaker Regex CompOption ExecOption ByteString where
makeRegexOpts :: CompOption -> ExecOption -> ByteString -> Regex
makeRegexOpts CompOption
c ExecOption
e ByteString
pattern = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
makeRegexOptsM :: forall (m :: * -> *).
MonadFail m =>
CompOption -> ExecOption -> ByteString -> m Regex
makeRegexOptsM CompOption
c ExecOption
e ByteString
pattern = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
failforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern
instance RegexLike Regex ByteString where
matchTest :: Regex -> ByteString -> Bool
matchTest Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
0 Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
matchOnce :: Regex -> ByteString -> Maybe MatchArray
matchOnce Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
matchAll :: Regex -> ByteString -> [MatchArray]
matchAll Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
matchCount :: Regex -> ByteString -> Int
matchCount Regex
regex ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount Regex
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e v. Show e => Either e v -> IO v
unwrap
compile :: CompOption
-> ExecOption
-> ByteString
-> IO (Either (MatchOffset,String) Regex)
compile :: CompOption
-> ExecOption -> ByteString -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e ByteString
pattern = do
let asCString :: ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
bs = if (Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs)) Bool -> Bool -> Bool
&& (Word8
0forall a. Eq a => a -> a -> Bool
==HasCallStack => ByteString -> Word8
B.last ByteString
bs)
then forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs
else forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.useAsCString ByteString
bs
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
pattern (CompOption
-> ExecOption -> Ptr CChar -> IO (Either (Int, String) Regex)
wrapCompile CompOption
c ExecOption
e)
execute :: Regex
-> ByteString
-> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
execute :: Regex -> ByteString -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex ByteString
bs = do
Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
case Either WrapError (Maybe [(Int, Int)])
maybeStartEnd of
Right Maybe [(Int, Int)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
Right (Just [(Int, Int)]
parts) ->
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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
parts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int
s,Int
e)->(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
eforall a. Num a => a -> a -> a
-Int
s))) forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
regexec :: Regex
-> ByteString
-> IO (Either WrapError (Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec :: Regex
-> ByteString
-> IO
(Either
WrapError
(Maybe (ByteString, ByteString, ByteString, [ByteString])))
regexec Regex
regex ByteString
bs = do
let getSub :: (Int, Int) -> ByteString
getSub (Int
start,Int
stop) | Int
start forall a. Eq a => a -> a -> Bool
== Int
unusedOffset = ByteString
B.empty
| Bool
otherwise = Int -> ByteString -> ByteString
B.take (Int
stopforall a. Num a => a -> a -> a
-Int
start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
start forall a b. (a -> b) -> a -> b
$ ByteString
bs
matchedParts :: [(Int, Int)] -> (ByteString, ByteString, ByteString, [ByteString])
matchedParts [] = (ByteString
B.empty,ByteString
B.empty,ByteString
bs,[])
matchedParts (matchedStartStop :: (Int, Int)
matchedStartStop@(Int
start,Int
stop):[(Int, Int)]
subStartStop) =
(Int -> ByteString -> ByteString
B.take Int
start ByteString
bs
,(Int, Int) -> ByteString
getSub (Int, Int)
matchedStartStop
,Int -> ByteString -> ByteString
B.drop Int
stop ByteString
bs
,forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> ByteString
getSub [(Int, Int)]
subStartStop)
Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. ByteString -> (CStringLen -> IO a) -> IO a
asCStringLen ByteString
bs (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
case Either WrapError (Maybe [(Int, Int)])
maybeStartEnd of
Right Maybe [(Int, Int)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
Right (Just [(Int, Int)]
parts) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> (ByteString, ByteString, ByteString, [ByteString])
matchedParts forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)