{-# 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
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 -> RE s2 a
RE s2 ()
forall s. RE s ()
Eps
Symbol ThreadId
t s1 -> Maybe a
p -> ThreadId -> (s2 -> Maybe a) -> RE s2 a
forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol ThreadId
t (s1 -> Maybe a
p (s1 -> Maybe a) -> (s2 -> s1) -> s2 -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s2 -> s1
f)
Alt RE s1 a
r1 RE s1 a
r2 -> RE s2 a -> RE s2 a -> RE s2 a
forall s a. RE s a -> RE s a -> RE s a
Alt ((s2 -> s1) -> RE s1 a -> RE s2 a
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r1) ((s2 -> s1) -> RE s1 a -> RE s2 a
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a
r2)
App RE s1 (a1 -> a)
r1 RE s1 a1
r2 -> RE s2 (a1 -> a) -> RE s2 a1 -> RE s2 a
forall s a1 a. RE s (a1 -> a) -> RE s a1 -> RE s a
App ((s2 -> s1) -> RE s1 (a1 -> a) -> RE s2 (a1 -> a)
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 (a1 -> a)
r1) ((s2 -> s1) -> RE s1 a1 -> RE s2 a1
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a1
r2)
Fmap a1 -> a
g RE s1 a1
r -> (a1 -> a) -> RE s2 a1 -> RE s2 a
forall a1 a s. (a1 -> a) -> RE s a1 -> RE s a
Fmap a1 -> a
g ((s2 -> s1) -> RE s1 a1 -> RE s2 a1
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a1
r)
CatMaybes RE s1 (Maybe a)
r -> RE s2 (Maybe a) -> RE s2 a
forall s a. RE s (Maybe a) -> RE s a
CatMaybes ((s2 -> s1) -> RE s1 (Maybe a) -> RE s2 (Maybe a)
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 -> RE s2 a
forall s a. RE s a
Fail
Rep Greediness
gr a -> a1 -> a
fn a
a RE s1 a1
r -> Greediness -> (a -> a1 -> a) -> a -> RE s2 a1 -> RE s2 a
forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
Rep Greediness
gr a -> a1 -> a
fn a
a ((s2 -> s1) -> RE s1 a1 -> RE s2 a1
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a1
r)
Void RE s1 a1
r -> RE s2 a1 -> RE s2 ()
forall s a1. RE s a1 -> RE s ()
Void ((s2 -> s1) -> RE s1 a1 -> RE s2 a1
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 a1
r)
anySym :: RE s s
anySym :: forall s. RE s s
anySym = (s -> Maybe s) -> RE s s
forall s a. (s -> Maybe a) -> RE s a
msym s -> Maybe s
forall a. a -> Maybe a
Just
reFoldl :: Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
reFoldl :: forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
reFoldl Greediness
g b -> a -> b
f b
b RE s a
a = Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
Rep Greediness
g b -> a -> b
f b
b RE s a
a
few :: RE s a -> RE s [a]
few :: forall s a. RE s a -> RE s [a]
few RE s a
a = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> RE s [a] -> RE s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Greediness -> ([a] -> a -> [a]) -> [a] -> RE s a -> RE s [a]
forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
Rep Greediness
NonGreedy ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] RE s a
a
withMatched :: RE s a -> RE s (a, [s])
withMatched :: forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
Eps = (a -> [s] -> (a, [s])) -> [s] -> a -> (a, [s])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] (a -> (a, [s])) -> RE s a -> RE s (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a
RE s ()
forall s. RE s ()
Eps
withMatched (Symbol ThreadId
t s -> Maybe a
p) = ThreadId -> (s -> Maybe (a, [s])) -> RE s (a, [s])
forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol ThreadId
t (\s
s -> (,[s
s]) (a -> (a, [s])) -> Maybe a -> Maybe (a, [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) = RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
a RE s (a, [s]) -> RE s (a, [s]) -> RE s (a, [s])
forall a. RE s a -> RE s a -> RE s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
b
withMatched (App RE s (a1 -> a)
a RE s a1
b) =
(\(a1 -> a
f, [s]
s) (a1
x, [s]
t) -> (a1 -> a
f a1
x, [s]
s [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++ [s]
t)) ((a1 -> a, [s]) -> (a1, [s]) -> (a, [s]))
-> RE s (a1 -> a, [s]) -> RE s ((a1, [s]) -> (a, [s]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
RE s (a1 -> a) -> RE s (a1 -> a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s (a1 -> a)
a RE s ((a1, [s]) -> (a, [s])) -> RE s (a1, [s]) -> RE s (a, [s])
forall a b. RE s (a -> b) -> RE s a -> RE s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
RE s a1 -> RE s (a1, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a1
b
withMatched RE s a
Fail = RE s (a, [s])
forall s a. RE s a
Fail
withMatched (Fmap a1 -> a
f RE s a1
x) = (a1 -> a
f (a1 -> a) -> ([s] -> [s]) -> (a1, [s]) -> (a, [s])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [s] -> [s]
forall a. a -> a
id) ((a1, [s]) -> (a, [s])) -> RE s (a1, [s]) -> RE s (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a1 -> RE s (a1, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a1
x
withMatched (CatMaybes RE s (Maybe a)
x) = RE s (Maybe (a, [s])) -> RE s (a, [s])
forall s a. RE s (Maybe a) -> RE s a
CatMaybes (RE s (Maybe (a, [s])) -> RE s (a, [s]))
-> RE s (Maybe (a, [s])) -> RE s (a, [s])
forall a b. (a -> b) -> a -> b
$
(\ (Maybe a
as, [s]
s) -> (a -> [s] -> (a, [s])) -> [s] -> a -> (a, [s])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [s]
s (a -> (a, [s])) -> Maybe a -> Maybe (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
as) ((Maybe a, [s]) -> Maybe (a, [s]))
-> RE s (Maybe a, [s]) -> RE s (Maybe (a, [s]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s (Maybe a) -> RE s (Maybe a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s (Maybe a)
x
withMatched (Rep Greediness
gr a -> a1 -> a
f a
a0 RE s a1
x) =
Greediness
-> ((a, [s]) -> (a1, [s]) -> (a, [s]))
-> (a, [s])
-> RE s (a1, [s])
-> RE s (a, [s])
forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
Rep Greediness
gr (\(a
a, [s]
s) (a1
x, [s]
t) -> (a -> a1 -> a
f a
a a1
x, [s]
s [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++ [s]
t)) (a
a0, []) (RE s a1 -> RE s (a1, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a1
x)
withMatched (Void RE s a1
x) = (() -> a1 -> ()
forall a b. a -> b -> a
const () (a1 -> ()) -> ([s] -> [s]) -> (a1, [s]) -> ((), [s])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [s] -> [s]
forall a. a -> a
id) ((a1, [s]) -> (a, [s])) -> RE s (a1, [s]) -> RE s (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a1 -> RE s (a1, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a1
x
(=~) :: [s] -> RE s a -> Maybe a
=~ :: forall s a. [s] -> RE s a -> Maybe a
(=~) = (RE s a -> [s] -> Maybe a) -> [s] -> RE s a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RE s a -> [s] -> Maybe a
forall s a. RE s a -> [s] -> Maybe a
match
infix 2 =~
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 = RE s a -> ReObject s a
forall s r. RE s r -> ReObject s r
compile RE s a
re in \[s]
str ->
[a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$
ReObject s a -> [a]
forall s r. ReObject s r -> [r]
results (ReObject s a -> [a]) -> ReObject s a -> [a]
forall a b. (a -> b) -> a -> b
$
(ReObject s a -> s -> ReObject s a)
-> ReObject s a -> [s] -> ReObject s a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((s -> ReObject s a -> ReObject s a)
-> ReObject s a -> s -> ReObject s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> ReObject s a -> ReObject s a
forall s r. s -> ReObject s r -> ReObject s r
step) ReObject s a
obj [s]
str
findFirstPrefix :: RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix = ([s] -> Maybe (s, [s])) -> RE s a -> [s] -> Maybe (a, [s])
forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findFirstPrefixWithUncons [s] -> Maybe (s, [s])
forall a. [a] -> Maybe (a, [a])
List.uncons
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 = (ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
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 -> [Thread s a] -> (ReObject s a, Maybe a)
forall {s} {r}.
ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk ReObject s a
forall s r. ReObject s r
emptyObject ([Thread s a] -> (ReObject s a, Maybe a))
-> (ReObject s a -> [Thread s a])
-> ReObject s a
-> (ReObject s a, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReObject s a -> [Thread s a]
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, Maybe r
forall a. Maybe a
Nothing)
walk ReObject s r
obj (Thread s r
t:[Thread s r]
ts) =
case Thread s r -> Maybe r
forall s r. Thread s r -> Maybe r
getResult Thread s r
t of
Just r
r -> (ReObject s r
obj, r -> Maybe r
forall a. a -> Maybe a
Just r
r)
Maybe r
Nothing -> ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk (Thread s r -> ReObject s r -> ReObject s r
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
findLongestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix = ([s] -> Maybe (s, [s])) -> RE s a -> [s] -> Maybe (a, [s])
forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findLongestPrefixWithUncons [s] -> Maybe (s, [s])
forall a. [a] -> Maybe (a, [a])
List.uncons
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 = (ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
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 -> Maybe a -> (ReObject s a, Maybe a))
-> (ReObject s a -> Maybe a)
-> ReObject s a
-> (ReObject s a, Maybe a)
forall a b.
(ReObject s a -> a -> b)
-> (ReObject s a -> a) -> ReObject s a -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a)
-> (ReObject s a -> [a]) -> ReObject s a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReObject s a -> [a]
forall s r. ReObject s r -> [r]
results)
findPrefixWith'
:: (ReObject s a -> (ReObject s a, Maybe a))
-> (ss -> Maybe (s, ss))
-> 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 (RE s a -> ReObject s a
forall s r. RE s r -> ReObject s r
compile RE s a
re) Maybe (a, ss)
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 = (a -> ss -> (a, ss)) -> ss -> a -> (a, ss)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ss
ss (a -> (a, ss)) -> Maybe a -> Maybe (a, ss)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
resThis Maybe (a, ss) -> Maybe (a, ss) -> Maybe (a, ss)
forall a. Maybe a -> Maybe a -> Maybe a
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)
_ | ReObject s a -> Bool
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 (s -> ReObject s a -> ReObject s a
forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s a
obj') Maybe (a, ss)
res ss
ss
findShortestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix :: forall s a. RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix = ([s] -> Maybe (s, [s])) -> RE s a -> [s] -> Maybe (a, [s])
forall ss s a.
(ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe (a, ss)
findShortestPrefixWithUncons [s] -> Maybe (s, [s])
forall a. [a] -> Maybe (a, [a])
List.uncons
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 (ReObject s a -> ss -> Maybe (a, ss))
-> (RE s a -> ReObject s a) -> RE s a -> ss -> Maybe (a, ss)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE s a -> ReObject s a
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 ReObject s a -> [a]
forall s r. ReObject s r -> [r]
results ReObject s a
obj of
a
r:[a]
_ -> (a, ss) -> Maybe (a, ss)
forall a. a -> Maybe a
Just (a
r, ss
ss)
[a]
_ -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (ReObject s a -> Bool
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 (s -> ReObject s a -> ReObject s a
forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s a
obj) ss
ss
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 =
((([s], a), [s]) -> ([s], a, [s]))
-> Maybe (([s], a), [s]) -> Maybe ([s], a, [s])
forall a b. (a -> b) -> Maybe a -> Maybe b
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)) (Maybe (([s], a), [s]) -> Maybe ([s], a, [s]))
-> Maybe (([s], a), [s]) -> Maybe ([s], a, [s])
forall a b. (a -> b) -> a -> b
$
RE s ([s], a) -> [s] -> Maybe (([s], a), [s])
forall s a. RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix ((,) ([s] -> a -> ([s], a)) -> RE s [s] -> RE s (a -> ([s], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s s -> RE s [s]
forall s a. RE s a -> RE s [a]
few RE s s
forall s. RE s s
anySym RE s (a -> ([s], a)) -> RE s a -> RE s ([s], a)
forall a b. RE s (a -> b) -> RE s a -> RE s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
re) [s]
str
prefixCounter :: RE s (Int, [s])
prefixCounter :: forall s. RE s (Int, [s])
prefixCounter = ([s] -> [s]) -> (Int, [s]) -> (Int, [s])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [s] -> [s]
forall a. [a] -> [a]
reverse ((Int, [s]) -> (Int, [s])) -> RE s (Int, [s]) -> RE s (Int, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Greediness
-> ((Int, [s]) -> s -> (Int, [s]))
-> (Int, [s])
-> RE s s
-> RE s (Int, [s])
forall a a1 s.
Greediness -> (a -> a1 -> a) -> a -> RE s a1 -> RE s a
reFoldl Greediness
NonGreedy (Int, [s]) -> s -> (Int, [s])
forall {a} {a}. Num a => (a, [a]) -> a -> (a, [a])
f (Int
0, []) RE s s
forall s. RE s s
anySym
where
f :: (a, [a]) -> a -> (a, [a])
f (a
i, [a]
prefix) a
s = ((,) (a -> [a] -> (a, [a])) -> a -> [a] -> (a, [a])
forall a b. (a -> b) -> a -> b
$! (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1)) ([a] -> (a, [a])) -> [a] -> (a, [a])
forall a b. (a -> b) -> a -> b
$ a
sa -> [a] -> [a]
forall 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
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 InfixMatchingState s a -> Int
forall s a. InfixMatchingState s a -> Int
prefixLen InfixMatchingState s a
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` InfixMatchingState s a -> Int
forall s a. InfixMatchingState s a -> Int
prefixLen InfixMatchingState s a
b of
Ordering
GT -> InfixMatchingState s a
b
Ordering
_ -> InfixMatchingState s a
a
mkInfixMatchingState
:: [s]
-> 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 Thread s ((Int, [s]), a) -> Maybe ((Int, [s]), a)
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 -> InfixMatchingState s a
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
findExtremalInfix
::
(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 (RE s ((Int, [s]), a) -> ReObject s ((Int, [s]), a)
forall s r. RE s r -> ReObject s r
compile (RE s ((Int, [s]), a) -> ReObject s ((Int, [s]), a))
-> RE s ((Int, [s]), a) -> ReObject s ((Int, [s]), a)
forall a b. (a -> b) -> a -> b
$ (,) ((Int, [s]) -> a -> ((Int, [s]), a))
-> RE s (Int, [s]) -> RE s (a -> ((Int, [s]), a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s (Int, [s])
forall s. RE s (Int, [s])
prefixCounter RE s (a -> ((Int, [s]), a)) -> RE s a -> RE s ((Int, [s]), a)
forall a b. RE s (a -> b) -> RE s a -> RE s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
re) [s]
str InfixMatchingState s a
forall s a. InfixMatchingState s a
NoResult of
InfixMatchingState s a
NoResult -> Maybe ([s], a, [s])
forall a. Maybe a
Nothing
r :: InfixMatchingState s a
r@GotResult{} ->
([s], a, [s]) -> Maybe ([s], a, [s])
forall a. a -> Maybe a
Just (InfixMatchingState s a -> [s]
forall s a. InfixMatchingState s a -> [s]
prefixStr InfixMatchingState s a
r, InfixMatchingState s a -> a
forall s a. InfixMatchingState s a -> a
result InfixMatchingState s a
r, InfixMatchingState s a -> [s]
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)
obj [s]
str InfixMatchingState s a
resOld =
let resThis :: InfixMatchingState s a
resThis =
(InfixMatchingState s a
-> Thread s ((Int, [s]), a) -> InfixMatchingState s a)
-> InfixMatchingState s a
-> [Thread s ((Int, [s]), a)]
-> InfixMatchingState s a
forall b a. (b -> a -> b) -> b -> [a] -> b
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 InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
`preferOver` [s] -> Thread s ((Int, [s]), a) -> InfixMatchingState s a
forall s a.
[s] -> Thread s ((Int, [s]), a) -> InfixMatchingState s a
mkInfixMatchingState [s]
str Thread s ((Int, [s]), a)
t)
InfixMatchingState s a
forall s a. InfixMatchingState s a
NoResult ([Thread s ((Int, [s]), a)] -> InfixMatchingState s a)
-> [Thread s ((Int, [s]), a)] -> InfixMatchingState s a
forall a b. (a -> b) -> a -> b
$
ReObject s ((Int, [s]), a) -> [Thread s ((Int, [s]), a)]
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 InfixMatchingState s a -> Bool
forall s a. InfixMatchingState s a -> Bool
gotResult InfixMatchingState s a
resThis Bool -> Bool -> Bool
&& Bool -> Bool
not (InfixMatchingState s a -> Bool
forall s a. InfixMatchingState s a -> Bool
gotResult InfixMatchingState s a
resOld)
then [Thread s ((Int, [s]), a)] -> ReObject s ((Int, [s]), a)
forall s r. [Thread s r] -> ReObject s r
fromThreads ([Thread s ((Int, [s]), a)] -> ReObject s ((Int, [s]), a))
-> [Thread s ((Int, [s]), a)] -> ReObject s ((Int, [s]), a)
forall a b. (a -> b) -> a -> b
$ [Thread s ((Int, [s]), a)] -> [Thread s ((Int, [s]), a)]
forall a. HasCallStack => [a] -> [a]
init ([Thread s ((Int, [s]), a)] -> [Thread s ((Int, [s]), a)])
-> [Thread s ((Int, [s]), a)] -> [Thread s ((Int, [s]), a)]
forall a b. (a -> b) -> a -> b
$ ReObject s ((Int, [s]), a) -> [Thread s ((Int, [s]), a)]
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]
_ | ReObject s ((Int, [s]), a) -> Bool
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 (s -> ReObject s ((Int, [s]), a) -> ReObject s ((Int, [s]), a)
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
findLongestInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findLongestInfix :: forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findLongestInfix = (InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a -> [s] -> Maybe ([s], a, [s])
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
forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
preferOver
findShortestInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findShortestInfix :: forall s a. RE s a -> [s] -> Maybe ([s], a, [s])
findShortestInfix = (InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a -> [s] -> Maybe ([s], a, [s])
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)
-> RE s a -> [s] -> Maybe ([s], a, [s]))
-> (InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a)
-> RE s a
-> [s]
-> Maybe ([s], a, [s])
forall a b. (a -> b) -> a -> b
$ (InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a)
-> InfixMatchingState s a
-> InfixMatchingState s a
-> InfixMatchingState s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
forall s a.
InfixMatchingState s a
-> InfixMatchingState s a -> InfixMatchingState s a
preferOver
replace :: RE s [s] -> [s] -> [s]
replace :: forall s. RE s [s] -> [s] -> [s]
replace RE s [s]
r = (([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ []) (([s] -> [s]) -> [s]) -> ([s] -> [s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> [s] -> [s]
go
where go :: [s] -> [s] -> [s]
go [s]
ys = case RE s [s] -> [s] -> Maybe ([s], [s], [s])
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 [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++)
Just ([s]
before, [s]
m, [s]
rest) -> ([s]
before [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++) ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([s]
m [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++) ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> [s] -> [s]
go [s]
rest