module Text.Regex.Do.Pcre.Replace( ReplaceCase(..), Replace(..), replaceMatch, defaultReplacer, getGroup, Mr_ ) where import Text.Regex.Base.RegexLike as R import Data.Array as A import Prelude as P import Data.ByteString as B import qualified Text.Regex.Do.Pcre.Option as O import Text.Regex.Do.Convert import Text.Regex.Do.Pcre.Match as M import Text.Regex.Do.Pcre.Result as R import Text.Regex.Do.TypeDo import Text.Regex.Do.TypeRegex import Text.Regex.Do.Pcre.Matchf type Mr_ a out = (Match a a out, Rx_ a a, Replace_ a, Opt_ a) {- | == dynamic group replace custom replacer fn returns replacement value >>> replacer::GroupReplacer String replacer = defaultReplacer 1 tweak1 where tweak1 str1 = case str1 of "101" -> "[сто один]" "3" -> "[three]" otherwise -> trace str1 "?" 'Once' vs 'All' options >>> replace [Once,Utf8] (Pattern "\\w=(\\d{1,3})", replacer) $ Body "a=101 b=3 12" "a=[сто один] b=3 12" >>> replace [All,Utf8] (Pattern "\\w=(\\d{1,3})", replacer) $ Body "a=101 b=3 12" "a=[сто один] b=[three] 12" == static replace for simple (no group) needle >>> replace [Once,Utf8] (Pattern "менее", Replacement "более") $ Body "менее менее" "более менее" >>> replace [Once,Utf8] (Pattern "^a\\s", Replacement "A") $ Body "a bc хол.гор." "Abc хол.гор." -} class Replace r a where replace::[ReplaceCase] -> Pattern a -> r a -> Body a -> a instance Replace Replacement String where replace = replace_ instance Replace Replacement ByteString where replace = replace_ instance Replace GroupReplacer String where replace = replaceG instance Replace GroupReplacer ByteString where replace = replaceG replace_::Mr_ a [a] => [ReplaceCase] -> Pattern a -> Replacement a -> Body a -> a replace_ cases0 p0 repl0 b0 = if isUtf8 cases0 then utfFn2 else fn2 (pat2 p0,repl0) b0 where fn1 = if P.elem All cases0 then rall else ronce fn2 = if P.elem All cases0 then rall else ronce utfFn2 = let res1 = fn1 (pat2 $ toByteString' <$> p0, toByteString' <$> repl0) $ toByteString' <$> b0 in toA res1 pat2 p0 = addOpt p0 cOpt1 cOpt1 = comp cases0 replaceG::Mr_ a [a] => [ReplaceCase] -> Pattern a -> GroupReplacer a -> Body a -> a replaceG cases0 p0 repl0 = fn1 pat2 repl0 where pat2 = addOpt p0 cOpt cOpt = comp cases0 fn1 = if P.elem All cases0 then rallGroup else ronceGroup class Replace_ a where prefix::PosLen -> a -> a suffix::PosLen -> a -> a concat'::[a] -> a len'::a -> Int toByteString'::a -> ByteString toA::ByteString -> a instance Replace_ String where prefix pl0 = P.take $ fst pl0 suffix pl0 = P.drop (pos1 + len1) where pos1 = fst pl0 len1 = snd pl0 concat' = P.concat toByteString' = toByteString toA = toString len' = P.length instance Replace_ B.ByteString where prefix pl0 = B.take $ fst pl0 suffix pl0 = B.drop (pos1 + len1) where pos1 = fst pl0 len1 = snd pl0 concat' = B.concat toByteString' = id toA = id len' = B.length -- static ronce::Mr_ a [a] => (Pattern Regex, Replacement a) -> Body a -> a ronce (p0, Replacement repl0) h1@(Body h0) = let pl2 = let m1 = marray_ p0 h1 in R.poslen m1 in case pl2 of Nothing -> h0 Just lpl1 -> firstGroup lpl1 (repl0, h0) rall::Mr_ a [a] => (Pattern Regex, Replacement a) -> Body a -> a rall (p0, Replacement repl0) h1@(Body h0) = let lpl1 = let m1 = marray_ p0 h1 in R.poslen m1::[[PosLen]] foldFn1 lpl1 acc1 = firstGroup lpl1 (repl0,acc1) in P.foldr foldFn1 h0 lpl1 firstGroup::Replace_ a => [PosLen] -> (a,a) -> a firstGroup (pl0:_) r1@(new0,a0) = acc $ replaceMatch pl0 (new0, acc1) where acc1 = ReplaceAcc { acc = a0, pos_adj = 0 } -- dynamic {- | you can write a custom replacer. This is only one common use case. Replaces specified (by idx) group match with tweaked value. -} defaultReplacer::(Replace_ a, R.Extract a) => Int -- ^ group idx -> (a -> a) -- ^ (group match -> replacement) tweak -> GroupReplacer a defaultReplacer idx0 tweak0 = GroupReplacer fn1 where fn1 (ma0::MatchArray) acc0 = maybe acc0 fn1 mval1 where pl1 = ma0 A.! idx0 :: (R.MatchOffset, R.MatchLength) mval1 = getGroup acc0 ma0 idx0 fn1 str1 = replaceMatch pl1 (str2, acc0) where str2 = tweak0 str1 {- | get group content safely call from your custom 'GroupReplacer' passed to 'replaceGroup' -} getGroup::R.Extract a => ReplaceAcc a -> MatchArray -> Int -> Maybe a getGroup acc0 ma0 idx0 = if idx0 >= P.length ma0 then Nothing -- safety catch else Just val1 where pl1 = ma0 A.! idx0 :: (R.MatchOffset, R.MatchLength) pl2 = adjustPoslen pl1 acc0 val1 = extract pl2 $ acc acc0 adjustPoslen::PosLen -> ReplaceAcc a -> PosLen adjustPoslen (p0,l0) acc0 = (p0 + pos_adj acc0, l0) ronceGroup::Rx_ a a => Pattern Regex -> GroupReplacer a -> Body a -> a ronceGroup pat0 (GroupReplacer repl0) h1@(Body h0) = let m1 = marray_ pat0 h1::Maybe MatchArray in case m1 of Nothing -> h0 Just ma1 -> let a1 = ReplaceAcc { acc = h0, pos_adj = 0 } in acc $ repl0 ma1 a1 rallGroup::Mr_ a [a] => Pattern Regex -> GroupReplacer a -> Body a -> a rallGroup pat0 (GroupReplacer repl0) b1@(Body b0) = let ma1 = marray_ pat0 b1::[MatchArray] acc1 = ReplaceAcc { acc = b0, pos_adj = 0 } in acc $ P.foldl (flip repl0) acc1 ma1 {- | call from your custom 'GroupReplacer' passed to 'replaceGroup' see example replacer above -} replaceMatch::Replace_ a => PosLen -- ^ replaceable, unadjusted -> (a, ReplaceAcc a) -- ^ (new val, acc passed to 'GroupReplacer') -> ReplaceAcc a -- ^ new acc replaceMatch pl0@(_,l0) (new0, acc0) = ReplaceAcc { acc = acc1, pos_adj = pos_adj acc0 + l1 - l0 } where pl1 = adjustPoslen pl0 acc0 prefix1 = prefix pl1 $ acc acc0 suffix1 = suffix pl1 $ acc acc0 acc1 = concat' [prefix1, new0, suffix1] l1 = len' new0 addOpt::Opt_ a => Pattern a -> [O.Comp] -> Pattern Regex addOpt pat0 opt0 = Pattern rx1 where rx1 = M.makeRegexOpts opt0 [] pat0 comp::[ReplaceCase]-> [O.Comp] comp = P.map mapFn . P.filter filterFn where filterFn o1 = o1 `P.elem` [Utf8,Multiline] mapFn Utf8 = O.Utf8 mapFn Multiline = O.Multiline isUtf8::[ReplaceCase] -> Bool isUtf8 case0 = Utf8 `P.elem` case0