{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances #-}
module Text.Regex.Base.RegexLike (
MatchOffset,
MatchLength,
MatchArray,
MatchText,
MatchResult(..),
RegexOptions(..),
RegexMaker(..),
RegexLike(..),
RegexContext(..),
Extract(..),
AllSubmatches(..),AllTextSubmatches(..),AllMatches(..),AllTextMatches(..)
) where
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail as Fail (MonadFail)
#endif
import Data.Array(Array,(!))
import Data.Maybe(isJust)
import qualified Data.ByteString as SB (take,drop,empty,ByteString)
import qualified Data.ByteString.Lazy as LB (take,drop,empty,ByteString)
import qualified Data.Sequence as S(take,drop,empty,Seq)
import qualified Data.Text as ST (take,drop,empty,Text)
import qualified Data.Text.Lazy as LT (take,drop,empty,Text)
type MatchOffset = Int
type MatchLength = Int
type MatchArray = Array Int (MatchOffset,MatchLength)
type MatchText source = Array Int (source,(MatchOffset,MatchLength))
data MatchResult a = MR {
forall a. MatchResult a -> a
mrBefore :: a,
forall a. MatchResult a -> a
mrMatch :: a,
forall a. MatchResult a -> a
mrAfter :: a,
forall a. MatchResult a -> [a]
mrSubList :: [a],
forall a. MatchResult a -> Array Int a
mrSubs :: Array Int a
}
class RegexOptions regex compOpt execOpt
| regex -> compOpt execOpt
, compOpt -> regex execOpt
, execOpt -> regex compOpt
where
blankCompOpt :: compOpt
blankExecOpt :: execOpt
defaultCompOpt :: compOpt
defaultExecOpt :: execOpt
setExecOpts :: execOpt -> regex -> regex
getExecOpts :: regex -> execOpt
class (RegexOptions regex compOpt execOpt) => RegexMaker regex compOpt execOpt source
| regex -> compOpt execOpt, compOpt -> regex execOpt, execOpt -> regex compOpt where
makeRegex :: source -> regex
makeRegexOpts :: compOpt -> execOpt -> source -> regex
makeRegexM :: (MonadFail m) => source -> m regex
makeRegexOptsM :: (MonadFail m) => compOpt -> execOpt -> source -> m regex
makeRegex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt
makeRegexM = forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt
makeRegexOpts compOpt
c execOpt
e source
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"makeRegexOpts failed") forall a. a -> a
id (forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM compOpt
c execOpt
e source
s)
makeRegexOptsM compOpt
c execOpt
e source
s = forall (m :: * -> *) a. Monad m => a -> m a
return (forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts compOpt
c execOpt
e source
s)
class (Extract source) => RegexLike regex source where
matchOnce :: regex -> source -> Maybe MatchArray
matchAll :: regex -> source -> [MatchArray]
matchCount :: regex -> source -> Int
matchTest :: regex -> source -> Bool
matchAllText :: regex -> source -> [MatchText source]
matchOnceText :: regex -> source -> Maybe (source, MatchText source, source)
matchAll regex
regex source
source = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) (forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText regex
regex source
source)
matchOnce regex
regex source
source = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(source
_,MatchText source
mt,source
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd MatchText source
mt) (forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText regex
regex source
source)
matchTest regex
regex source
source = forall a. Maybe a -> Bool
isJust (forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
matchOnce regex
regex source
source)
matchCount regex
regex source
source = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll regex
regex source
source)
matchOnceText regex
regex source
source =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MatchArray
ma -> let (Int
o,Int
l) = MatchArray
ma forall i e. Ix i => Array i e -> i -> e
! Int
0
in (forall source. Extract source => Int -> source -> source
before Int
o source
source
,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int, Int)
ol -> (forall source. Extract source => (Int, Int) -> source -> source
extract (Int, Int)
ol source
source,(Int, Int)
ol)) MatchArray
ma
,forall source. Extract source => Int -> source -> source
after (Int
oforall a. Num a => a -> a -> a
+Int
l) source
source))
(forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
matchOnce regex
regex source
source)
matchAllText regex
regex source
source =
forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int, Int)
ol -> (forall source. Extract source => (Int, Int) -> source -> source
extract (Int, Int)
ol source
source,(Int, Int)
ol)))
(forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll regex
regex source
source)
class (RegexLike regex source) => RegexContext regex source target where
match :: regex -> source -> target
matchM :: (MonadFail m) => regex -> source -> m target
class source where
before :: Int -> source -> source
after :: Int -> source -> source
empty :: source
:: (Int,Int) -> source -> source
extract (Int
off,Int
len) source
source = forall source. Extract source => Int -> source -> source
before Int
len (forall source. Extract source => Int -> source -> source
after Int
off source
source)
instance Extract String where
before :: Int -> String -> String
before = forall a. Int -> [a] -> [a]
take; after :: Int -> String -> String
after = forall a. Int -> [a] -> [a]
drop; empty :: String
empty = []
instance Extract SB.ByteString where
before :: Int -> ByteString -> ByteString
before = Int -> ByteString -> ByteString
SB.take; after :: Int -> ByteString -> ByteString
after = Int -> ByteString -> ByteString
SB.drop; empty :: ByteString
empty = ByteString
SB.empty
instance Extract LB.ByteString where
before :: Int -> ByteString -> ByteString
before = Int64 -> ByteString -> ByteString
LB.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum; after :: Int -> ByteString -> ByteString
after = Int64 -> ByteString -> ByteString
LB.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum; empty :: ByteString
empty = ByteString
LB.empty
instance Extract (S.Seq a) where
before :: Int -> Seq a -> Seq a
before = forall a. Int -> Seq a -> Seq a
S.take; after :: Int -> Seq a -> Seq a
after = forall a. Int -> Seq a -> Seq a
S.drop; empty :: Seq a
empty = forall a. Seq a
S.empty
instance Extract ST.Text where
before :: Int -> Text -> Text
before = Int -> Text -> Text
ST.take; after :: Int -> Text -> Text
after = Int -> Text -> Text
ST.drop; empty :: Text
empty = Text
ST.empty
instance Extract LT.Text where
before :: Int -> Text -> Text
before = Int64 -> Text -> Text
LT.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum; after :: Int -> Text -> Text
after = Int64 -> Text -> Text
LT.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum; empty :: Text
empty = Text
LT.empty
newtype AllSubmatches f b = AllSubmatches {forall (f :: * -> *) b. AllSubmatches f b -> f b
getAllSubmatches :: (f b)}
newtype AllTextSubmatches f b = AllTextSubmatches {forall (f :: * -> *) b. AllTextSubmatches f b -> f b
getAllTextSubmatches :: (f b)}
newtype AllMatches f b = AllMatches {forall (f :: * -> *) b. AllMatches f b -> f b
getAllMatches :: (f b)}
newtype AllTextMatches f b = AllTextMatches {forall (f :: * -> *) b. AllTextMatches f b -> f b
getAllTextMatches :: (f b) }