{-# 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 = 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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
(AllMatches []) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
AllMatches [] target
xs -> 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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
(AllTextMatches []) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
AllTextMatches [] target
xs -> 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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match regex
r source
s of
([]) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
[target]
xs -> 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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail 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 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 -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Just (s, MatchText s, s)
preMApost -> 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 = 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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
Bool
False -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Bool
True -> 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 forall a b. RegexLike a b => a -> b -> Bool
matchTest a
r b
s of
Bool
False -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance (RegexLike a b) => RegexContext a b Int where
match :: a -> b -> Int
match = 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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
Int
0 -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Int
x -> 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1,Int
0) (forall i e. Ix i => Array i e -> i -> e
! Int
0) (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) b. MonadFail m => m b
regexFailed (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i e. Ix i => Array i e -> i -> e
! Int
0)) (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MR {mrBefore :: b
mrBefore = b
s,mrMatch :: b
mrMatch = forall source. Extract source => source
empty,mrAfter :: b
mrAfter = forall source. Extract source => source
empty
,mrSubs :: Array Int b
mrSubs = forall a. Array Int a
nullArray,mrSubList :: [b]
mrSubList = []}) forall a. a -> a
id (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 = 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) = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst MatchText b
ma
, mrSubList :: [b]
mrSubList = forall a b. (a -> b) -> [a] -> [b]
map 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,forall a. Array Int a
nullArray,forall source. Extract source => source
empty) forall a. a -> a
id (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) b. MonadFail m => m b
regexFailed forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,forall source. Extract source => source
empty,forall source. Extract source => source
empty) forall a. a -> a
id (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 = 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))]
_) = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
s,forall source. Extract source => source
empty,forall source. Extract source => source
empty,[]) forall a. a -> a
id (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 = 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) = forall i e. Array i e -> [e]
elems MatchText b
ma
in (b
pre,b
whole,b
post,forall a b. (a -> b) -> [a] -> [b]
map 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Array Int a
nullArray forall a. a -> a
id (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) b. MonadFail m => m b
regexFailed forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllSubmatches f b
AllSubmatches []) forall a. a -> a
id (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 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 -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
Just Array Int (Int, Int)
ma -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) b. f b -> AllSubmatches f b
AllSubmatches (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 = 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
_) -> forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches MatchText b
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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches []) forall a. a -> a
id (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 = 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
_) -> forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches []) forall a. a -> a
id (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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches forall a b. (a -> b) -> a -> 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
_) -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> [e]
elems 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) b. f b -> AllTextSubmatches f b
AllTextSubmatches forall a b. (a -> b) -> a -> 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
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches [ Array Int (Int, Int)
ma forall i e. Ix i => Array i e -> i -> e
! Int
0 | Array Int (Int, Int)
ma <- 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllMatches []) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllMatches [(Int, Int)]
pairs) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
pairs) 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 = 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
[] -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
[Array Int (Int, Int)]
mas -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllMatches f b
AllMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Array Int (Int, Int)]
mas) 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 = forall a b. RegexLike a b => a -> b -> [MatchText b]
matchAllText
matchM :: forall (m :: * -> *). MonadFail m => a -> b -> m [MatchText b]
matchM = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
([]) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
([MatchText b]
mts) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [MatchText b]
mts) 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 = forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches [ forall a b. (a, b) -> a
fst (MatchText b
ma forall i e. Ix i => Array i e -> i -> e
! Int
0) | MatchText b
ma <- 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllTextMatches []) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllTextMatches [b]
bs) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
bs) 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 = [ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall i e. Array i e -> [e]
elems MatchText b
ma) | MatchText b
ma <- 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
([]) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
([[b]]
ls) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [[b]]
ls) 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 = forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst MatchText b
ma | MatchText b
ma <- 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall a. Array Int a
nullArray) forall a. a -> a
id (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 forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match a
r b
s of
(AllTextMatches []) -> forall (m :: * -> *) b. MonadFail m => m b
regexFailed
(AllTextMatches [Array Int b]
as) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b. f b -> AllTextMatches f b
AllTextMatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Array Int b]
as) forall a b. (a -> b) -> a -> b
$ [Array Int b]
as