{-# LANGUAGE TypeFamilies, GADTs, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.Applicative.Interface where
import Control.Applicative hiding (empty)
import qualified Control.Applicative
import Control.Arrow
import Data.Traversable
import Data.String
import Data.Maybe
import Text.Regex.Applicative.Types
import Text.Regex.Applicative.Object
instance Functor (RE s) where
fmap :: (a -> b) -> RE s a -> RE s b
fmap a -> b
f RE s a
x = (a -> b) -> RE s a -> RE s b
forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> b
f RE s a
x
a
f <$ :: a -> RE s b -> RE s a
<$ RE s b
x = a -> RE s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
f RE s a -> RE s b -> RE s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE s b
x
instance Applicative (RE s) where
pure :: a -> RE s a
pure a
x = a -> () -> a
forall a b. a -> b -> a
const a
x (() -> a) -> RE s () -> RE s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s ()
forall s. RE s ()
Eps
RE s (a -> b)
a1 <*> :: RE s (a -> b) -> RE s a -> RE s b
<*> RE s a
a2 = RE s (a -> b) -> RE s a -> RE s b
forall s a b. RE s (a -> b) -> RE s a -> RE s b
App RE s (a -> b)
a1 RE s a
a2
RE s a
a *> :: RE s a -> RE s b -> RE s b
*> RE s b
b = (() -> b -> b) -> RE s (() -> b -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> b) -> () -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id) RE s (() -> b -> b) -> RE s () -> RE s (b -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a -> RE s ()
forall s a. RE s a -> RE s ()
Void RE s a
a RE s (b -> b) -> RE s b -> RE s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s b
b
RE s a
a <* :: RE s a -> RE s b -> RE s a
<* RE s b
b = (a -> () -> a) -> RE s (a -> () -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> () -> a
forall a b. a -> b -> a
const RE s (a -> () -> a) -> RE s a -> RE s (() -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
a RE s (() -> a) -> RE s () -> RE s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s b -> RE s ()
forall s a. RE s a -> RE s ()
Void RE s b
b
instance Alternative (RE s) where
RE s a
a1 <|> :: RE s a -> RE s a -> RE s a
<|> RE s a
a2 = RE s a -> RE s a -> RE s a
forall s a. RE s a -> RE s a -> RE s a
Alt RE s a
a1 RE s a
a2
empty :: RE s a
empty = RE s a
forall s a. RE s a
Fail
many :: RE s a -> RE s [a]
many 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 b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
Greedy ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] RE s a
a
some :: RE s a -> RE s [a]
some RE s a
a = (:) (a -> [a] -> [a]) -> RE s a -> RE s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a
a RE s ([a] -> [a]) -> RE s [a] -> RE s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a -> RE s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE s a
a
instance (char ~ Char, string ~ String) => IsString (RE char string) where
fromString :: String -> RE char string
fromString = String -> RE char string
forall a. Eq a => [a] -> RE a [a]
string
comap :: (s2 -> s1) -> RE s1 a -> RE s2 a
comap :: (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
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 (a -> a)
r1 RE s1 a
r2 -> RE s2 (a -> a) -> RE s2 a -> RE s2 a
forall s a b. RE s (a -> b) -> RE s a -> RE s b
App ((s2 -> s1) -> RE s1 (a -> a) -> RE s2 (a -> a)
forall s2 s1 a. (s2 -> s1) -> RE s1 a -> RE s2 a
comap s2 -> s1
f RE s1 (a -> 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)
Fmap a -> a
g RE s1 a
r -> (a -> a) -> RE s2 a -> RE s2 a
forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> a
g ((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
r)
RE s1 a
Fail -> RE s2 a
forall s a. RE s a
Fail
Rep Greediness
gr a -> a -> a
fn a
a RE s1 a
r -> Greediness -> (a -> a -> a) -> a -> RE s2 a -> RE s2 a
forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
gr a -> a -> a
fn a
a ((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
r)
Void RE s1 a
r -> RE s2 a -> RE s2 ()
forall s a. RE s a -> RE s ()
Void ((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
r)
psym :: (s -> Bool) -> RE s s
psym :: (s -> Bool) -> RE s s
psym s -> Bool
p = (s -> Maybe s) -> RE s s
forall s a. (s -> Maybe a) -> RE s a
msym (\s
s -> if s -> Bool
p s
s then s -> Maybe s
forall a. a -> Maybe a
Just s
s else Maybe s
forall a. Maybe a
Nothing)
msym :: (s -> Maybe a) -> RE s a
msym :: (s -> Maybe a) -> RE s a
msym s -> Maybe a
p = ThreadId -> (s -> Maybe a) -> RE s a
forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol (String -> ThreadId
forall a. HasCallStack => String -> a
error String
"Not numbered symbol") s -> Maybe a
p
sym :: Eq s => s -> RE s s
sym :: s -> RE s s
sym s
s = (s -> Bool) -> RE s s
forall s. (s -> Bool) -> RE s s
psym (s
s s -> s -> Bool
forall a. Eq a => a -> a -> Bool
==)
anySym :: RE s s
anySym :: 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
string :: Eq a => [a] -> RE a [a]
string :: [a] -> RE a [a]
string = (a -> RE a a) -> [a] -> RE a [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> RE a a
forall s. Eq s => s -> RE s s
sym
reFoldl :: Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
reFoldl :: Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
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 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
few :: RE s a -> RE s [a]
few :: 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 b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
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 :: RE s a -> RE s (a, [s])
withMatched RE s a
Eps = (() -> [s] -> ((), [s])) -> [s] -> () -> ((), [s])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] (() -> ((), [s])) -> RE s () -> RE s ((), [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (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 (a -> a)
a RE s a
b) =
(\(a -> a
f, [s]
s) (a
x, [s]
t) -> (a -> a
f a
x, [s]
s [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++ [s]
t)) ((a -> a, [s]) -> (a, [s]) -> (a, [s]))
-> RE s (a -> a, [s]) -> RE s ((a, [s]) -> (a, [s]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
RE s (a -> a) -> RE s (a -> a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s (a -> a)
a RE s ((a, [s]) -> (a, [s])) -> RE s (a, [s]) -> RE s (a, [s])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
b
withMatched RE s a
Fail = RE s (a, [s])
forall s a. RE s a
Fail
withMatched (Fmap a -> a
f RE s a
x) = (a -> a
f (a -> a) -> ([s] -> [s]) -> (a, [s]) -> (a, [s])
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) ((a, [s]) -> (a, [s])) -> RE s (a, [s]) -> RE s (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x
withMatched (Rep Greediness
gr a -> a -> a
f a
a0 RE s a
x) =
Greediness
-> ((a, [s]) -> (a, [s]) -> (a, [s]))
-> (a, [s])
-> RE s (a, [s])
-> RE s (a, [s])
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 [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++ [s]
t)) (a
a0, []) (RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x)
withMatched (Void RE s a
x) = (() -> a -> ()
forall a b. a -> b -> a
const () (a -> ()) -> ([s] -> [s]) -> (a, [s]) -> ((), [s])
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) ((a, [s]) -> (a, [s])) -> RE s (a, [s]) -> RE s (a, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> RE s (a, [s])
forall s a. RE s a -> RE s (a, [s])
withMatched RE s a
x
(=~) :: [s] -> RE s a -> Maybe 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 :: 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 (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 :: RE s a -> [s] -> Maybe (a, [s])
findFirstPrefix RE s a
re [s]
str = ReObject s a -> [s] -> Maybe (a, [s]) -> Maybe (a, [s])
forall s r. ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go (RE s a -> ReObject s a
forall s r. RE s r -> ReObject s r
compile RE s a
re) [s]
str Maybe (a, [s])
forall a. Maybe a
Nothing
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
go :: ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go ReObject s r
obj [s]
str Maybe (r, [s])
resOld =
case ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
forall s r. ReObject s r -> [Thread s r] -> (ReObject s r, Maybe r)
walk ReObject s r
forall s r. ReObject s r
emptyObject ([Thread s r] -> (ReObject s r, Maybe r))
-> [Thread s r] -> (ReObject s r, Maybe r)
forall a b. (a -> b) -> a -> b
$ ReObject s r -> [Thread s r]
forall s r. ReObject s r -> [Thread s r]
threads ReObject s r
obj of
(ReObject s r
obj', Maybe r
resThis) ->
let res :: Maybe (r, [s])
res = (((r -> [s] -> (r, [s])) -> [s] -> r -> (r, [s])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [s]
str) (r -> (r, [s])) -> Maybe r -> Maybe (r, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe r
resThis) Maybe (r, [s]) -> Maybe (r, [s]) -> Maybe (r, [s])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (r, [s])
resOld
in
case [s]
str of
[s]
_ | ReObject s r -> Bool
forall s r. ReObject s r -> Bool
failed ReObject s r
obj' -> Maybe (r, [s])
res
[] -> Maybe (r, [s])
res
(s
s:[s]
ss) -> ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go (s -> ReObject s r -> ReObject s r
forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s r
obj') [s]
ss Maybe (r, [s])
res
findLongestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findLongestPrefix RE s a
re [s]
str = ReObject s a -> [s] -> Maybe (a, [s]) -> Maybe (a, [s])
forall s r. ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go (RE s a -> ReObject s a
forall s r. RE s r -> ReObject s r
compile RE s a
re) [s]
str Maybe (a, [s])
forall a. Maybe a
Nothing
where
go :: ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go ReObject s r
obj [s]
str Maybe (r, [s])
resOld =
let res :: Maybe (r, [s])
res = ((r -> (r, [s])) -> Maybe r -> Maybe (r, [s])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r -> [s] -> (r, [s])) -> [s] -> r -> (r, [s])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [s]
str) (Maybe r -> Maybe (r, [s])) -> Maybe r -> Maybe (r, [s])
forall a b. (a -> b) -> a -> b
$ [r] -> Maybe r
forall a. [a] -> Maybe a
listToMaybe ([r] -> Maybe r) -> [r] -> Maybe r
forall a b. (a -> b) -> a -> b
$ ReObject s r -> [r]
forall s r. ReObject s r -> [r]
results ReObject s r
obj) Maybe (r, [s]) -> Maybe (r, [s]) -> Maybe (r, [s])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (r, [s])
resOld
in
case [s]
str of
[s]
_ | ReObject s r -> Bool
forall s r. ReObject s r -> Bool
failed ReObject s r
obj -> Maybe (r, [s])
res
[] -> Maybe (r, [s])
res
(s
s:[s]
ss) -> ReObject s r -> [s] -> Maybe (r, [s]) -> Maybe (r, [s])
go (s -> ReObject s r -> ReObject s r
forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s r
obj) [s]
ss Maybe (r, [s])
res
findShortestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix :: RE s a -> [s] -> Maybe (a, [s])
findShortestPrefix RE s a
re [s]
str = ReObject s a -> [s] -> Maybe (a, [s])
forall s r. ReObject s r -> [s] -> Maybe (r, [s])
go (RE s a -> ReObject s a
forall s r. RE s r -> ReObject s r
compile RE s a
re) [s]
str
where
go :: ReObject s r -> [s] -> Maybe (r, [s])
go ReObject s r
obj [s]
str =
case ReObject s r -> [r]
forall s r. ReObject s r -> [r]
results ReObject s r
obj of
r
r : [r]
_ -> (r, [s]) -> Maybe (r, [s])
forall a. a -> Maybe a
Just (r
r, [s]
str)
[r]
_ | ReObject s r -> Bool
forall s r. ReObject s r -> Bool
failed ReObject s r
obj -> Maybe (r, [s])
forall a. Maybe a
Nothing
[r]
_ ->
case [s]
str of
[] -> Maybe (r, [s])
forall a. Maybe a
Nothing
s
s:[s]
ss -> ReObject s r -> [s] -> Maybe (r, [s])
go (s -> ReObject s r -> ReObject s r
forall s r. s -> ReObject s r -> ReObject s r
step s
s ReObject s r
obj) [s]
ss
findFirstInfix :: RE s a -> [s] -> Maybe ([s], a, [s])
findFirstInfix :: 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
re) [s]
str
prefixCounter :: RE s (Int, [s])
prefixCounter :: RE s (Int, [s])
prefixCounter = ([s] -> [s]) -> (Int, [s]) -> (Int, [s])
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 b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
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
{ InfixMatchingState s a -> Int
prefixLen :: !Int
, InfixMatchingState s a -> [s]
prefixStr :: [s]
, InfixMatchingState s a -> a
result :: a
, InfixMatchingState s a -> [s]
postfixStr :: [s]
}
| NoResult
preferOver
:: InfixMatchingState s a
-> InfixMatchingState s a
-> InfixMatchingState s a
preferOver :: 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 :: [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 :: forall s a. Int -> [s] -> a -> [s] -> InfixMatchingState s a
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 :: 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 :: (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 (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 (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. [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 :: 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 :: 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 :: 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