module Text.RegexPR (
matchRegexPR
, multiMatchRegexPR
, gmatchRegexPR
, getbrsRegexPR
, ggetbrsRegexPR
, subRegexPR
, subRegexPRBy
, gsubRegexPR
, gsubRegexPRBy
, splitRegexPR
) where
import Hidden.RegexPRCore ( matchRegexPRVerbose,
multiMatchRegexPRVerbose )
import Hidden.RegexPRTypes ( MatchFun , VerboseMatchFun,
RegexResult, VerboseResult ,
MatchList )
import Data.Char ( isDigit )
import Data.List ( sort, nubBy )
import Data.Function ( on )
import Data.Maybe ( fromMaybe )
import Control.Arrow ( first )
matchRegexPR :: MatchFun Maybe
matchRegexPR :: MatchFun Maybe
matchRegexPR = VerboseMatchFun Maybe -> MatchFun Maybe
forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun Maybe
matchRegexPRVerbose
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR = VerboseMatchFun [] -> MatchFun []
forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun []
multiMatchRegexPRVerbose
gmatchRegexPR :: MatchFun []
gmatchRegexPR :: MatchFun []
gmatchRegexPR String
reg = (String, String) -> [(RegexResult, MatchList)]
baseFun ((String, String) -> [(RegexResult, MatchList)])
-> (String -> (String, String))
-> String
-> [(RegexResult, MatchList)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""
where
baseFun :: (String, String) -> [(RegexResult, MatchList)]
baseFun ( String
_, String
"" ) = []
baseFun (String, String)
pos = [(RegexResult, MatchList)]
-> (((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)])
-> Maybe ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun (Maybe ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)])
-> Maybe ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
forall a b. (a -> b) -> a -> b
$ VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String, String)
pos
justFun :: ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun mr :: ((String, String, (String, String)), MatchList)
mr@( ( String
_, String
r, (String, String)
pos ), MatchList
_ )
= ((String, String, (String, String)) -> RegexResult)
-> ((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ((String, String, (String, String)), MatchList)
mr (RegexResult, MatchList)
-> [(RegexResult, MatchList)] -> [(RegexResult, MatchList)]
forall a. a -> [a] -> [a]
:
(String, String) -> [(RegexResult, MatchList)]
baseFun ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then (String, String) -> (String, String)
forall {a}. ([a], [a]) -> ([a], [a])
next (String, String)
pos else (String, String)
pos )
next :: ([a], [a]) -> ([a], [a])
next ( [a]
p, a
x:[a]
xs ) = ( a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
p, [a]
xs )
next ([a], [a])
_ = String -> ([a], [a])
forall a. HasCallStack => String -> a
error String
"can not go to next"
simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun :: forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun f
mf String
reg
= (((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList))
-> f ((String, String, (String, String)), MatchList)
-> f (RegexResult, MatchList)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( ((String, String, (String, String)) -> RegexResult)
-> ((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ) (f ((String, String, (String, String)), MatchList)
-> f (RegexResult, MatchList))
-> (String -> f ((String, String, (String, String)), MatchList))
-> String
-> f (RegexResult, MatchList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerboseMatchFun f
mf String
reg ((String, String)
-> f ((String, String, (String, String)), MatchList))
-> (String -> (String, String))
-> String
-> f ((String, String, (String, String)), MatchList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""
simplifyResult :: VerboseResult -> RegexResult
simplifyResult :: (String, String, (String, String)) -> RegexResult
simplifyResult ( String
pre, String
ret, (String
_, String
rest) ) = ( String
ret, (String
pre, String
rest) )
getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR :: String -> String -> [String]
getbrsRegexPR String
reg String
str
= case MatchFun Maybe
matchRegexPR String
reg String
str of
Maybe (RegexResult, MatchList)
Nothing
-> []
Just ( ( String
ret, (String
_, String
_) ), MatchList
ml )
-> String
ret String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Int, String) -> String) -> MatchList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd ( MatchList -> MatchList
forall a. Ord a => [a] -> [a]
sort (MatchList -> MatchList) -> MatchList -> MatchList
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> (Int, String) -> Bool) -> MatchList -> MatchList
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ( (Int -> Int -> Bool)
-> ((Int, String) -> Int) -> (Int, String) -> (Int, String) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int, String) -> Int
forall a b. (a, b) -> a
fst ) MatchList
ml )
ggetbrsRegexPR :: String -> String -> [ [ String ] ]
ggetbrsRegexPR :: String -> String -> [[String]]
ggetbrsRegexPR String
reg
= ((RegexResult, MatchList) -> [String])
-> [(RegexResult, MatchList)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ( \( (String
m, (String, String)
_), MatchList
bl ) ->
String
m String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Int, String) -> String) -> MatchList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd ( MatchList -> MatchList
forall a. Ord a => [a] -> [a]
sort (MatchList -> MatchList) -> MatchList -> MatchList
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> (Int, String) -> Bool) -> MatchList -> MatchList
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((Int -> Int -> Bool)
-> ((Int, String) -> Int) -> (Int, String) -> (Int, String) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int, String) -> Int
forall a b. (a, b) -> a
fst) MatchList
bl ) )
([(RegexResult, MatchList)] -> [[String]])
-> (String -> [(RegexResult, MatchList)]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchFun []
gmatchRegexPR String
reg
splitRegexPR :: String -> String -> [String]
splitRegexPR :: String -> String -> [String]
splitRegexPR String
reg String
str
= case [(RegexResult, MatchList)]
gmatched of
[ ] -> [ ]
[(RegexResult, MatchList)]
_ -> ((RegexResult, MatchList) -> String)
-> [(RegexResult, MatchList)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ( (String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> ((RegexResult, MatchList) -> (String, String))
-> (RegexResult, MatchList)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RegexResult -> (String, String)
forall a b. (a, b) -> b
snd(RegexResult -> (String, String))
-> ((RegexResult, MatchList) -> RegexResult)
-> (RegexResult, MatchList)
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RegexResult, MatchList) -> RegexResult
forall a b. (a, b) -> a
fst ) [(RegexResult, MatchList)]
gmatched [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ ((String, String) -> String
forall a b. (a, b) -> b
snd((String, String) -> String)
-> ([(RegexResult, MatchList)] -> (String, String))
-> [(RegexResult, MatchList)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RegexResult -> (String, String)
forall a b. (a, b) -> b
snd(RegexResult -> (String, String))
-> ([(RegexResult, MatchList)] -> RegexResult)
-> [(RegexResult, MatchList)]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RegexResult, MatchList) -> RegexResult
forall a b. (a, b) -> a
fst((RegexResult, MatchList) -> RegexResult)
-> ([(RegexResult, MatchList)] -> (RegexResult, MatchList))
-> [(RegexResult, MatchList)]
-> RegexResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(RegexResult, MatchList)] -> (RegexResult, MatchList)
forall a. HasCallStack => [a] -> a
last) [(RegexResult, MatchList)]
gmatched ]
where gmatched :: [(RegexResult, MatchList)]
gmatched = MatchFun []
gmatchRegexPR String
reg String
str
subRegexPR :: String -> String -> String -> String
subRegexPR :: String -> String -> String -> String
subRegexPR String
reg String
sub = String -> (String -> String) -> String -> String
subRegexPRBy String
reg (String -> String -> String
forall a b. a -> b -> a
const String
sub)
subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy String
reg String -> String
subf String
src
= case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String
"",String
src) of
Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
m, (String, String)
sp), MatchList
_) -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
subf String
m) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
sp
Maybe ((String, String, (String, String)), MatchList)
Nothing -> String
src
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR String
reg String
sub String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
forall a. Maybe a
Nothing String
reg (String -> String -> String
forall a b. a -> b -> a
const String
sub) (String
"", String
src)
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy String
reg String -> String
subf String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
forall a. Maybe a
Nothing String
reg String -> String
subf (String
"", String
src)
gsubRegexPRGen ::
Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen :: Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
pmp String
reg String -> String
fsub (String, String)
src
= case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String, String)
src of
Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
match, sp :: (String, String)
sp@(~(String
p,Char
x:String
xs))), MatchList
_)
-> case (Maybe (String, String)
pmp, (String, String)
sp) of
(Just (String
_, String
""), (String, String)
_) -> String
""
(Maybe (String, String), (String, String))
_ | (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp Maybe (String, String) -> Maybe (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (String, String)
pmp -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++
Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
p, String
xs)
| Bool
otherwise -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
fsub String
match) String -> String -> String
forall a. [a] -> [a] -> [a]
++
Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (String, String)
sp
Maybe ((String, String, (String, String)), MatchList)
Nothing -> (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
src
subBackRef ::
((String, String, (String, String)), MatchList) -> String -> String
subBackRef :: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String))
_, MatchList
_) String
"" = String
""
subBackRef al :: ((String, String, (String, String)), MatchList)
al@((String
_, String
match, (String
hasRead,String
post)), MatchList
ml) (Char
'\\':str :: String
str@(Char
c:String
rest))
| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"&0" = String
match String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' = String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
match) String
hasRead) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = String
post String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = (Int, String) -> String
forall a b. (a, b) -> b
snd (MatchList -> (Int, String)
forall a. HasCallStack => [a] -> a
head MatchList
ml) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Int -> MatchList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
rest) MatchList
ml) String -> String -> String
forall a. [a] -> [a] -> [a]
++
((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
forall a. HasCallStack => [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
str)
| Bool
otherwise = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Int -> MatchList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
str) MatchList
ml) String -> String -> String
forall a. [a] -> [a] -> [a]
++
((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit String
str)
subBackRef ((String, String, (String, String)), MatchList)
al (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
cs