module Regexdo.Pcre.Replace(
ReplaceCase(..),
Replace_cl(..),
replaceMatch,
defaultReplacer,
Mr
) where
import Data.Array
import Data.ByteString
import Prelude as P
import qualified Data.ByteString as B
import qualified Regexdo.Pcre.Option as O
import qualified Text.Regex.Base.RegexLike as R
import Regexdo.Convert
import Regexdo.Pcre.Match
import Regexdo.Pcre.Result
import Regexdo.TypeDo
import Regexdo.TypeRegex
type Mr a = (Match_cl Regex a, Replace_cl' a, Match_opt a)
class Replace_cl' a where
prefix::PosLen -> a -> a
suffix::PosLen -> a -> a
concat'::[a] -> a
toByteString'::a -> ByteString
toA::ByteString -> a
class Replace_cl a where
replace::Mr a =>
[ReplaceCase] -> (Needle a, Replacement a) -> Haystack a -> a
replace cases0 (pat1,repl1) hay0 =
if isUtf8 cases0 then utfFn2
else fn2 (pat2 pat1,repl1) hay0
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' <$> pat1, toByteString' <$> repl1) $ toByteString' <$> hay0
in toA res1
pat2 pat1 = addOpt pat1 cOpt1
cOpt1 = comp cases0
replaceGroup::Mr a =>
[ReplaceCase] -> (Needle a, GroupReplacer a) -> Haystack a -> a
replaceGroup cases (pat1,repl1) = fn1 (pat2,repl1)
where pat2 = addOpt pat1 cOpt
cOpt = comp cases
fn1 = if P.elem All cases
then rallGroup
else ronceGroup
instance Replace_cl String
instance Replace_cl' String where
prefix pl1 = P.take $ fst pl1
suffix pl1 = P.drop (pos1 + len1)
where pos1 = fst pl1
len1 = snd pl1
concat' = P.concat
toByteString' = toByteString
toA = toString
instance Replace_cl B.ByteString
instance Replace_cl' B.ByteString where
prefix pl1 = B.take $ fst pl1
suffix pl1 = B.drop (pos1 + len1)
where pos1 = fst pl1
len1 = snd pl1
concat' = B.concat
toByteString' = id
toA = id
replaceMatch::Replace_cl' a =>
(R.MatchOffset, R.MatchLength) ->
(a, a)
-> a
replaceMatch pl1 (repl1, bs_str1) =
concat' [prefix1,repl1,suffix1]
where prefix1 = prefix pl1 bs_str1
suffix1 = suffix pl1 bs_str1
ronce::Mr a =>
(Needle Regex, Replacement a) -> Haystack a -> a
ronce (pat1, Replacement repl1) body1@(Haystack bs_str1) =
let pl2 = do
let m1 = match pat1 body1
poslen m1
in case pl2 of
Nothing -> bs_str1
Just pl_arr -> firstGroup pl_arr (repl1,bs_str1)
rall::Mr a =>
(Needle Regex, Replacement a) -> Haystack a -> a
rall (pat1, Replacement repl1) body1@(Haystack bs_str1) =
let pl_arr_arr1 = do
let m1 = matchAll pat1 body1
poslen m1
folderFn pl_arr acc1 = firstGroup pl_arr (repl1,acc1)
in P.foldr folderFn bs_str1 pl_arr_arr1
firstGroup::Replace_cl' a =>
[PosLen] -> (a,a) -> a
firstGroup (pl1:_) r1@(repl1,bs_str1) = replaceMatch pl1 r1
defaultReplacer::(Replace_cl' a, R.Extract a) =>
Int
-> (a -> a)
-> GroupReplacer a
defaultReplacer idx0 tweak0 (ma0::MatchArray) acc0 =
if idx0 >= P.length ma0 then acc0
else fn1 val1
where poslen1 = ma0 ! idx0 :: (R.MatchOffset, R.MatchLength)
val1 = extract poslen1 acc0
fn1 str1 = replaceMatch poslen1 (str2,acc0)
where str2 = tweak0 str1
ronceGroup::Match_cl Regex a =>
(Needle Regex, GroupReplacer a) -> Haystack a -> a
ronceGroup (pat1, repl1) body1@(Haystack bs_str1) =
let m1 = match pat1 body1
in case m1 of
Nothing -> bs_str1
Just marr1 -> repl1 marr1 bs_str1
rallGroup::Match_cl Regex a =>
(Needle Regex, GroupReplacer a) -> Haystack a -> a
rallGroup (pat1, repl1) body1@(Haystack bs_str1) =
let marrList1 = matchAll pat1 body1
in P.foldr repl1 bs_str1 marrList1
addOpt::Match_opt a =>
Needle a -> [O.Comp] -> Needle Regex
addOpt pat1 opt1 = Needle rx1
where rx1 = makeRegexOpts opt1 [] pat1
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