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 = simplifyMatchFun matchRegexPRVerbose
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR = simplifyMatchFun multiMatchRegexPRVerbose
gmatchRegexPR :: MatchFun []
gmatchRegexPR reg = baseFun . (,) ""
where
baseFun ( _, "" ) = []
baseFun pos = maybe [] justFun $ matchRegexPRVerbose reg pos
justFun mr@( ( _, r, pos ), _ )
= first simplifyResult mr :
baseFun ( if null r then next pos else pos )
next ( p, x:xs ) = ( x:p, xs )
next _ = error "can not go to next"
simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun mf reg
= fmap ( first simplifyResult ) . mf reg . (,) ""
simplifyResult :: VerboseResult -> RegexResult
simplifyResult ( pre, ret, (_, rest) ) = ( ret, (pre, rest) )
getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR reg str
= case matchRegexPR reg str of
Nothing
-> []
Just ( ( ret, (_, _) ), ml )
-> ret : map snd ( sort $ nubBy ( on (==) fst ) ml )
ggetbrsRegexPR :: String -> String -> [ [ String ] ]
ggetbrsRegexPR reg
= map ( \( (m, _), bl ) ->
m : map snd ( sort $ nubBy (on (==) fst) bl ) )
. gmatchRegexPR reg
splitRegexPR :: String -> String -> [String]
splitRegexPR reg str
= case gmatched of
[ ] -> [ ]
_ -> map ( fst.snd.fst ) gmatched ++ [ (snd.snd.fst.last) gmatched ]
where gmatched = gmatchRegexPR reg str
subRegexPR :: String -> String -> String -> String
subRegexPR reg sub = subRegexPRBy reg (const sub)
subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy reg subf src
= case matchRegexPRVerbose reg ("",src) of
Just al@((pre, m, sp), _) -> pre ++ subBackRef al (subf m) ++ snd sp
Nothing -> src
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR reg sub src = gsubRegexPRGen Nothing reg (const sub) ("", src)
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy reg subf src = gsubRegexPRGen Nothing reg subf ("", src)
gsubRegexPRGen ::
Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen pmp reg fsub src
= case matchRegexPRVerbose reg src of
Just al@((pre, match, sp@(~(p,x:xs))), _)
-> case (pmp, sp) of
(Just (_, ""), _) -> ""
_ | Just sp == pmp -> pre ++ [x] ++
gsubRegexPRGen (Just sp) reg fsub (x:p, xs)
| otherwise -> pre ++ subBackRef al (fsub match) ++
gsubRegexPRGen (Just sp) reg fsub sp
Nothing -> snd src
subBackRef ::
((String, String, (String, String)), MatchList) -> String -> String
subBackRef (_, _) "" = ""
subBackRef al@((_, match, (hasRead,post)), ml) ('\\':str@(c:rest))
| c `elem` "&0" = match ++ subBackRef al rest
| c == '`' = reverse (drop (length match) hasRead) ++ subBackRef al rest
| c == '\'' = post ++ subBackRef al rest
| c == '+' = snd (head ml) ++ subBackRef al rest
| c == '{' = fromMaybe "" (lookup (read $ takeWhile (/='}') rest) ml) ++
subBackRef al (tail $ dropWhile (/='}') str)
| otherwise = fromMaybe "" (lookup (read $ takeWhile isDigit str) ml) ++
subBackRef al (dropWhile isDigit str)
subBackRef al (c:cs) = c : subBackRef al cs