diff --git a/regex-do.cabal b/regex-do.cabal --- a/regex-do.cabal +++ b/regex-do.cabal @@ -1,5 +1,5 @@ name: regex-do -version: 1.8 +version: 1.9 synopsis: PCRE wrapper description: format, search, replace (String | ByteString) with PCRE regex. Utf8-safe author: Imants Cekusins @@ -28,6 +28,7 @@ Text.Regex.Do.Convert Text.Regex.Do.Pad Text.Regex.Do.Pcre.MatchSame + Text.Regex.Do.Pcre.ReplaceOpen other-modules: Text.Regex.Do.Pcre.Matchf Text.Regex.Do.Pcre.Result diff --git a/src/Text/Regex/Do/Pcre/Replace.hs b/src/Text/Regex/Do/Pcre/Replace.hs --- a/src/Text/Regex/Do/Pcre/Replace.hs +++ b/src/Text/Regex/Do/Pcre/Replace.hs @@ -1,28 +1,20 @@ module Text.Regex.Do.Pcre.Replace( - ReplaceCase(..), - Replace(..), - replaceMatch, - defaultReplacer, - getGroup, - Mr_ - ) where + replace, + ReplaceCase_(..)) 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 +import qualified Text.Regex.Do.Pcre.ReplaceOpen as O +import Text.Regex.Do.Convert -type Mr_ a out = (Match a a out, Rx_ a a, Replace_ a, Opt_ a) - {- | == dynamic group replace custom replacer fn returns replacement value @@ -35,190 +27,71 @@ 'Once' vs 'All' options - >>> replace [Once,Utf8] (Pattern "\\w=(\\d{1,3})", replacer) $ Body "a=101 b=3 12" + >>> 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" + >>> 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 "менее менее" + for no-regex 'ByteString' replacement see "Text.Regex.Do.Split" + >>> replace [Once,Utf8] (Pattern "менее") (Replacement "более") $ Body "менее менее" + "более менее" - >>> replace [Once,Utf8] (Pattern "^a\\s", Replacement "A") $ Body "a bc хол.гор." + >>> 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 +replace::(Rx_ a a, ReplaceCase_ r a, Opt_ a) => + [ReplaceCase] -> Pattern a -> r a -> Body a -> a +replace case0 p0 r0 b0 = replace_ case0 p1 r0 b0 + where opt1 = comp case0 + p1 = addOpt p0 opt1 -{- | 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 - +class ReplaceCase_ r a where + replace_::[ReplaceCase] -> Pattern Regex -> r a -> Body a -> a -adjustPoslen::PosLen -> ReplaceAcc a -> PosLen -adjustPoslen (p0,l0) acc0 = (p0 + pos_adj acc0, l0) +instance ReplaceCase_ Replacement String where + replace_ case0 p0 r0 b0 = + let ma1 = marray_ p0 b1::Maybe MatchArray + ma2 = marray_ p0 b1::[MatchArray] + b1 = toByteString <$> b0 + r1 = toByteString <$> r0 + isAll1 = All `P.elem` case0 + isUtf1 = Utf8 `P.elem` case0 + bs1 = if isAll1 then O.replace ma2 r1 b1 + else O.replace ma1 r1 b1 + in if isUtf1 then toString bs1 + else vanilla_replace case0 p0 r0 b0 -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 +instance ReplaceCase_ Replacement ByteString where + replace_ = vanilla_replace +instance ReplaceCase_ GroupReplacer ByteString where + replace_ = vanilla_replace -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 +instance ReplaceCase_ GroupReplacer String where + replace_ = vanilla_replace -{- | 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 +vanilla_replace::(O.ReplaceOpen [] r, O.ReplaceOpen Maybe r, + O.Extract' a,Rx_ a a,Opt_ a) => + [ReplaceCase] -> Pattern Regex -> r a -> Body a -> a +vanilla_replace case0 p0 r0 b0 = + let ma1 = marray_ p0 b0::Maybe MatchArray + ma2 = marray_ p0 b0:: [MatchArray] + isAll1 = All ` P.elem ` case0 + in if isAll1 then O.replace ma2 r0 b0 + else O.replace ma1 r0 b0 addOpt::Opt_ a => @@ -232,7 +105,3 @@ 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 diff --git a/src/Text/Regex/Do/Pcre/ReplaceOpen.hs b/src/Text/Regex/Do/Pcre/ReplaceOpen.hs new file mode 100644 --- /dev/null +++ b/src/Text/Regex/Do/Pcre/ReplaceOpen.hs @@ -0,0 +1,155 @@ +{- | extensible and reusable replacement functions + + Run replacement with your preferred content types e.g. "Data.Text", + from search results with non-PCRE regex or non-regex libs + + open a bug or a PR on to request a new 'ReplaceOpen' instance -} +module Text.Regex.Do.Pcre.ReplaceOpen + (ReplaceOpen(..), + toArray, + Extract'(..), + defaultReplacer, + getGroup, + replaceMatch + ) + where + +import Text.Regex.Base.RegexLike as R +import Data.Array as A +import Prelude as P +import Data.ByteString as B +import Text.Regex.Do.TypeDo +import Text.Regex.Do.Pcre.Result as R + + +toArray::[PosLen] -> MatchArray +toArray [] = listArray (0,0) [] +toArray lpl0 = listArray (1, P.length lpl0) lpl0 + + +{- | see String, ByteString instances for implementation examples + + see "Text.Regex.Base.RegexLike" for 'Extract' detail -} +class Extract a => Extract' a where + concat'::[a] -> a + len'::a -> Int + + +prefix::Extract a => PosLen -> a -> a +prefix pl0 = before $ fst pl0 + +suffix::Extract a => PosLen -> a -> a +suffix pl0 = after (pos1 + len1) + where pos1 = fst pl0 + len1 = snd pl0 + + +class ReplaceOpen f r where + replace::Extract' a => f MatchArray -> r a -> Body a -> a + + +instance ReplaceOpen Maybe Replacement where + replace Nothing (Replacement repl0) (Body b0) = b0 + replace (Just ma0) (Replacement repl0) (Body b0) = firstGroup lpl1 (repl0, b0) + where lpl1 = A.elems ma0 + + +instance ReplaceOpen [] Replacement where + replace [] _ (Body b0) = b0 + replace ma0 (Replacement repl0) (Body b0) = + let lpl1 = R.poslen ma0::[[PosLen]] + foldFn1 lpl1 acc1 = firstGroup lpl1 (repl0,acc1) + in P.foldr foldFn1 b0 lpl1 + + +instance ReplaceOpen Maybe GroupReplacer where + replace Nothing _ (Body b0) = b0 + replace (Just ma0) (GroupReplacer repl0) (Body b0) = + let a1 = ReplaceAcc { + acc = b0, + pos_adj = 0 + } + in acc $ repl0 ma0 a1 + + +instance ReplaceOpen [] GroupReplacer where + replace [] _ (Body b0) = b0 + replace ma0 (GroupReplacer repl0) (Body b0) = + let acc1 = ReplaceAcc { acc = b0, pos_adj = 0 } + in acc $ P.foldl (flip repl0) acc1 ma0 + + +firstGroup::Extract' a => + [PosLen] -> (a,a) -> a +firstGroup (pl0:_) r1@(new0,a0) = acc $ replaceMatch pl0 (new0, acc1) + where acc1 = ReplaceAcc { + acc = a0, + pos_adj = 0 + } + + +instance Extract' String where + concat' = P.concat + len' = P.length + + +instance Extract' B.ByteString where + concat' = B.concat + len' = B.length + + + +-- dynamic +{- | Replaces specified (by idx) group match with tweaked value. + Works for one common simple use case + + 'GroupReplacer' can be used with complicated regex + + another custom dynamic replacer could e.g. + + inspect all group matches before looking up a replacement. -} +defaultReplacer::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 + + see 'defaultReplacer' source for use example + -} +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 + + +{- | call from your custom 'GroupReplacer' passed to 'replaceGroup' + + see 'defaultReplacer' source for use example -} +replaceMatch::Extract' 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 + + +adjustPoslen::PosLen -> ReplaceAcc a -> PosLen +adjustPoslen (p0,l0) acc0 = (p0 + pos_adj acc0, l0) diff --git a/test/TestRegex/TestReplace.hs b/test/TestRegex/TestReplace.hs --- a/test/TestRegex/TestReplace.hs +++ b/test/TestRegex/TestReplace.hs @@ -4,7 +4,8 @@ import Test.Hspec import Text.Regex.Do.TypeDo -import Text.Regex.Do.Pcre.Replace +import Text.Regex.Do.Pcre.Replace as R +import Text.Regex.Do.Pcre.ReplaceOpen hiding (replace) import Text.Regex.Do.Convert import Data.ByteString as B import Debug.Trace