{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.PCRE.Sequence(
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 System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchLength,MatchOffset,Extract(..))
import Text.Regex.Base.Impl(polymatch,polymatchM)
import Data.Sequence as S hiding (length)
import qualified Data.Sequence as S (length)
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Storable
instance RegexContext Regex (Seq Char) (Seq Char) where
match :: Regex -> Seq Char -> Seq Char
match = forall a b. RegexLike a b => a -> b -> b
polymatch
matchM :: forall (m :: * -> *).
MonadFail m =>
Regex -> Seq Char -> m (Seq Char)
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.Sequence 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
instance RegexMaker Regex CompOption ExecOption (Seq Char) where
makeRegexOpts :: CompOption -> ExecOption -> Seq Char -> Regex
makeRegexOpts CompOption
c ExecOption
e Seq Char
pattern = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
CompOption
-> ExecOption -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
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 -> Seq Char -> m Regex
makeRegexOptsM CompOption
c ExecOption
e Seq Char
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 -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
pattern
instance RegexLike Regex (Seq Char) where
matchTest :: Regex -> Seq Char -> Bool
matchTest Regex
regex Seq Char
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (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 -> Seq Char -> Maybe MatchArray
matchOnce Regex
regex Seq Char
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
Regex -> Seq Char -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex Seq Char
str 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 -> Seq Char -> [MatchArray]
matchAll Regex
regex Seq Char
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (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 -> Seq Char -> Int
matchCount Regex
regex Seq Char
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (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
-> (Seq Char)
-> IO (Either (MatchOffset,String) Regex)
compile :: CompOption
-> ExecOption -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
pattern = forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq0 Seq Char
pattern (CompOption
-> ExecOption -> CString -> IO (Either (Int, String) Regex)
wrapCompile CompOption
c ExecOption
e)
execute :: Regex
-> (Seq Char)
-> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
execute :: Regex -> Seq Char -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex Seq Char
str = do
Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (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
-> (Seq Char)
-> IO (Either WrapError (Maybe ((Seq Char), (Seq Char),(Seq Char), [(Seq Char)])))
regexec :: Regex
-> Seq Char
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
regexec Regex
regex Seq Char
str = do
let getSub :: (Int, Int) -> Seq Char
getSub (Int
start,Int
stop) | Int
start forall a. Eq a => a -> a -> Bool
== Int
unusedOffset = forall a. Seq a
S.empty
| Bool
otherwise = forall source. Extract source => (Int, Int) -> source -> source
extract (Int
start,Int
stopforall a. Num a => a -> a -> a
-Int
start) Seq Char
str
matchedParts :: [(Int, Int)] -> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts [] = (forall a. Seq a
S.empty,forall a. Seq a
S.empty,Seq Char
str,[])
matchedParts (matchedStartStop :: (Int, Int)
matchedStartStop@(Int
start,Int
stop):[(Int, Int)]
subStartStop) =
(forall source. Extract source => Int -> source -> source
before Int
start Seq Char
str
,(Int, Int) -> Seq Char
getSub (Int, Int)
matchedStartStop
,forall source. Extract source => Int -> source -> source
after Int
stop Seq Char
str
,forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Seq Char
getSub [(Int, Int)]
subStartStop)
Either WrapError (Maybe [(Int, Int)])
maybeStartEnd <- forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (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)] -> (Seq Char, Seq Char, Seq Char, [Seq Char])
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)
withSeq :: Seq Char -> (CStringLen -> IO a) -> IO a
withSeq :: forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
s CStringLen -> IO a
f =
let
len :: Int
len = forall a. Seq a -> Int
S.length Seq Char
s
pokes :: CString -> Seq Char -> IO ()
pokes CString
p Seq Char
a | seq :: forall a b. a -> b -> b
seq CString
p (seq :: forall a b. a -> b -> b
seq Seq Char
a Bool
False) = forall a. HasCallStack => a
undefined
| Bool
otherwise =
case forall a. Seq a -> ViewL a
viewl Seq Char
a of
ViewL Char
EmptyL -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char
c :< Seq Char
a' -> forall a. Storable a => Ptr a -> a -> IO ()
poke CString
p (Char -> CChar
castCharToCChar Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> Seq Char -> IO ()
pokes (forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr CString
p Int
1) Seq Char
a'
in forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall a. Seq a -> Int
S.length Seq Char
s) (\CString
ptr -> CString -> Seq Char -> IO ()
pokes CString
ptr Seq Char
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CStringLen -> IO a
f (CString
ptr,Int
len))
withSeq0 :: Seq Char -> (CString -> IO a) -> IO a
withSeq0 :: forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq0 Seq Char
s CString -> IO a
f =
let
s' :: Seq Char
s' = case forall a. Seq a -> ViewR a
viewr Seq Char
s of
ViewR Char
EmptyR -> forall a. a -> Seq a
singleton Char
'\0'
Seq Char
_ :> Char
'\0' -> Seq Char
s
ViewR Char
_ -> Seq Char
s forall a. Seq a -> a -> Seq a
|> Char
'\0'
pokes :: CString -> Seq Char -> IO ()
pokes CString
p Seq Char
a | seq :: forall a b. a -> b -> b
seq CString
p (seq :: forall a b. a -> b -> b
seq Seq Char
a Bool
False) = forall a. HasCallStack => a
undefined
| Bool
otherwise =
case forall a. Seq a -> ViewL a
viewl Seq Char
a of
ViewL Char
EmptyL -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char
c :< Seq Char
a' -> forall a. Storable a => Ptr a -> a -> IO ()
poke CString
p (Char -> CChar
castCharToCChar Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> Seq Char -> IO ()
pokes (forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr CString
p Int
1) Seq Char
a'
in forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall a. Seq a -> Int
S.length Seq Char
s') (\CString
ptr -> CString -> Seq Char -> IO ()
pokes CString
ptr Seq Char
s' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> IO a
f CString
ptr)