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
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
defaultReplacer::Extract' a =>
Int
-> (a -> a)
-> 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
getGroup::R.Extract a =>
ReplaceAcc a -> MatchArray -> Int -> Maybe a
getGroup acc0 ma0 idx0 = if idx0 >= P.length ma0 then Nothing
else Just val1
where pl1 = ma0 A.! idx0 :: (R.MatchOffset, R.MatchLength)
pl2 = adjustPoslen pl1 acc0
val1 = extract pl2 $ acc acc0
replaceMatch::Extract' a =>
PosLen
-> (a, ReplaceAcc a)
-> ReplaceAcc a
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)