{-# LANGUAGE TypeFamilies, GADTs, TupleSections #-}
module Text.Regex.Applicative.Interface where
import Control.Applicative hiding (empty)
import Control.Arrow
import Control.Monad (guard)
import qualified Data.List as List
import Data.Maybe
import Text.Regex.Applicative.Types
import Text.Regex.Applicative.Object

-- | 'RE' is a profunctor. This is its contravariant map.
--
-- (A dependency on the @profunctors@ package doesn't seem justified.)
comap :: (s2 -> s1) -> RE s1 a -> RE s2 a
comap :: forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
re =
  case RE s1 a
re of
    RE s1 a
Eps -> forall s. RE s ()
Eps
    Symbol ThreadId
t s1 -> Maybe a
p    -> forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol ThreadId
t (s1 -> Maybe a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. s2 -> s1
f)
    Alt RE s1 a
r1 RE s1 a
r2     -> forall s a. RE s a -> RE s a -> RE s a
Alt (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r1) (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r2)
    App RE s1 (a -> a)
r1 RE s1 a
r2     -> forall s a b. RE s (a -> b) -> RE s a -> RE s b
App (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 (a -> a)
r1) (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r2)
    Fmap a -> a
g RE s1 a
r      -> forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> a
g (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r)
    CatMaybes RE s1 (Maybe a)
r   -> forall s a. RE s (Maybe a) -> RE s a
CatMaybes (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 (Maybe a)
r)
    RE s1 a
Fail          -> forall s a. RE s a
Fail
    Rep Greediness
gr a -> a -> a
fn a
a RE s1 a
r -> forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
gr a -> a -> a
fn a
a (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r)
    Void RE s1 a
r        -> forall s a. RE s a -> RE s ()
Void (forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r)

-- | Match and return any single symbol
anySym :: RE s s
anySym :: forall s. RE s s
anySym = forall s a. (s -> Maybe a) -> RE s a
msym forall a. a -> Maybe a
Just

-- | Match zero or more instances of the given expression, which are combined using
-- the given folding function.
--
-- 'Greediness' argument controls whether this regular expression should match
-- as many as possible ('Greedy') or as few as possible ('NonGreedy') instances
-- of the underlying expression.
reFoldl :: Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
reFoldl :: forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
reFoldl Greediness
g b -> a -> b
f b
b RE s a
a = forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
g b -> a -> b
f b
b RE s a
a

-- | Match zero or more instances of the given expression, but as
-- few of them as possible (i.e. /non-greedily/). A greedy equivalent of 'few'
-- is 'many'.
--
-- Examples:
--
-- >Text.Regex.Applicative> findFirstPrefix (few anySym  <* "b") "ababab"
-- >Just ("a","abab")
-- >Text.Regex.Applicative> findFirstPrefix (many anySym  <* "b") "ababab"
-- >Just ("ababa","")
few :: RE s a -> RE s [a]
few :: forall s a. RE s a -> RE s [a]
few RE s a
a = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
NonGreedy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] RE s a
a

-- | Return matched symbols as part of the return value
withMatched :: RE s a -> RE s (a, [s])
withMatched :: forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
Eps = forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. RE s ()
Eps
withMatched (Symbol ThreadId
t s -> Maybe a
p) = forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol ThreadId
t (\s
s -> (,[s
s]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe a
p s
s)
withMatched (Alt RE s a
a RE s a
b) = forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
b
withMatched (App RE s (a -> a)
a RE s a
b) =
    (\(a -> a
f, [s]
s) (a
x, [s]
t) -> (a -> a
f a
x, [s]
s forall a. [a] -> [a] -> [a]
++ [s]
t)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall s a. RE s a -> RE s (a, [s])
withMatched RE s (a -> a)
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
b
withMatched RE s a
Fail = forall s a. RE s a
Fail
withMatched (Fmap a -> a
f RE s a
x) = (a -> a
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x
withMatched (CatMaybes RE s (Maybe a)
x) = forall s a. RE s (Maybe a) -> RE s a
CatMaybes forall a b. (a -> b) -> a -> b
$
    (\ (Maybe a
as, [s]
s) -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [s]
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
as) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. RE s a -> RE s (a, [s])
withMatched RE s (Maybe a)
x
withMatched (Rep Greediness
gr a -> a -> a
f a
a0 RE s a
x) =
    forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
gr (\(a
a, [s]
s) (a
x, [s]
t) -> (a -> a -> a
f a
a a
x, [s]
s forall a. [a] -> [a] -> [a]
++ [s]
t)) (a
a0, []) (forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x)
-- N.B.: this ruins the Void optimization
withMatched (Void RE s a
x) = (forall a b. a -> b -> a
const () forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x

-- | @s =~ a = match a s@
(=~) :: [s] -> RE s a -> Maybe a
=~ :: forall s a. [s] -> RE s a -> Maybe a
(=~) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. RE s a -> [s] -> Maybe a
match
infix 2 =~

-- | Attempt to match a string of symbols against the regular expression.
-- Note that the whole string (not just some part of it) should be matched.
--
-- Examples:
--
-- >Text.Regex.Applicative> match (sym 'a' <|> sym 'b') "a"
-- >Just 'a'
-- >Text.Regex.Applicative> match (sym 'a' <|> sym 'b') "ab"
-- >Nothing
--
match :: RE s a -> [s] -> Maybe a
match :: forall s a. RE s a -> [s] -> Maybe a
match RE s a
re = let obj :: ReObject s a
obj = forall s r. RE s r -> ReObject s r
compile RE s a
re in \[s]
str ->
    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
    forall s r. ReObject s r -> [r]
results forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s r. s -> ReObject s r -> ReObject s r
step) ReObject s a
obj [s]
str

-- | Find a string prefix which is matched by the regular expression.
--
-- Of all matching prefixes, pick one using left bias (prefer the left part of
-- '<|>' to the right part) and greediness.
--
-- This is the match which a backtracking engine (such as Perl's one) would find
-- first.
--
-- If match is found, the rest of the input is also returned.
--
-- See also 'findFirstPrefixWithUncons', of which this is a special case.
--
-- Examples:
--
-- >Text.Regex.Applicative> findFirstPrefix ("a" <|> "ab") "abc"
-- >Just ("a","bc")
-- >Text.Regex.Applicative> findFirstPrefix ("ab" <|> "a") "abc"
-- >Just ("ab","c")
-- >Text.Regex.Applicative> findFirstPrefix "bc" "abc"
-- >Nothing
findFirstPrefix :: RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix = forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findFirstPrefixWithUncons forall a. [a] -> Maybe (a, [a])
List.uncons

-- | Find the first prefix, with the given @uncons@ function.
--
-- @since 0.3.4
findFirstPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findFirstPrefixWithUncons :: forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findFirstPrefixWithUncons = forall s a ss.
(ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findPrefixWith' (forall {s} {r}.
ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk forall s r. ReObject s r
emptyObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s r. ReObject s r -> [Thread s r]
threads)
  where
    walk :: ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk ReObject s r
obj [] = (ReObject s r
obj, forall a. Maybe a
Nothing)
    walk ReObject s r
obj (Thread s r
t:[Thread s r]
ts) =
        case forall s r. Thread s r -> Maybe r
getResult Thread s r
t of
            Just r
r -> (ReObject s r
obj, forall a. a -> Maybe a
Just r
r)
            Maybe r
Nothing -> ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk (forall s r. Thread s r -> ReObject s r -> ReObject s r
addThread Thread s r
t ReObject s r
obj) [Thread s r]
ts

-- | Find the longest string prefix which is matched by the regular expression.
--
-- Submatches are still determined using left bias and greediness, so this is
-- different from POSIX semantics.
--
-- If match is found, the rest of the input is also returned.
--
-- See also 'findLongestPrefixWithUncons', of which this is a special case.
--
-- Examples:
--
-- >Text.Regex.Applicative Data.Char> let keyword = "if"
-- >Text.Regex.Applicative Data.Char> let identifier = many $ psym isAlpha
-- >Text.Regex.Applicative Data.Char> let lexeme = (Left <$> keyword) <|> (Right <$> identifier)
-- >Text.Regex.Applicative Data.Char> findLongestPrefix lexeme "if foo"
-- >Just (Left "if"," foo")
-- >Text.Regex.Applicative Data.Char> findLongestPrefix lexeme "iffoo"
-- >Just (Right "iffoo","")
findLongestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix = forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findLongestPrefixWithUncons forall a. [a] -> Maybe (a, [a])
List.uncons

-- | Find the longest prefix, with the given @uncons@ function.
--
-- @since 0.3.4
findLongestPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findLongestPrefixWithUncons :: forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findLongestPrefixWithUncons = forall s a ss.
(ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findPrefixWith' ((,) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s r. ReObject s r -> [r]
results)

findPrefixWith'
 :: (ReObject s a -> (ReObject s a, Maybe a))
 -- ^ Given the regex object, compute the regex object to feed the next input value into, and
 -- the result, if any.
 -> (ss -> Maybe (s, ss)) -- ^ @uncons@
 -> RE s a -> ss -> Maybe (a, ss)
findPrefixWith' :: forall s a ss.
(ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findPrefixWith' ReObject s a -> (ReObject s a, Maybe a)
walk ss -> Maybe (s, ss)
uncons = \ RE s a
re -> ReObject s a -> Maybe (a, ss) -> ss -> Maybe (a, ss)
go (forall s r. RE s r -> ReObject s r
compile RE s a
re) forall a. Maybe a
Nothing
  where
    go :: ReObject s a -> Maybe (a, ss) -> ss -> Maybe (a, ss)
go ReObject s a
obj Maybe (a, ss)
resOld ss
ss = case ReObject s a -> (ReObject s a, Maybe a)
walk ReObject s a
obj of
        (ReObject s a
obj', Maybe a
resThis) ->
            let res :: Maybe (a, ss)
res = forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ss
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
resThis forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (a, ss)
resOld
            in
                case ss -> Maybe (s, ss)
uncons ss
ss of
                    Maybe (s, ss)
_ | forall s r. ReObject s r -> Bool
failed ReObject s a
obj' -> Maybe (a, ss)
res
                    Maybe (s, ss)
Nothing -> Maybe (a, ss)
res
                    Just (s
s, ss
ss) -> ReObject s a -> Maybe (a, ss) -> ss -> Maybe (a, ss)
go (forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s a
obj') Maybe (a, ss)
res ss
ss

-- | Find the shortest prefix (analogous to 'findLongestPrefix')
--
-- See also 'findShortestPrefixWithUncons', of which this is a special case.
findShortestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix = forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findShortestPrefixWithUncons forall a. [a] -> Maybe (a, [a])
List.uncons

-- | Find the shortest prefix (analogous to 'findLongestPrefix'), with the given @uncons@ function.
--
-- @since 0.3.4
findShortestPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findShortestPrefixWithUncons :: forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findShortestPrefixWithUncons ss -> Maybe (s, ss)
uncons = ReObject s a -> ss -> Maybe (a, ss)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s r. RE s r -> ReObject s r
compile
  where
    go :: ReObject s a -> ss -> Maybe (a, ss)
go ReObject s a
obj ss
ss = case forall s r. ReObject s r -> [r]
results ReObject s a
obj of
        a
r:[a]
_ -> forall a. a -> Maybe a
Just (a
r, ss
ss)
        [a]
_ -> do
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall s r. ReObject s r -> Bool
failed ReObject s a
obj))
            (s
s, ss
ss) <- ss -> Maybe (s, ss)
uncons ss
ss
            ReObject s a -> ss -> Maybe (a, ss)
go (forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s a
obj) ss
ss

-- | Find the leftmost substring that is matched by the regular expression.
-- Otherwise behaves like 'findFirstPrefix'. Returns the result together with
-- the prefix and suffix of the string surrounding the match.
findFirstInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findFirstInfix :: forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findFirstInfix RE s a
re [s]
str =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(([s]
first, a
res), [s]
last) -> ([s]
first, a
res, [s]
last)) forall a b. (a -> b) -> a -> b
$
    forall s a. RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. RE s a -> RE s [a]
few forall s. RE s s
anySym forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
re) [s]
str

-- Auxiliary function for findExtremeInfix
prefixCounter :: RE s (Int, [s])
prefixCounter :: forall s. RE s (Int, [s])
prefixCounter = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
reFoldl Greediness
NonGreedy forall {a} {a}. Num a => (a, [a]) -> a -> (a, [a])
f (Int
0, []) forall s. RE s s
anySym
    where
    f :: (a, [a]) -> a -> (a, [a])
f (a
i, [a]
prefix) a
s = ((,) forall a b. (a -> b) -> a -> b
$! (a
iforall a. Num a => a -> a -> a
+a
1)) forall a b. (a -> b) -> a -> b
$ a
sforall a. a -> [a] -> [a]
:[a]
prefix

data InfixMatchingState s a = GotResult
    { forall s a. InfixMatchingState s a -> Int
prefixLen  :: !Int
    , forall s a. InfixMatchingState s a -> [s]
prefixStr  :: [s]
    , forall s a. InfixMatchingState s a -> a
result     :: a
    , forall s a. InfixMatchingState s a -> [s]
postfixStr :: [s]
    }
    | NoResult

-- a `preferOver` b chooses one of a and b, giving preference to a
preferOver
    :: InfixMatchingState s a
    -> InfixMatchingState s a
    -> InfixMatchingState s a
preferOver :: forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
preferOver InfixMatchingState s a
NoResult InfixMatchingState s a
b = InfixMatchingState s a
b
preferOver InfixMatchingState s a
b InfixMatchingState s a
NoResult = InfixMatchingState s a
b
preferOver InfixMatchingState s a
a InfixMatchingState s a
b =
    case forall s a. InfixMatchingState s a -> Int
prefixLen InfixMatchingState s a
a forall a. Ord a => a -> a -> Ordering
`compare` forall s a. InfixMatchingState s a -> Int
prefixLen InfixMatchingState s a
b of
        Ordering
GT -> InfixMatchingState s a
b -- prefer b when it has smaller prefix
        Ordering
_  -> InfixMatchingState s a
a -- otherwise, prefer a

mkInfixMatchingState
    :: [s] -- rest of input
    -> Thread s ((Int, [s]), a)
    -> InfixMatchingState s a
mkInfixMatchingState :: forall s a.
[s] -> Thread s ((Int, [s]), a) -> InfixMatchingState s a
mkInfixMatchingState [s]
rest Thread s ((Int, [s]), a)
thread =
    case forall s r. Thread s r -> Maybe r
getResult Thread s ((Int, [s]), a)
thread of
        Just ((Int
pLen, [s]
pStr), a
res) ->
            GotResult
                { prefixLen :: Int
prefixLen = Int
pLen
                , prefixStr :: [s]
prefixStr = [s]
pStr
                , result :: a
result    = a
res
                , postfixStr :: [s]
postfixStr = [s]
rest
                }
        Maybe ((Int, [s]), a)
Nothing -> forall s a. InfixMatchingState s a
NoResult

gotResult :: InfixMatchingState s a -> Bool
gotResult :: forall s a. InfixMatchingState s a -> Bool
gotResult GotResult {} = Bool
True
gotResult InfixMatchingState s a
_ = Bool
False

-- Algorithm for finding leftmost longest infix match:
--
-- 1. Add a thread /.*?/ to the begginning of the regexp
-- 2. As soon as we get first accept, we delete that thread
-- 3. When we get more than one accept, we choose one by the following criteria:
-- 3.1. Compare by the length of prefix (since we are looking for the leftmost
-- match)
-- 3.2. If they are produced on the same step, choose the first one (left-biased
-- choice)
-- 3.3. If they are produced on the different steps, choose the later one (since
-- they have the same prefixes, later means longer)
findExtremalInfix
    :: -- function to combine a later result (first arg) to an earlier one (second
       -- arg)
       (InfixMatchingState s a -> InfixMatchingState s a -> InfixMatchingState s a)
    -> RE s a
    -> [s]
    -> Maybe ([s], a, [s])
findExtremalInfix :: forall s a.
(InfixMatchingState s a
 -> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a -> [s] -> Maybe ([s], a, [s])
findExtremalInfix InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
newOrOld RE s a
re [s]
str =
    case ReObject s ((Int, [s]), a)
-> [s] -> InfixMatchingState s a -> InfixMatchingState s a
go (forall s r. RE s r -> ReObject s r
compile forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. RE s (Int, [s])
prefixCounter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
re) [s]
str forall s a. InfixMatchingState s a
NoResult of
        InfixMatchingState s a
NoResult -> forall a. Maybe a
Nothing
        r :: InfixMatchingState s a
r@GotResult{} ->
            forall a. a -> Maybe a
Just (forall s a. InfixMatchingState s a -> [s]
prefixStr InfixMatchingState s a
r, forall s a. InfixMatchingState s a -> a
result InfixMatchingState s a
r, forall s a. InfixMatchingState s a -> [s]
postfixStr InfixMatchingState s a
r)
    where
    {-
    go :: ReObject s ((Int, [s]), a)
       -> [s]
       -> InfixMatchingState s a
       -> InfixMatchingState s a
    -}
    go :: ReObject s ((Int, [s]), a)
-> [s] -> InfixMatchingState s a -> InfixMatchingState s a
go ReObject s ((Int, [s]), a)
obj [s]
str InfixMatchingState s a
resOld =
        let resThis :: InfixMatchingState s a
resThis =
                forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                    (\InfixMatchingState s a
acc Thread s ((Int, [s]), a)
t -> InfixMatchingState s a
acc forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
`preferOver` forall s a.
[s] -> Thread s ((Int, [s]), a) -> InfixMatchingState s a
mkInfixMatchingState [s]
str Thread s ((Int, [s]), a)
t)
                    forall s a. InfixMatchingState s a
NoResult forall a b. (a -> b) -> a -> b
$
                    forall s r. ReObject s r -> [Thread s r]
threads ReObject s ((Int, [s]), a)
obj
            res :: InfixMatchingState s a
res = InfixMatchingState s a
resThis InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
`newOrOld` InfixMatchingState s a
resOld
            obj' :: ReObject s ((Int, [s]), a)
obj' =
                -- If we just found the first result, kill the "prefixCounter" thread.
                -- We rely on the fact that it is the last thread of the object.
                if forall s a. InfixMatchingState s a -> Bool
gotResult InfixMatchingState s a
resThis Bool -> Bool -> Bool
&& Bool -> Bool
not (forall s a. InfixMatchingState s a -> Bool
gotResult InfixMatchingState s a
resOld)
                    then forall s r. [Thread s r] -> ReObject s r
fromThreads forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall s r. ReObject s r -> [Thread s r]
threads ReObject s ((Int, [s]), a)
obj
                    else ReObject s ((Int, [s]), a)
obj
        in
            case [s]
str of
                [] -> InfixMatchingState s a
res
                [s]
_ | forall s r. ReObject s r -> Bool
failed ReObject s ((Int, [s]), a)
obj -> InfixMatchingState s a
res
                (s
s:[s]
ss) -> ReObject s ((Int, [s]), a)
-> [s] -> InfixMatchingState s a -> InfixMatchingState s a
go (forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s ((Int, [s]), a)
obj') [s]
ss InfixMatchingState s a
res


-- | Find the leftmost substring that is matched by the regular expression.
-- Otherwise behaves like 'findLongestPrefix'. Returns the result together with
-- the prefix and suffix of the string surrounding the match.
findLongestInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findLongestInfix :: forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findLongestInfix = forall s a.
(InfixMatchingState s a
 -> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a -> [s] -> Maybe ([s], a, [s])
findExtremalInfix forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
preferOver

-- | Find the leftmost substring that is matched by the regular expression.
-- Otherwise behaves like 'findShortestPrefix'. Returns the result together with
-- the prefix and suffix of the string surrounding the match.
findShortestInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findShortestInfix :: forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findShortestInfix = forall s a.
(InfixMatchingState s a
 -> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a -> [s] -> Maybe ([s], a, [s])
findExtremalInfix forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
preferOver

-- | Replace matches of the regular expression with its value.
--
-- >Text.Regex.Applicative > replace ("!" <$ sym 'f' <* some (sym 'o')) "quuxfoofooooofoobarfobar"
-- >"quux!!!bar!bar"
replace :: RE s [s] -> [s] -> [s]
replace :: forall s. RE s [s] -> [s] -> [s]
replace RE s [s]
r = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> [s] -> [s]
go
  where go :: [s] -> [s] -> [s]
go [s]
ys = case forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findLongestInfix RE s [s]
r [s]
ys of
                    Maybe ([s], [s], [s])
Nothing                -> ([s]
ys forall a. [a] -> [a] -> [a]
++)
                    Just ([s]
before, [s]
m, [s]
rest) -> ([s]
before forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([s]
m forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> [s] -> [s]
go [s]
rest