{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.Posix.Sequence(
Regex,
MatchOffset,
MatchLength,
ReturnCode,
WrapError,
unusedOffset,
compile,
regexec,
execute,
CompOption(CompOption),
compBlank,
compExtended,
compIgnoreCase,
compNoSub,
compNewline,
ExecOption(ExecOption),
execBlank,
execNotBOL,
execNotEOL
) where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))
import Data.Array(listArray, Array)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..),MatchOffset,MatchLength,Extract(..))
import Text.Regex.Posix.Wrap
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 = Regex -> Seq Char -> Seq Char
forall a b. RegexLike a b => a -> b -> b
polymatch
matchM :: forall (m :: * -> *).
MonadFail m =>
Regex -> Seq Char -> m (Seq Char)
matchM = Regex -> Seq Char -> m (Seq Char)
forall a b (m :: * -> *).
(RegexLike a b, MonadFail m) =>
a -> b -> m b
polymatchM
unusedOffset :: Int
unusedOffset :: Int
unusedOffset = RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
unusedRegOffset
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 -> String -> IO v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.Posix.Sequence died: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
err)
Right v
v -> v -> IO 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 = IO Regex -> Regex
forall a. IO a -> a
unsafePerformIO (IO Regex -> Regex) -> IO Regex -> Regex
forall a b. (a -> b) -> a -> b
$
(CompOption -> ExecOption -> Seq Char -> IO (Either WrapError Regex)
compile CompOption
c ExecOption
e Seq Char
pattern IO (Either WrapError Regex)
-> (Either WrapError Regex -> IO Regex) -> IO Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Regex -> IO Regex
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 = (WrapError -> m Regex)
-> (Regex -> m Regex) -> Either WrapError Regex -> m Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> m Regex)
-> (WrapError -> String) -> WrapError -> m Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WrapError -> String
forall a. Show a => a -> String
show) Regex -> m Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError Regex -> m Regex)
-> Either WrapError Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ IO (Either WrapError Regex) -> Either WrapError Regex
forall a. IO a -> a
unsafePerformIO (IO (Either WrapError Regex) -> Either WrapError Regex)
-> IO (Either WrapError Regex) -> Either WrapError Regex
forall a b. (a -> b) -> a -> b
$
(CompOption -> ExecOption -> Seq Char -> IO (Either WrapError 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 = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
Seq Char
-> (CString -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
str (Regex -> CString -> IO (Either WrapError Bool)
wrapTest Regex
regex) IO (Either WrapError Bool)
-> (Either WrapError Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Bool -> IO Bool
forall e v. Show e => Either e v -> IO v
unwrap
matchOnce :: Regex -> Seq Char -> Maybe MatchArray
matchOnce Regex
regex Seq Char
str = IO (Maybe MatchArray) -> Maybe MatchArray
forall a. IO a -> a
unsafePerformIO (IO (Maybe MatchArray) -> Maybe MatchArray)
-> IO (Maybe MatchArray) -> Maybe MatchArray
forall a b. (a -> b) -> a -> b
$
Regex -> Seq Char -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex Seq Char
str IO (Either WrapError (Maybe MatchArray))
-> (Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray))
-> IO (Maybe MatchArray)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray)
forall e v. Show e => Either e v -> IO v
unwrap
matchAll :: Regex -> Seq Char -> [MatchArray]
matchAll Regex
regex Seq Char
str = IO [MatchArray] -> [MatchArray]
forall a. IO a -> a
unsafePerformIO (IO [MatchArray] -> [MatchArray])
-> IO [MatchArray] -> [MatchArray]
forall a b. (a -> b) -> a -> b
$
Seq Char
-> (CString -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
str (Regex -> CString -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) IO (Either WrapError [MatchArray])
-> (Either WrapError [MatchArray] -> IO [MatchArray])
-> IO [MatchArray]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError [MatchArray] -> IO [MatchArray]
forall e v. Show e => Either e v -> IO v
unwrap
matchCount :: Regex -> Seq Char -> Int
matchCount Regex
regex Seq Char
str = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
Seq Char
-> (CString -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
str (Regex -> CString -> IO (Either WrapError Int)
wrapCount Regex
regex) IO (Either WrapError Int)
-> (Either WrapError Int -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Int -> IO Int
forall e v. Show e => Either e v -> IO v
unwrap
compile :: CompOption
-> ExecOption
-> Seq Char
-> IO (Either WrapError Regex)
compile :: CompOption -> ExecOption -> Seq Char -> IO (Either WrapError Regex)
compile CompOption
flags ExecOption
e Seq Char
pattern = Seq Char
-> (CString -> IO (Either WrapError Regex))
-> IO (Either WrapError Regex)
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
pattern (CompOption -> ExecOption -> CString -> IO (Either WrapError Regex)
wrapCompile CompOption
flags 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 [(RegOffset, RegOffset)])
maybeStartEnd <- Seq Char
-> (CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)])))
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
str (Regex
-> CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
wrapMatch Regex
regex)
case Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right Maybe MatchArray
forall a. Maybe a
Nothing)
Right (Just [(RegOffset, RegOffset)]
parts) ->
Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray)))
-> ([(RegOffset, RegOffset)]
-> Either WrapError (Maybe MatchArray))
-> [(RegOffset, RegOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right (Maybe MatchArray -> Either WrapError (Maybe MatchArray))
-> ([(RegOffset, RegOffset)] -> Maybe MatchArray)
-> [(RegOffset, RegOffset)]
-> Either WrapError (Maybe MatchArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchArray -> Maybe MatchArray
forall a. a -> Maybe a
Just (MatchArray -> Maybe MatchArray)
-> ([(RegOffset, RegOffset)] -> MatchArray)
-> [(RegOffset, RegOffset)]
-> Maybe MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [(Int, Int)] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred ([(RegOffset, RegOffset)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(RegOffset, RegOffset)]
parts))
([(Int, Int)] -> MatchArray)
-> ([(RegOffset, RegOffset)] -> [(Int, Int)])
-> [(RegOffset, RegOffset)]
-> MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RegOffset, RegOffset) -> (Int, Int))
-> [(RegOffset, RegOffset)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RegOffset
s,RegOffset
e)->(RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
s, RegOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RegOffset
eRegOffset -> RegOffset -> RegOffset
forall a. Num a => a -> a -> a
-RegOffset
s)))
([(RegOffset, RegOffset)]
-> IO (Either WrapError (Maybe MatchArray)))
-> [(RegOffset, RegOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall a b. (a -> b) -> a -> b
$ [(RegOffset, RegOffset)]
parts
Left WrapError
err -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError (Maybe MatchArray)
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 :: (RegOffset,RegOffset) -> Seq Char
getSub :: (RegOffset, RegOffset) -> Seq Char
getSub (RegOffset
start,RegOffset
stop) | RegOffset
start RegOffset -> RegOffset -> Bool
forall a. Eq a => a -> a -> Bool
== RegOffset
unusedRegOffset = Seq Char
forall a. Seq a
S.empty
| Bool
otherwise =
(Int, Int) -> Seq Char -> Seq Char
forall source. Extract source => (Int, Int) -> source -> source
extract (RegOffset -> Int
forall a. Enum a => a -> Int
fromEnum RegOffset
start,RegOffset -> Int
forall a. Enum a => a -> Int
fromEnum (RegOffset -> Int) -> RegOffset -> Int
forall a b. (a -> b) -> a -> b
$ RegOffset
stopRegOffset -> RegOffset -> RegOffset
forall a. Num a => a -> a -> a
-RegOffset
start) (Seq Char -> Seq Char) -> Seq Char -> Seq Char
forall a b. (a -> b) -> a -> b
$ Seq Char
str
matchedParts :: [(RegOffset,RegOffset)] -> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts :: [(RegOffset, RegOffset)]
-> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts [] = (Seq Char
str,Seq Char
forall a. Seq a
S.empty,Seq Char
forall a. Seq a
S.empty,[])
matchedParts (matchedStartStop :: (RegOffset, RegOffset)
matchedStartStop@(RegOffset
start,RegOffset
stop):[(RegOffset, RegOffset)]
subStartStop) =
(Int -> Seq Char -> Seq Char
forall source. Extract source => Int -> source -> source
before (RegOffset -> Int
forall a. Enum a => a -> Int
fromEnum RegOffset
start) Seq Char
str
,(RegOffset, RegOffset) -> Seq Char
getSub (RegOffset, RegOffset)
matchedStartStop
,Int -> Seq Char -> Seq Char
forall source. Extract source => Int -> source -> source
after (RegOffset -> Int
forall a. Enum a => a -> Int
fromEnum RegOffset
stop) Seq Char
str
,((RegOffset, RegOffset) -> Seq Char)
-> [(RegOffset, RegOffset)] -> [Seq Char]
forall a b. (a -> b) -> [a] -> [b]
map (RegOffset, RegOffset) -> Seq Char
getSub [(RegOffset, RegOffset)]
subStartStop)
Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd <- Seq Char
-> (CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)])))
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
str (Regex
-> CString
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
wrapMatch Regex
regex)
case Either WrapError (Maybe [(RegOffset, RegOffset)])
maybeStartEnd of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. b -> Either a b
Right Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall a. Maybe a
Nothing)
Right (Just [(RegOffset, RegOffset)]
parts) -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))))
-> ([(RegOffset, RegOffset)]
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
-> [(RegOffset, RegOffset)]
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. b -> Either a b
Right (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
-> ([(RegOffset, RegOffset)]
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> [(RegOffset, RegOffset)]
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall a. a -> Maybe a
Just ((Seq Char, Seq Char, Seq Char, [Seq Char])
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> ([(RegOffset, RegOffset)]
-> (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> [(RegOffset, RegOffset)]
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RegOffset, RegOffset)]
-> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts ([(RegOffset, RegOffset)]
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))))
-> [(RegOffset, RegOffset)]
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall a b. (a -> b) -> a -> b
$ [(RegOffset, RegOffset)]
parts
Left WrapError
err -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
(Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError
-> Either
WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. a -> Either a b
Left WrapError
err)
withSeq :: Seq Char -> (CString -> IO a) -> IO a
withSeq :: forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq Seq Char
s CString -> IO a
f =
let
s' :: Seq Char
s' = case Seq Char -> ViewR Char
forall a. Seq a -> ViewR a
viewr Seq Char
s of
ViewR Char
EmptyR -> Char -> Seq Char
forall a. a -> Seq a
singleton Char
'\0'
Seq Char
_ :> Char
'\0' -> Seq Char
s
ViewR Char
_ -> Seq Char
s Seq Char -> Char -> Seq Char
forall a. Seq a -> a -> Seq a
|> Char
'\0'
pokes :: CString -> Seq Char -> IO ()
pokes CString
p Seq Char
a = case Seq Char -> ViewL Char
forall a. Seq a -> ViewL a
viewl Seq Char
a of
ViewL Char
EmptyL -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char
c :< Seq Char
a' -> CString -> CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
p (Char -> CChar
castCharToCChar Char
c) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> Seq Char -> IO ()
pokes (CString -> Int -> CString
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr CString
p Int
1) Seq Char
a'
in Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Seq Char -> Int
forall a. Seq a -> Int
S.length Seq Char
s') (\CString
ptr -> CString -> Seq Char -> IO ()
pokes CString
ptr Seq Char
s' IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> IO a
f CString
ptr)