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 reg :: 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
. (,) ""
where
baseFun :: (String, String) -> [(RegexResult, MatchList)]
baseFun ( _, "" ) = []
baseFun pos :: (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@( ( _, r :: String
r, pos :: (String, String)
pos ), _ )
= ((String, String, (String, String)) -> RegexResult)
-> ((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList)
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 (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 ( p :: [a]
p, x :: a
x:xs :: [a]
xs ) = ( a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
p, [a]
xs )
next _ = String -> ([a], [a])
forall a. HasCallStack => String -> a
error "can not go to next"
simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun :: VerboseMatchFun f -> MatchFun f
simplifyMatchFun mf :: VerboseMatchFun f
mf reg :: String
reg
= (((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList))
-> f ((String, String, (String, String)), MatchList)
-> f (RegexResult, MatchList)
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 (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
. (,) ""
simplifyResult :: VerboseResult -> RegexResult
simplifyResult :: (String, String, (String, String)) -> RegexResult
simplifyResult ( pre :: String
pre, ret :: String
ret, (_, rest :: String
rest) ) = ( String
ret, (String
pre, String
rest) )
getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR :: String -> String -> [String]
getbrsRegexPR reg :: String
reg str :: String
str
= case MatchFun Maybe
matchRegexPR String
reg String
str of
Nothing
-> []
Just ( ( ret :: String
ret, (_, _) ), ml :: 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 reg :: String
reg
= ((RegexResult, MatchList) -> [String])
-> [(RegexResult, MatchList)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ( \( (m :: String
m, _), bl :: 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 reg :: String
reg str :: String
str
= case [(RegexResult, MatchList)]
gmatched of
[ ] -> [ ]
_ -> ((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. [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 reg :: String
reg sub :: 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 reg :: String
reg subf :: String -> String
subf src :: String
src
= case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg ("",String
src) of
Just al :: ((String, String, (String, String)), MatchList)
al@((pre :: String
pre, m :: String
m, sp :: (String, String)
sp), _) -> 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
Nothing -> String
src
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR reg :: String
reg sub :: String
sub src :: 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
src)
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy reg :: String
reg subf :: String -> String
subf src :: 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
src)
gsubRegexPRGen ::
Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen :: Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen pmp :: Maybe (String, String)
pmp reg :: String
reg fsub :: String -> String
fsub src :: (String, String)
src
= case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String, String)
src of
Just al :: ((String, String, (String, String)), MatchList)
al@((pre :: String
pre, match :: String
match, sp :: (String, String)
sp@(~(p :: String
p,x :: Char
x:xs :: String
xs))), _)
-> case (Maybe (String, String)
pmp, (String, String)
sp) of
(Just (_, ""), _) -> ""
_ | (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
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 (_, _) "" = ""
subBackRef al :: ((String, String, (String, String)), MatchList)
al@((_, match :: String
match, (hasRead :: String
hasRead,post :: String
post)), ml :: MatchList
ml) ('\\':str :: String
str@(c :: Char
c:rest :: String
rest))
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "&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
== '`' = String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> 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
== '\'' = 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
== '+' = (Int, String) -> String
forall a b. (a, b) -> b
snd (MatchList -> (Int, String)
forall a. [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
== '{' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (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
/='}') 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. [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
/='}') String
str)
| Bool
otherwise = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (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 al :: ((String, String, (String, String)), MatchList)
al (c :: Char
c:cs :: 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