module Text.Regex.Do.Match.Result where

import qualified Data.Array as A(elems)
import Text.Regex.Base.RegexLike as R
import Text.Regex.Do.Type.Do
import Text.Regex.Do.Type.Internal


-- | match offset, length
poslen::Functor f =>
    f MatchArray -> f [PosLen]
poslen :: f MatchArray -> f [PosLen]
poslen = (MatchArray -> [PosLen]
forall i e. Array i e -> [e]
A.elems (MatchArray -> [PosLen]) -> f MatchArray -> f [PosLen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)


-- | all groups
allMatches::(Functor f, R.Extract b) =>
    Body b -> f MatchArray -> f [b]
allMatches :: Body b -> f MatchArray -> f [b]
allMatches hay0 :: Body b
hay0 results0 :: f MatchArray
results0 = Body b -> MatchArray -> [b]
forall b. Extract b => Body b -> MatchArray -> [b]
groupMatch Body b
hay0 (MatchArray -> [b]) -> f MatchArray -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f MatchArray
results0


-- | matches for one group
groupMatch::R.Extract b =>
    Body b -> MatchArray -> [b]
groupMatch :: Body b -> MatchArray -> [b]
groupMatch (Body b0 :: b
b0) a0 :: MatchArray
a0 = [PosLen -> b -> b
forall source. Extract source => PosLen -> source -> source
R.extract PosLen
tuple1 b
b0 |  PosLen
tuple1 <- MatchArray -> [PosLen]
forall i e. Array i e -> [e]
A.elems MatchArray
a0]