{- | extensible and reusable replacement functions

Run replacement with your preferred content types e.g. "Data.Text" (implemented),

from search results with non-PCRE regex or non-regex libs

=== how to use:    

value replacement:

>>> replace (Just [(4,3)::PosLen]) "4567" ("abc 123 def"::Text)

"abc 4567 def"


'GroupReplacer' : replace with a function

@
replacer::GroupReplacer Text
replacer = defaultReplacer 1 tweak1        --  1: group 1 match. 
          where tweak1 str1 = case str1 of
                                "123" -> "[1-2-3]"
                                otherwise -> traceShow str1 "?"
@

>>> replace (Just ([(4,3)]::[PosLen])) replacer ("abc 123 def"::Text)

    "abc [1-2-3] def"     -}    

module Text.Regex.Do.Replace.Open
    (Replace(..),
    defaultReplacer,
    getGroup,
    replaceMatch,
    boundsOk)
    where

import Text.Regex.Base.RegexLike as R
import Data.Array as A
import Prelude as P
import Text.Regex.Do.Type.Do
import Text.Regex.Do.Match.Result as R
import Text.Regex.Do.Type.Convert
import Text.Regex.Do.Type.Extract


class Replace f repl body where
   replace::(Extract' body, ToArray arr) =>
        f arr -> repl -> body -> body


instance Replace Maybe b b where
   replace :: Maybe arr -> b -> b -> b
replace Nothing repl0 :: b
repl0 body0 :: b
body0 = b
body0
   replace (Just ma0 :: arr
ma0) repl0 :: b
repl0 body0 :: b
body0 = [PosLen] -> (b, b) -> b
forall a. Extract' a => [PosLen] -> (a, a) -> a
firstGroup [PosLen]
lpl1 (b
repl0, b
body0)
        where lpl1 :: [PosLen]
lpl1 = Array Int PosLen -> [PosLen]
forall i e. Array i e -> [e]
A.elems (Array Int PosLen -> [PosLen]) -> Array Int PosLen -> [PosLen]
forall a b. (a -> b) -> a -> b
$ arr -> Array Int PosLen
forall a. ToArray a => a -> Array Int PosLen
toArray arr
ma0


instance Replace [] b b where
   replace :: [arr] -> b -> b -> b
replace [] _ body0 :: b
body0 = b
body0
   replace ma0 :: [arr]
ma0 repl0 :: b
repl0 body0 :: b
body0 =
      let lpl1 :: [[PosLen]]
lpl1 = [Array Int PosLen] -> [[PosLen]]
forall (f :: * -> *).
Functor f =>
f (Array Int PosLen) -> f [PosLen]
R.poslen ([Array Int PosLen] -> [[PosLen]])
-> [Array Int PosLen] -> [[PosLen]]
forall a b. (a -> b) -> a -> b
$ arr -> Array Int PosLen
forall a. ToArray a => a -> Array Int PosLen
toArray (arr -> Array Int PosLen) -> [arr] -> [Array Int PosLen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [arr]
ma0::[[PosLen]]
          foldFn1 :: [PosLen] -> b -> b
foldFn1 lpl1 :: [PosLen]
lpl1 acc1 :: b
acc1 = [PosLen] -> (b, b) -> b
forall a. Extract' a => [PosLen] -> (a, a) -> a
firstGroup [PosLen]
lpl1 (b
repl0,b
acc1)
      in ([PosLen] -> b -> b) -> b -> [[PosLen]] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
P.foldr [PosLen] -> b -> b
foldFn1 b
body0 [[PosLen]]
lpl1


instance Replace Maybe (GroupReplacer b) b where
   replace :: Maybe arr -> GroupReplacer b -> b -> b
replace Nothing _ body0 :: b
body0 = b
body0
   replace (Just ma0 :: arr
ma0) (GroupReplacer repl0 :: Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b
repl0) body0 :: b
body0 =
            let a1 :: ReplaceAcc b
a1 = ReplaceAcc :: forall b. b -> Int -> ReplaceAcc b
ReplaceAcc {
                                  acc :: b
acc = b
body0,
                                  pos_adj :: Int
pos_adj = 0
                                }
            in ReplaceAcc b -> b
forall b. ReplaceAcc b -> b
acc (ReplaceAcc b -> b) -> ReplaceAcc b -> b
forall a b. (a -> b) -> a -> b
$ Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b
repl0 (arr -> Array Int PosLen
forall a. ToArray a => a -> Array Int PosLen
toArray arr
ma0) ReplaceAcc b
a1


instance Replace [] (GroupReplacer b) b where
   replace :: [arr] -> GroupReplacer b -> b -> b
replace [] _ body0 :: b
body0 = b
body0
   replace ma0 :: [arr]
ma0 (GroupReplacer repl0 :: Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b
repl0) body0 :: b
body0 =
        let acc1 :: ReplaceAcc b
acc1 = ReplaceAcc :: forall b. b -> Int -> ReplaceAcc b
ReplaceAcc { acc :: b
acc = b
body0, pos_adj :: Int
pos_adj = 0 }
        in ReplaceAcc b -> b
forall b. ReplaceAcc b -> b
acc (ReplaceAcc b -> b) -> ReplaceAcc b -> b
forall a b. (a -> b) -> a -> b
$ (ReplaceAcc b -> Array Int PosLen -> ReplaceAcc b)
-> ReplaceAcc b -> [Array Int PosLen] -> ReplaceAcc b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
P.foldl ((Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b)
-> ReplaceAcc b -> Array Int PosLen -> ReplaceAcc b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b
repl0) ReplaceAcc b
acc1 ([Array Int PosLen] -> ReplaceAcc b)
-> [Array Int PosLen] -> ReplaceAcc b
forall a b. (a -> b) -> a -> b
$ arr -> Array Int PosLen
forall a. ToArray a => a -> Array Int PosLen
toArray (arr -> Array Int PosLen) -> [arr] -> [Array Int PosLen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [arr]
ma0


firstGroup::Extract' a =>
    [PosLen] -> (a,a) -> a
firstGroup :: [PosLen] -> (a, a) -> a
firstGroup (pl0 :: PosLen
pl0:_) r1 :: (a, a)
r1@(new0 :: a
new0,a0 :: a
a0) = ReplaceAcc a -> a
forall b. ReplaceAcc b -> b
acc (ReplaceAcc a -> a) -> ReplaceAcc a -> a
forall a b. (a -> b) -> a -> b
$ PosLen -> (a, ReplaceAcc a) -> ReplaceAcc a
forall a. Extract' a => PosLen -> (a, ReplaceAcc a) -> ReplaceAcc a
replaceMatch PosLen
pl0 (a
new0, ReplaceAcc a
acc1)
    where acc1 :: ReplaceAcc a
acc1 = ReplaceAcc :: forall b. b -> Int -> ReplaceAcc b
ReplaceAcc {
                    acc :: a
acc = a
a0,
                    pos_adj :: Int
pos_adj = 0
                    }


--  dynamic
{- | Replaces specified (by idx) group match with value provided by (a -> a) fn.
    Works for one common simple use case

    'GroupReplacer' can also be used with multi-group regex

    another custom dynamic replacer could e.g.
    inspect all group matches before looking up a replacement.     -}
defaultReplacer::Extract' a =>
        Int         -- ^ group idx. 0: full match, groups: 1.. see 'MatchArray'
        -> (a -> a) -- ^ (group match -> replacement) lookup
            -> GroupReplacer a
defaultReplacer :: Int -> (a -> a) -> GroupReplacer a
defaultReplacer idx0 :: Int
idx0 tweak0 :: a -> a
tweak0 = (Array Int PosLen -> ReplaceAcc a -> ReplaceAcc a)
-> GroupReplacer a
forall b.
(Array Int PosLen -> ReplaceAcc b -> ReplaceAcc b)
-> GroupReplacer b
GroupReplacer Array Int PosLen -> ReplaceAcc a -> ReplaceAcc a
fn1
    where fn1 :: Array Int PosLen -> ReplaceAcc a -> ReplaceAcc a
fn1 (Array Int PosLen
ma0::MatchArray) acc0 :: ReplaceAcc a
acc0 =
            if Array Int PosLen -> Int -> Bool
boundsOk Array Int PosLen
ma0 Int
idx0 then ReplaceAcc a -> (a -> ReplaceAcc a) -> Maybe a -> ReplaceAcc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReplaceAcc a
acc0 a -> ReplaceAcc a
fn1 Maybe a
mval1
            else ReplaceAcc a
acc0
            where pl1 :: PosLen
pl1 = Array Int PosLen
ma0 Array Int PosLen -> Int -> PosLen
forall i e. Ix i => Array i e -> i -> e
A.! Int
idx0 :: (R.MatchOffset, R.MatchLength)
                  mval1 :: Maybe a
mval1 = ReplaceAcc a -> Array Int PosLen -> Int -> Maybe a
forall a.
Extract a =>
ReplaceAcc a -> Array Int PosLen -> Int -> Maybe a
getGroup ReplaceAcc a
acc0 Array Int PosLen
ma0 Int
idx0 
                  fn1 :: a -> ReplaceAcc a
fn1 str1 :: a
str1 = PosLen -> (a, ReplaceAcc a) -> ReplaceAcc a
forall a. Extract' a => PosLen -> (a, ReplaceAcc a) -> ReplaceAcc a
replaceMatch PosLen
pl1 (a
str2, ReplaceAcc a
acc0) 
                             where str2 :: a
str2 = a -> a
tweak0 a
str1


{- | check if specified group index is within 'MatchArray' bounds

for use within 'GroupReplacer'
-}
boundsOk::MatchArray -> Int -> Bool
boundsOk :: Array Int PosLen -> Int -> Bool
boundsOk ma0 :: Array Int PosLen
ma0 = PosLen -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Int PosLen -> PosLen
forall i e. Array i e -> (i, i)
bounds Array Int PosLen
ma0)                         


{- | get group content safely:

    * non-existing group idx will not error but return 'Nothing'
    * adjust for previous replacements length

    see 'defaultReplacer' source for use example
    -}
getGroup::R.Extract a =>
    ReplaceAcc a -> MatchArray -> Int -> Maybe a
getGroup :: ReplaceAcc a -> Array Int PosLen -> Int -> Maybe a
getGroup acc0 :: ReplaceAcc a
acc0 ma0 :: Array Int PosLen
ma0 idx0 :: Int
idx0 = if Bool -> Bool
not (Array Int PosLen -> Int -> Bool
boundsOk Array Int PosLen
ma0 Int
idx0) then Maybe a
forall a. Maybe a
Nothing     --  safety catch
    else a -> Maybe a
forall a. a -> Maybe a
Just a
val1
    where pl1 :: PosLen
pl1 = Array Int PosLen
ma0 Array Int PosLen -> Int -> PosLen
forall i e. Ix i => Array i e -> i -> e
A.! Int
idx0 :: (R.MatchOffset, R.MatchLength)
          pl2 :: PosLen
pl2 = PosLen -> ReplaceAcc a -> PosLen
forall a. PosLen -> ReplaceAcc a -> PosLen
adjustPoslen PosLen
pl1 ReplaceAcc a
acc0
          val1 :: a
val1 = PosLen -> a -> a
forall source. Extract source => PosLen -> source -> source
extract PosLen
pl2 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ ReplaceAcc a -> a
forall b. ReplaceAcc b -> b
acc ReplaceAcc a
acc0


{- | replace group match while adjusting for previous replacements length

    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 :: PosLen -> (a, ReplaceAcc a) -> ReplaceAcc a
replaceMatch pl0 :: PosLen
pl0@(_,l0 :: Int
l0) (new0 :: a
new0, acc0 :: ReplaceAcc a
acc0) = ReplaceAcc :: forall b. b -> Int -> ReplaceAcc b
ReplaceAcc {
                    acc :: a
acc = a
acc1,
                    pos_adj :: Int
pos_adj = ReplaceAcc a -> Int
forall b. ReplaceAcc b -> Int
pos_adj ReplaceAcc a
acc0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l0
                    }
     where  pl1 :: PosLen
pl1 = PosLen -> ReplaceAcc a -> PosLen
forall a. PosLen -> ReplaceAcc a -> PosLen
adjustPoslen PosLen
pl0 ReplaceAcc a
acc0
            prefix1 :: a
prefix1 = PosLen -> a -> a
forall source. Extract source => PosLen -> source -> source
prefix PosLen
pl1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ ReplaceAcc a -> a
forall b. ReplaceAcc b -> b
acc ReplaceAcc a
acc0
            suffix1 :: a
suffix1 = PosLen -> a -> a
forall source. Extract source => PosLen -> source -> source
suffix PosLen
pl1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ ReplaceAcc a -> a
forall b. ReplaceAcc b -> b
acc ReplaceAcc a
acc0
            acc1 :: a
acc1 = [a] -> a
forall a. Extract' a => [a] -> a
concat' [a
prefix1, a
new0, a
suffix1]
            l1 :: Int
l1 = a -> Int
forall a. Extract' a => a -> Int
len' a
new0


adjustPoslen::PosLen -> ReplaceAcc a -> PosLen
adjustPoslen :: PosLen -> ReplaceAcc a -> PosLen
adjustPoslen (p0 :: Int
p0,l0 :: Int
l0) acc0 :: ReplaceAcc a
acc0  = (Int
p0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ReplaceAcc a -> Int
forall b. ReplaceAcc b -> Int
pos_adj ReplaceAcc a
acc0, Int
l0)