{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 702
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
#endif
module Text.Regex.Base.Context() where
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))
import Control.Monad(liftM)
import Data.Array(Array,(!),elems,listArray)
import Text.Regex.Base.RegexLike(RegexLike(..),RegexContext(..)
,AllSubmatches(..),AllTextSubmatches(..),AllMatches(..),AllTextMatches(..)
,MatchResult(..),Extract(empty),MatchOffset,MatchLength,MatchArray,MatchText)
nullArray :: Array Int a
{-# INLINE nullArray #-}
nullArray :: forall a. Array Int a
nullArray = (Int, Int) -> [a] -> Array Int a
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
0) []
nullFail :: (RegexContext regex source (AllMatches [] target),MonadFail m) => regex -> source -> m (AllMatches [] target)
{-# INLINE nullFail #-}
nullFail :: forall regex source target (m :: * -> *).
(RegexContext regex source (AllMatches [] target), MonadFail m) =>
regex -> source -> m (AllMatches [] target)
nullFail regex
r source
s = case regex -> source -> AllMatches [] target
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
(AllMatches []) -> m (AllMatches [] target)
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
AllMatches [] target
xs -> AllMatches [] target -> m (AllMatches [] target)
forall (m :: * -> *) a. Monad m => a -> m a
return AllMatches [] target
xs
nullFailText :: (RegexContext regex source (AllTextMatches [] target),MonadFail m) => regex -> source -> m (AllTextMatches [] target)
{-# INLINE nullFailText #-}
nullFailText :: forall regex source target (m :: * -> *).
(RegexContext regex source (AllTextMatches [] target),
MonadFail m) =>
regex -> source -> m (AllTextMatches [] target)
nullFailText regex
r source
s = case regex -> source -> AllTextMatches [] target
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
(AllTextMatches []) -> m (AllTextMatches [] target)
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
AllTextMatches [] target
xs -> AllTextMatches [] target -> m (AllTextMatches [] target)
forall (m :: * -> *) a. Monad m => a -> m a
return AllTextMatches [] target
xs
nullFail' :: (RegexContext regex source ([] target),MonadFail m) => regex -> source -> m ([] target)
{-# INLINE nullFail' #-}
nullFail' :: forall regex source target (m :: * -> *).
(RegexContext regex source [target], MonadFail m) =>
regex -> source -> m [target]
nullFail' regex
r source
s = case regex -> source -> [target]
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
([]) -> m [target]
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
[target]
xs -> [target] -> m [target]
forall (m :: * -> *) a. Monad m => a -> m a
return [target]
xs
regexFailed :: (MonadFail m) => m b
{-# INLINE regexFailed #-}
regexFailed :: forall (m :: * -> *) b. MonadFail m => m b
regexFailed = String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ String
"regex failed to match"
actOn :: (RegexLike r s,MonadFail m) => ((s,MatchText s,s)->t) -> r -> s -> m t
{-# INLINE actOn #-}
actOn :: forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (s, MatchText s, s) -> t
f r
r s
s = case r -> s -> Maybe (s, MatchText s, s)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText r
r s
s of
Maybe (s, MatchText s, s)
Nothing -> m t
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Just (s, MatchText s, s)
preMApost -> t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return ((s, MatchText s, s) -> t
f (s, MatchText s, s)
preMApost)
instance (RegexLike a b) => RegexContext a b Bool where
match :: a -> b -> Bool
match = a -> b -> Bool
forall a b. RegexLike a b => a -> b -> Bool
matchTest
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m Bool
matchM a
r b
s = case a -> b -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
Bool
False -> m Bool
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Bool
True -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance (RegexLike a b) => RegexContext a b () where
match :: a -> b -> ()
match a
_ b
_ = ()
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m ()
matchM a
r b
s = case a -> b -> Bool
forall a b. RegexLike a b => a -> b -> Bool
matchTest a
r b
s of
Bool
False -> m ()
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance (RegexLike a b) => RegexContext a b Int where
match :: a -> b -> Int
match = a -> b -> Int
forall a b. RegexLike a b => a -> b -> Int
matchCount
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m Int
matchM a
r b
s = case a -> b -> Int
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
Int
0 -> m Int
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Int
x -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
instance (RegexLike a b) => RegexContext a b (MatchOffset,MatchLength) where
match :: a -> b -> (Int, Int)
match a
r b
s = (Int, Int)
-> (Array Int (Int, Int) -> (Int, Int))
-> Maybe (Array Int (Int, Int))
-> (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1,Int
0) (Array Int (Int, Int) -> Int -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! Int
0) (a -> b -> Maybe (Array Int (Int, Int))
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (Array Int (Int, Int))
matchOnce a
r b
s)
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m (Int, Int)
matchM a
r b
s = m (Int, Int)
-> (Array Int (Int, Int) -> m (Int, Int))
-> Maybe (Array Int (Int, Int))
-> m (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Int, Int)
forall (m :: * -> *) b. MonadFail m => m b
regexFailed ((Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> m (Int, Int))
-> (Array Int (Int, Int) -> (Int, Int))
-> Array Int (Int, Int)
-> m (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Int (Int, Int) -> Int -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! Int
0)) (a -> b -> Maybe (Array Int (Int, Int))
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (Array Int (Int, Int))
matchOnce a
r b
s)
instance (RegexLike a b) => RegexContext a b (MatchResult b) where
match :: a -> b -> MatchResult b
match a
r b
s = MatchResult b
-> (MatchResult b -> MatchResult b)
-> Maybe (MatchResult b)
-> MatchResult b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MR {mrBefore :: b
mrBefore = b
s,mrMatch :: b
mrMatch = b
forall source. Extract source => source
empty,mrAfter :: b
mrAfter = b
forall source. Extract source => source
empty
,mrSubs :: Array Int b
mrSubs = Array Int b
forall a. Array Int a
nullArray,mrSubList :: [b]
mrSubList = []}) MatchResult b -> MatchResult b
forall a. a -> a
id (a -> b -> Maybe (MatchResult b)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m (MatchResult b)
matchM = ((b, MatchText b, b) -> MatchResult b)
-> a -> b -> m (MatchResult b)
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
pre,MatchText b
ma,b
post) ->
let ((b
whole,(Int, Int)
_):[(b, (Int, Int))]
subs) = MatchText b -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems MatchText b
ma
in MR { mrBefore :: b
mrBefore = b
pre
, mrMatch :: b
mrMatch = b
whole
, mrAfter :: b
mrAfter = b
post
, mrSubs :: Array Int b
mrSubs = ((b, (Int, Int)) -> b) -> MatchText b -> Array Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst MatchText b
ma
, mrSubList :: [b]
mrSubList = ((b, (Int, Int)) -> b) -> [(b, (Int, Int))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst [(b, (Int, Int))]
subs })
instance (RegexLike a b) => RegexContext a b (b,MatchText b,b) where
match :: a -> b -> (b, MatchText b, b)
match a
r b
s = (b, MatchText b, b)
-> ((b, MatchText b, b) -> (b, MatchText b, b))
-> Maybe (b, MatchText b, b)
-> (b, MatchText b, b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,MatchText b
forall a. Array Int a
nullArray,b
forall source. Extract source => source
empty) (b, MatchText b, b) -> (b, MatchText b, b)
forall a. a -> a
id (a -> b -> Maybe (b, MatchText b, b)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (b, MatchText b, b)
matchM a
r b
s = m (b, MatchText b, b)
-> ((b, MatchText b, b) -> m (b, MatchText b, b))
-> Maybe (b, MatchText b, b)
-> m (b, MatchText b, b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (b, MatchText b, b)
forall (m :: * -> *) b. MonadFail m => m b
regexFailed (b, MatchText b, b) -> m (b, MatchText b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> Maybe (b, MatchText b, b)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText a
r b
s)
instance (RegexLike a b) => RegexContext a b (b,b,b) where
match :: a -> b -> (b, b, b)
match a
r b
s = (b, b, b)
-> ((b, b, b) -> (b, b, b)) -> Maybe (b, b, b) -> (b, b, b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,b
forall source. Extract source => source
empty,b
forall source. Extract source => source
empty) (b, b, b) -> (b, b, b)
forall a. a -> a
id (a -> b -> Maybe (b, b, b)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m (b, b, b)
matchM = ((b, MatchText b, b) -> (b, b, b)) -> a -> b -> m (b, b, b)
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
pre,MatchText b
ma,b
post) -> let ((b
whole,(Int, Int)
_):[(b, (Int, Int))]
_) = MatchText b -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems MatchText b
ma
in (b
pre,b
whole,b
post))
instance (RegexLike a b) => RegexContext a b (b,b,b,[b]) where
match :: a -> b -> (b, b, b, [b])
match a
r b
s = (b, b, b, [b])
-> ((b, b, b, [b]) -> (b, b, b, [b]))
-> Maybe (b, b, b, [b])
-> (b, b, b, [b])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,b
forall source. Extract source => source
empty,b
forall source. Extract source => source
empty,[]) (b, b, b, [b]) -> (b, b, b, [b])
forall a. a -> a
id (a -> b -> Maybe (b, b, b, [b])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m (b, b, b, [b])
matchM = ((b, MatchText b, b) -> (b, b, b, [b]))
-> a -> b -> m (b, b, b, [b])
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
pre,MatchText b
ma,b
post) -> let ((b
whole,(Int, Int)
_):[(b, (Int, Int))]
subs) = MatchText b -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems MatchText b
ma
in (b
pre,b
whole,b
post,((b, (Int, Int)) -> b) -> [(b, (Int, Int))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst [(b, (Int, Int))]
subs))
instance (RegexLike a b) => RegexContext a b MatchArray where
match :: a -> b -> Array Int (Int, Int)
match a
r b
s = Array Int (Int, Int)
-> (Array Int (Int, Int) -> Array Int (Int, Int))
-> Maybe (Array Int (Int, Int))
-> Array Int (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Array Int (Int, Int)
forall a. Array Int a
nullArray Array Int (Int, Int) -> Array Int (Int, Int)
forall a. a -> a
id (a -> b -> Maybe (Array Int (Int, Int))
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (Array Int (Int, Int))
matchOnce a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (Array Int (Int, Int))
matchM a
r b
s = m (Array Int (Int, Int))
-> (Array Int (Int, Int) -> m (Array Int (Int, Int)))
-> Maybe (Array Int (Int, Int))
-> m (Array Int (Int, Int))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Array Int (Int, Int))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed Array Int (Int, Int) -> m (Array Int (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> Maybe (Array Int (Int, Int))
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (Array Int (Int, Int))
matchOnce a
r b
s)
instance (RegexLike a b) => RegexContext a b (AllSubmatches [] (MatchOffset,MatchLength)) where
match :: a -> b -> AllSubmatches [] (Int, Int)
match a
r b
s = AllSubmatches [] (Int, Int)
-> (AllSubmatches [] (Int, Int) -> AllSubmatches [] (Int, Int))
-> Maybe (AllSubmatches [] (Int, Int))
-> AllSubmatches [] (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(Int, Int)] -> AllSubmatches [] (Int, Int)
forall (f :: * -> *) b. f b -> AllSubmatches f b
AllSubmatches []) AllSubmatches [] (Int, Int) -> AllSubmatches [] (Int, Int)
forall a. a -> a
id (a -> b -> Maybe (AllSubmatches [] (Int, Int))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllSubmatches [] (Int, Int))
matchM a
r b
s = case a -> b -> Maybe (Array Int (Int, Int))
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (Array Int (Int, Int))
matchOnce a
r b
s of
Maybe (Array Int (Int, Int))
Nothing -> m (AllSubmatches [] (Int, Int))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Just Array Int (Int, Int)
ma -> AllSubmatches [] (Int, Int) -> m (AllSubmatches [] (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> AllSubmatches [] (Int, Int)
forall (f :: * -> *) b. f b -> AllSubmatches f b
AllSubmatches (Array Int (Int, Int) -> [(Int, Int)]
forall i e. Array i e -> [e]
elems Array Int (Int, Int)
ma))
instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) (b, (MatchOffset, MatchLength))) where
match :: a -> b -> AllTextSubmatches (Array Int) (b, (Int, Int))
match a
r b
s = AllTextSubmatches (Array Int) (b, (Int, Int))
-> (AllTextSubmatches (Array Int) (b, (Int, Int))
-> AllTextSubmatches (Array Int) (b, (Int, Int)))
-> Maybe (AllTextSubmatches (Array Int) (b, (Int, Int)))
-> AllTextSubmatches (Array Int) (b, (Int, Int))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int (b, (Int, Int))
-> AllTextSubmatches (Array Int) (b, (Int, Int))
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches Array Int (b, (Int, Int))
forall a. Array Int a
nullArray) AllTextSubmatches (Array Int) (b, (Int, Int))
-> AllTextSubmatches (Array Int) (b, (Int, Int))
forall a. a -> a
id (a -> b -> Maybe (AllTextSubmatches (Array Int) (b, (Int, Int)))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextSubmatches (Array Int) (b, (Int, Int)))
matchM a
r b
s = ((b, Array Int (b, (Int, Int)), b)
-> AllTextSubmatches (Array Int) (b, (Int, Int)))
-> a -> b -> m (AllTextSubmatches (Array Int) (b, (Int, Int)))
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
_,Array Int (b, (Int, Int))
ma,b
_) -> Array Int (b, (Int, Int))
-> AllTextSubmatches (Array Int) (b, (Int, Int))
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches Array Int (b, (Int, Int))
ma) a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] (b, (MatchOffset, MatchLength))) where
match :: a -> b -> AllTextSubmatches [] (b, (Int, Int))
match a
r b
s = AllTextSubmatches [] (b, (Int, Int))
-> (AllTextSubmatches [] (b, (Int, Int))
-> AllTextSubmatches [] (b, (Int, Int)))
-> Maybe (AllTextSubmatches [] (b, (Int, Int)))
-> AllTextSubmatches [] (b, (Int, Int))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(b, (Int, Int))] -> AllTextSubmatches [] (b, (Int, Int))
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches []) AllTextSubmatches [] (b, (Int, Int))
-> AllTextSubmatches [] (b, (Int, Int))
forall a. a -> a
id (a -> b -> Maybe (AllTextSubmatches [] (b, (Int, Int)))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextSubmatches [] (b, (Int, Int)))
matchM a
r b
s = ((b, MatchText b, b) -> AllTextSubmatches [] (b, (Int, Int)))
-> a -> b -> m (AllTextSubmatches [] (b, (Int, Int)))
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
_,MatchText b
ma,b
_) -> [(b, (Int, Int))] -> AllTextSubmatches [] (b, (Int, Int))
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches (MatchText b -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems MatchText b
ma)) a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] b) where
match :: a -> b -> AllTextSubmatches [] b
match a
r b
s = AllTextSubmatches [] b
-> (AllTextSubmatches [] b -> AllTextSubmatches [] b)
-> Maybe (AllTextSubmatches [] b)
-> AllTextSubmatches [] b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([b] -> AllTextSubmatches [] b
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches []) AllTextSubmatches [] b -> AllTextSubmatches [] b
forall a. a -> a
id (a -> b -> Maybe (AllTextSubmatches [] b)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextSubmatches [] b)
matchM a
r b
s = ([b] -> AllTextSubmatches [] b)
-> m [b] -> m (AllTextSubmatches [] b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [b] -> AllTextSubmatches [] b
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches (m [b] -> m (AllTextSubmatches [] b))
-> m [b] -> m (AllTextSubmatches [] b)
forall a b. (a -> b) -> a -> b
$ ((b, MatchText b, b) -> [b]) -> a -> b -> m [b]
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
_,MatchText b
ma,b
_) -> ((b, (Int, Int)) -> b) -> [(b, (Int, Int))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst ([(b, (Int, Int))] -> [b])
-> (MatchText b -> [(b, (Int, Int))]) -> MatchText b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchText b -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems (MatchText b -> [b]) -> MatchText b -> [b]
forall a b. (a -> b) -> a -> b
$ MatchText b
ma) a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) b) where
match :: a -> b -> AllTextSubmatches (Array Int) b
match a
r b
s = AllTextSubmatches (Array Int) b
-> (AllTextSubmatches (Array Int) b
-> AllTextSubmatches (Array Int) b)
-> Maybe (AllTextSubmatches (Array Int) b)
-> AllTextSubmatches (Array Int) b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int b -> AllTextSubmatches (Array Int) b
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches Array Int b
forall a. Array Int a
nullArray) AllTextSubmatches (Array Int) b -> AllTextSubmatches (Array Int) b
forall a. a -> a
id (a -> b -> Maybe (AllTextSubmatches (Array Int) b)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextSubmatches (Array Int) b)
matchM a
r b
s = (Array Int b -> AllTextSubmatches (Array Int) b)
-> m (Array Int b) -> m (AllTextSubmatches (Array Int) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Array Int b -> AllTextSubmatches (Array Int) b
forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches (m (Array Int b) -> m (AllTextSubmatches (Array Int) b))
-> m (Array Int b) -> m (AllTextSubmatches (Array Int) b)
forall a b. (a -> b) -> a -> b
$ ((b, MatchText b, b) -> Array Int b) -> a -> b -> m (Array Int b)
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\(b
_,MatchText b
ma,b
_) -> ((b, (Int, Int)) -> b) -> MatchText b -> Array Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst MatchText b
ma) a
r b
s
instance (RegexLike a b) => RegexContext a b (AllMatches [] (MatchOffset,MatchLength)) where
match :: a -> b -> AllMatches [] (Int, Int)
match a
r b
s = [(Int, Int)] -> AllMatches [] (Int, Int)
forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches [ Array Int (Int, Int)
ma Array Int (Int, Int) -> Int -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! Int
0 | Array Int (Int, Int)
ma <- a -> b -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll a
r b
s ]
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllMatches [] (Int, Int))
matchM a
r b
s = a -> b -> m (AllMatches [] (Int, Int))
forall regex source target (m :: * -> *).
(RegexContext regex source (AllMatches [] target), MonadFail m) =>
regex -> source -> m (AllMatches [] target)
nullFail a
r b
s
instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) (MatchOffset,MatchLength)) where
match :: a -> b -> AllMatches (Array Int) (Int, Int)
match a
r b
s = AllMatches (Array Int) (Int, Int)
-> (AllMatches (Array Int) (Int, Int)
-> AllMatches (Array Int) (Int, Int))
-> Maybe (AllMatches (Array Int) (Int, Int))
-> AllMatches (Array Int) (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int (Int, Int) -> AllMatches (Array Int) (Int, Int)
forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches Array Int (Int, Int)
forall a. Array Int a
nullArray) AllMatches (Array Int) (Int, Int)
-> AllMatches (Array Int) (Int, Int)
forall a. a -> a
id (a -> b -> Maybe (AllMatches (Array Int) (Int, Int))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllMatches (Array Int) (Int, Int))
matchM a
r b
s = case a -> b -> AllMatches [] (Int, Int)
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllMatches []) -> m (AllMatches (Array Int) (Int, Int))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllMatches [(Int, Int)]
pairs) -> AllMatches (Array Int) (Int, Int)
-> m (AllMatches (Array Int) (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (AllMatches (Array Int) (Int, Int)
-> m (AllMatches (Array Int) (Int, Int)))
-> ([(Int, Int)] -> AllMatches (Array Int) (Int, Int))
-> [(Int, Int)]
-> m (AllMatches (Array Int) (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Int, Int) -> AllMatches (Array Int) (Int, Int)
forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches (Array Int (Int, Int) -> AllMatches (Array Int) (Int, Int))
-> ([(Int, Int)] -> Array Int (Int, Int))
-> [(Int, Int)]
-> AllMatches (Array Int) (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [(Int, Int)] -> Array Int (Int, Int)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
pairs) ([(Int, Int)] -> m (AllMatches (Array Int) (Int, Int)))
-> [(Int, Int)] -> m (AllMatches (Array Int) (Int, Int))
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs
instance (RegexLike a b) => RegexContext a b [MatchArray] where
match :: a -> b -> [Array Int (Int, Int)]
match = a -> b -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m [Array Int (Int, Int)]
matchM = a -> b -> m [Array Int (Int, Int)]
forall regex source target (m :: * -> *).
(RegexContext regex source [target], MonadFail m) =>
regex -> source -> m [target]
nullFail'
instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) MatchArray) where
match :: a -> b -> AllMatches (Array Int) (Array Int (Int, Int))
match a
r b
s = AllMatches (Array Int) (Array Int (Int, Int))
-> (AllMatches (Array Int) (Array Int (Int, Int))
-> AllMatches (Array Int) (Array Int (Int, Int)))
-> Maybe (AllMatches (Array Int) (Array Int (Int, Int)))
-> AllMatches (Array Int) (Array Int (Int, Int))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int (Array Int (Int, Int))
-> AllMatches (Array Int) (Array Int (Int, Int))
forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches Array Int (Array Int (Int, Int))
forall a. Array Int a
nullArray) AllMatches (Array Int) (Array Int (Int, Int))
-> AllMatches (Array Int) (Array Int (Int, Int))
forall a. a -> a
id (a -> b -> Maybe (AllMatches (Array Int) (Array Int (Int, Int)))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllMatches (Array Int) (Array Int (Int, Int)))
matchM a
r b
s = case a -> b -> [Array Int (Int, Int)]
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
[] -> m (AllMatches (Array Int) (Array Int (Int, Int)))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
[Array Int (Int, Int)]
mas -> AllMatches (Array Int) (Array Int (Int, Int))
-> m (AllMatches (Array Int) (Array Int (Int, Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (AllMatches (Array Int) (Array Int (Int, Int))
-> m (AllMatches (Array Int) (Array Int (Int, Int))))
-> ([Array Int (Int, Int)]
-> AllMatches (Array Int) (Array Int (Int, Int)))
-> [Array Int (Int, Int)]
-> m (AllMatches (Array Int) (Array Int (Int, Int)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Array Int (Int, Int))
-> AllMatches (Array Int) (Array Int (Int, Int))
forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches (Array Int (Array Int (Int, Int))
-> AllMatches (Array Int) (Array Int (Int, Int)))
-> ([Array Int (Int, Int)] -> Array Int (Array Int (Int, Int)))
-> [Array Int (Int, Int)]
-> AllMatches (Array Int) (Array Int (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int)
-> [Array Int (Int, Int)] -> Array Int (Array Int (Int, Int))
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Array Int (Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Array Int (Int, Int)]
mas) ([Array Int (Int, Int)]
-> m (AllMatches (Array Int) (Array Int (Int, Int))))
-> [Array Int (Int, Int)]
-> m (AllMatches (Array Int) (Array Int (Int, Int)))
forall a b. (a -> b) -> a -> b
$ [Array Int (Int, Int)]
mas
instance (RegexLike a b) => RegexContext a b [MatchText b] where
match :: a -> b -> [MatchText b]
match = a -> b -> [MatchText b]
forall a b. RegexLike a b => a -> b -> [MatchText b]
matchAllText
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m [MatchText b]
matchM = a -> b -> m [MatchText b]
forall regex source target (m :: * -> *).
(RegexContext regex source [target], MonadFail m) =>
regex -> source -> m [target]
nullFail'
instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (MatchText b)) where
match :: a -> b -> AllTextMatches (Array Int) (MatchText b)
match a
r b
s = AllTextMatches (Array Int) (MatchText b)
-> (AllTextMatches (Array Int) (MatchText b)
-> AllTextMatches (Array Int) (MatchText b))
-> Maybe (AllTextMatches (Array Int) (MatchText b))
-> AllTextMatches (Array Int) (MatchText b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int (MatchText b) -> AllTextMatches (Array Int) (MatchText b)
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches Array Int (MatchText b)
forall a. Array Int a
nullArray) AllTextMatches (Array Int) (MatchText b)
-> AllTextMatches (Array Int) (MatchText b)
forall a. a -> a
id (a -> b -> Maybe (AllTextMatches (Array Int) (MatchText b))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches (Array Int) (MatchText b))
matchM a
r b
s = case a -> b -> [MatchText b]
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
([]) -> m (AllTextMatches (Array Int) (MatchText b))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
([MatchText b]
mts) -> AllTextMatches (Array Int) (MatchText b)
-> m (AllTextMatches (Array Int) (MatchText b))
forall (m :: * -> *) a. Monad m => a -> m a
return (AllTextMatches (Array Int) (MatchText b)
-> m (AllTextMatches (Array Int) (MatchText b)))
-> ([MatchText b] -> AllTextMatches (Array Int) (MatchText b))
-> [MatchText b]
-> m (AllTextMatches (Array Int) (MatchText b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (MatchText b) -> AllTextMatches (Array Int) (MatchText b)
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches (Array Int (MatchText b)
-> AllTextMatches (Array Int) (MatchText b))
-> ([MatchText b] -> Array Int (MatchText b))
-> [MatchText b]
-> AllTextMatches (Array Int) (MatchText b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [MatchText b] -> Array Int (MatchText b)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [MatchText b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MatchText b]
mts) ([MatchText b] -> m (AllTextMatches (Array Int) (MatchText b)))
-> [MatchText b] -> m (AllTextMatches (Array Int) (MatchText b))
forall a b. (a -> b) -> a -> b
$ [MatchText b]
mts
instance (RegexLike a b) => RegexContext a b (AllTextMatches [] b) where
match :: a -> b -> AllTextMatches [] b
match a
r b
s = [b] -> AllTextMatches [] b
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches [ (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst (MatchText b
ma MatchText b -> Int -> (b, (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
0) | MatchText b
ma <- a -> b -> [MatchText b]
forall a b. RegexLike a b => a -> b -> [MatchText b]
matchAllText a
r b
s ]
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches [] b)
matchM a
r b
s = a -> b -> m (AllTextMatches [] b)
forall regex source target (m :: * -> *).
(RegexContext regex source (AllTextMatches [] target),
MonadFail m) =>
regex -> source -> m (AllTextMatches [] target)
nullFailText a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) b) where
match :: a -> b -> AllTextMatches (Array Int) b
match a
r b
s = AllTextMatches (Array Int) b
-> (AllTextMatches (Array Int) b -> AllTextMatches (Array Int) b)
-> Maybe (AllTextMatches (Array Int) b)
-> AllTextMatches (Array Int) b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int b -> AllTextMatches (Array Int) b
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches Array Int b
forall a. Array Int a
nullArray) AllTextMatches (Array Int) b -> AllTextMatches (Array Int) b
forall a. a -> a
id (a -> b -> Maybe (AllTextMatches (Array Int) b)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches (Array Int) b)
matchM a
r b
s = case a -> b -> AllTextMatches [] b
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllTextMatches []) -> m (AllTextMatches (Array Int) b)
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllTextMatches [b]
bs) -> AllTextMatches (Array Int) b -> m (AllTextMatches (Array Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (AllTextMatches (Array Int) b -> m (AllTextMatches (Array Int) b))
-> ([b] -> AllTextMatches (Array Int) b)
-> [b]
-> m (AllTextMatches (Array Int) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int b -> AllTextMatches (Array Int) b
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches (Array Int b -> AllTextMatches (Array Int) b)
-> ([b] -> Array Int b) -> [b] -> AllTextMatches (Array Int) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [b] -> Array Int b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
bs) ([b] -> m (AllTextMatches (Array Int) b))
-> [b] -> m (AllTextMatches (Array Int) b)
forall a b. (a -> b) -> a -> b
$ [b]
bs
instance (RegexLike a b) => RegexContext a b [[b]] where
match :: a -> b -> [[b]]
match a
r b
s = [ ((b, (Int, Int)) -> b) -> [(b, (Int, Int))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst (Array Int (b, (Int, Int)) -> [(b, (Int, Int))]
forall i e. Array i e -> [e]
elems Array Int (b, (Int, Int))
ma) | Array Int (b, (Int, Int))
ma <- a -> b -> [Array Int (b, (Int, Int))]
forall a b. RegexLike a b => a -> b -> [MatchText b]
matchAllText a
r b
s ]
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m [[b]]
matchM a
r b
s = a -> b -> m [[b]]
forall regex source target (m :: * -> *).
(RegexContext regex source [target], MonadFail m) =>
regex -> source -> m [target]
nullFail' a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) [b]) where
match :: a -> b -> AllTextMatches (Array Int) [b]
match a
r b
s = AllTextMatches (Array Int) [b]
-> (AllTextMatches (Array Int) [b]
-> AllTextMatches (Array Int) [b])
-> Maybe (AllTextMatches (Array Int) [b])
-> AllTextMatches (Array Int) [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int [b] -> AllTextMatches (Array Int) [b]
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches Array Int [b]
forall a. Array Int a
nullArray) AllTextMatches (Array Int) [b] -> AllTextMatches (Array Int) [b]
forall a. a -> a
id (a -> b -> Maybe (AllTextMatches (Array Int) [b])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches (Array Int) [b])
matchM a
r b
s = case a -> b -> [[b]]
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
([]) -> m (AllTextMatches (Array Int) [b])
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
([[b]]
ls) -> AllTextMatches (Array Int) [b]
-> m (AllTextMatches (Array Int) [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (AllTextMatches (Array Int) [b]
-> m (AllTextMatches (Array Int) [b]))
-> ([[b]] -> AllTextMatches (Array Int) [b])
-> [[b]]
-> m (AllTextMatches (Array Int) [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int [b] -> AllTextMatches (Array Int) [b]
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches (Array Int [b] -> AllTextMatches (Array Int) [b])
-> ([[b]] -> Array Int [b])
-> [[b]]
-> AllTextMatches (Array Int) [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [[b]] -> Array Int [b]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [[b]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[b]]
ls) ([[b]] -> m (AllTextMatches (Array Int) [b]))
-> [[b]] -> m (AllTextMatches (Array Int) [b])
forall a b. (a -> b) -> a -> b
$ [[b]]
ls
instance (RegexLike a b) => RegexContext a b (AllTextMatches [] (Array Int b)) where
match :: a -> b -> AllTextMatches [] (Array Int b)
match a
r b
s = [Array Int b] -> AllTextMatches [] (Array Int b)
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches [ ((b, (Int, Int)) -> b) -> Array Int (b, (Int, Int)) -> Array Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, (Int, Int)) -> b
forall a b. (a, b) -> a
fst Array Int (b, (Int, Int))
ma | Array Int (b, (Int, Int))
ma <- a -> b -> [Array Int (b, (Int, Int))]
forall a b. RegexLike a b => a -> b -> [MatchText b]
matchAllText a
r b
s ]
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches [] (Array Int b))
matchM a
r b
s = a -> b -> m (AllTextMatches [] (Array Int b))
forall regex source target (m :: * -> *).
(RegexContext regex source (AllTextMatches [] target),
MonadFail m) =>
regex -> source -> m (AllTextMatches [] target)
nullFailText a
r b
s
instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (Array Int b)) where
match :: a -> b -> AllTextMatches (Array Int) (Array Int b)
match a
r b
s = AllTextMatches (Array Int) (Array Int b)
-> (AllTextMatches (Array Int) (Array Int b)
-> AllTextMatches (Array Int) (Array Int b))
-> Maybe (AllTextMatches (Array Int) (Array Int b))
-> AllTextMatches (Array Int) (Array Int b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Array Int (Array Int b) -> AllTextMatches (Array Int) (Array Int b)
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches Array Int (Array Int b)
forall a. Array Int a
nullArray) AllTextMatches (Array Int) (Array Int b)
-> AllTextMatches (Array Int) (Array Int b)
forall a. a -> a
id (a -> b -> Maybe (AllTextMatches (Array Int) (Array Int b))
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM a
r b
s)
matchM :: forall (m :: * -> *).
MonadFail m =>
a -> b -> m (AllTextMatches (Array Int) (Array Int b))
matchM a
r b
s = case a -> b -> AllTextMatches [] (Array Int b)
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllTextMatches []) -> m (AllTextMatches (Array Int) (Array Int b))
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllTextMatches [Array Int b]
as) -> AllTextMatches (Array Int) (Array Int b)
-> m (AllTextMatches (Array Int) (Array Int b))
forall (m :: * -> *) a. Monad m => a -> m a
return (AllTextMatches (Array Int) (Array Int b)
-> m (AllTextMatches (Array Int) (Array Int b)))
-> ([Array Int b] -> AllTextMatches (Array Int) (Array Int b))
-> [Array Int b]
-> m (AllTextMatches (Array Int) (Array Int b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Array Int b) -> AllTextMatches (Array Int) (Array Int b)
forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches (Array Int (Array Int b)
-> AllTextMatches (Array Int) (Array Int b))
-> ([Array Int b] -> Array Int (Array Int b))
-> [Array Int b]
-> AllTextMatches (Array Int) (Array Int b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Array Int b] -> Array Int (Array Int b)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Array Int b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Array Int b]
as) ([Array Int b] -> m (AllTextMatches (Array Int) (Array Int b)))
-> [Array Int b] -> m (AllTextMatches (Array Int) (Array Int b))
forall a b. (a -> b) -> a -> b
$ [Array Int b]
as