{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : Text.Regex.Base.Context Copyright : (c) Chris Kuklewicz 2006 License : BSD-style (see the file LICENSE) Maintainer : libraries@haskell.org, textregexlazy@personal.mightyreason.com Stability : experimental Portability : non-portable (MPTC+FD) This is a module of instances of 'RegexContext' (defined in Text.Regex.Base.RegexLike). Nothing else is exported. This is usually imported via the Text.Regex.Base convenience package which itself is re-exported from newer Text.Regex.XXX modules provided by the different regex-xxx backends. These instances work for all the supported types and backends interchangably. These instances provide the different results that can be gotten from a match or matchM operation (often via the @=~@ and @=~~@ operators with combine @makeRegex@ with @match@ and @matchM@ respectively). This module name is Context because they operators are context dependent: use them in a context that expects an Int and you get a count of matches, use them in a Bool context and get True if there is a match, etc. @RegexContext a b c@ takes a regular expression suppied in a type 'a' generated by 'RegexMaker' and a target text supplied in type 'b' to a result type 'c' using the 'match' class function. The 'matchM' class function works like 'match' unless there is no match found, in which case it calls 'fail' in the (arbitrary) monad context. There are a few type synonyms from RegexLike that are used here: @ -- | 0 based index from start of source, or (-1) for unused type MatchOffset = Int -- | non-negative length of a match type MatchLength = Int type MatchArray = Array Int (MatchOffset, MatchLength) type MatchText source = Array Int (source, (MatchOffset, MatchLength)) @ There are also a few newtypes that used to prevent any possible overlap of types, which were not needed for GHC's late overlap detection but are needed for use in Hugs. @ newtype AllSubmatches f b = AllSubmatches {getAllSubmatches :: (f b)} newtype AllTextSubmatches f b = AllTextSubmatches {getAllTextSubmatches :: (f b)} newtype AllMatches f b = AllMatches {getAllMatches :: (f b)} newtype AllTextMatches f b = AllTextMatches {getAllTextMatches :: (f b) } @ The newtypes' @f@ parameters are the containers, usually @[]@ or @Array Int@, (where the arrays all have lower bound 0). The two *Submatches newtypes return only information on the first match. The other two newtypes return information on all the non-overlapping matches. The two *Text* newtypes are used to mark result types that contain the same type as the target text. Where provided, noncaptured submatches will have a @MatchOffset@ of (-1) and non-negative otherwise. The semantics of submatches depend on the backend and its compile and execution options. Where provided, @MatchLength@ will always be non-negative. Arrays with no elements are returned with bounds of (1,0). Arrays with elements will have a lower bound of 0. XXX THIS HADDOCK DOCUMENTATION IS OUT OF DATE XXX These are for finding the first match in the target text: @ RegexContext a b Bool @ : Whether there is any match or not. @ RegexContext a b () @ : Useful as a guard with @matchM@ or @=~~@ in a monad, since failure to match calls 'fail'. @ RegexContext a b b @ : This returns the text of the whole match. It will return 'empty' from the 'Extract' type class if there is no match. These are defined in each backend module, but documented here for convenience. @ RegexContext a b (MatchOffset,MatchLength) @ : This returns the initial index and length of the whole match. MatchLength will always be non-negative, and 0 for a failed match. @ RegexContext a b (MatchResult b) @ : The 'MatchResult' structure with details for the match. This is the structure copied from the old @JRegex@ pacakge. @ RegexContext a b (b, b, b) @ : The text before the match, the text of the match, the text after the match @ RegexContext a b (b, MatchText b, b) @ : The text before the match, the details of the match, and the text after the match @ RegexContext a b (b, b, b, [b]) @ : The text before the match, the text of the match, the text after the match, and a list of the text of the 1st and higher sub-parts of the match. This is the same return value as used in the old @Text.Regex@ API. Two containers of the submatch offset information: @ RegexContext a b MatchArray @ : Array of @(MatchOffset,MatchLength)@ for all the sub matches. The whole match is at the intial 0th index. Noncaptured submatches will have a @MatchOffset@ of (-1) The array will have no elements and bounds (1,0) if there is no match. @ RegexContext a b (AllSubmatches [] (MatchOffset,MatchLength) @ : List of @(MatchOffset,MatchLength)@ The whole match is the first element, the rest are the submatches (if any) in order. The list is empty if there is no match. Two containers of the submatch text and offset information: @ RegexContext a b (AllTextSubmatches (Array Int) (b, (MatchOffset, MatchLength))) @ @ RegexContext a b (AllTextSubmatches [] (b, (MatchOffset, MatchLength))) @ Two containers of the submatch text information: @ RegexContext a b (AllTextSubmatches [] b) @ @ RegexContext a b (AllTextSubmatches (Array Int) b) @ These instances are for all the matches (non-overlapping). Note that backends are supposed to supply 'RegexLike' instances for which the default 'matchAll' and 'matchAllText' stop searching after returning any successful but empty match. @ RegexContext a b Int @ : The number of matches, non-negative. Two containers for locations of all matches: @ RegexContext a b (AllMatches [] (MatchOffset, MatchLength)) @ @ RegexContext a b (AllMatches (Array Int) (MatchOffset,MatchLength)) @ Two containers for the locations of all matches and their submatches: @ RegexContext a b [MatchArray] @ : @ RegexContext a b (AllMatches (Array Int) MatchArray) @ Two containers for the text and locations of all matches and their submatches: @ RegexContext a b [MatchText b] @ @ RegexContext a b (AllTextMatches (Array Int) (MatchText b)) @ Two containers for text of all matches: @ RegexContext a b (AllTextMatches [] b) @ @ RegexContext a b (AllTextMatches (Array Int) b) @ Four containers for text of all matches and their submatches: @ RegexContext a b [[b]] @ @ RegexContext a b (AllTextMatches (Array Int) [b]) @ @ RegexContext a b (AllTextMatches [] (Array Int b)) @ @ RegexContext a b (AllTextMatches (Array Int) (Array Int b)) @ Unused matches are 'empty' (defined via 'Extract') -} module Text.Regex.Base.Context() where import Control.Monad(liftM) import Data.Array(Array,(!),elems,listArray) -- import Data.Maybe(maybe) import Text.Regex.Base.RegexLike(RegexLike(..),RegexContext(..) ,AllSubmatches(..),AllTextSubmatches(..),AllMatches(..),AllTextMatches(..) ,MatchResult(..),Extract(empty),MatchOffset,MatchLength,MatchArray,MatchText) {- -- Get the ByteString type for mood/doom import Data.ByteString(ByteString) -- Get the Regex types for the mood/doom workaround import qualified Text.Regex.Lib.WrapPosix as R1(Regex) import qualified Text.Regex.Lib.WrapPCRE as R2(Regex) import qualified Text.Regex.Lib.WrapLazy as R3(Regex) import qualified Text.Regex.Lib.WrapDFAEngine as R4(Regex) -- Get the RegexLike instances import Text.Regex.Lib.StringPosix() import Text.Regex.Lib.StringPCRE() import Text.Regex.Lib.StringLazy() import Text.Regex.Lib.StringDFAEngine() import Text.Regex.Lib.ByteStringPosix() import Text.Regex.Lib.ByteStringPCRE() import Text.Regex.Lib.ByteStringLazy() import Text.Regex.Lib.ByteStringDFAEngine() -} {- mood :: (RegexLike a b) => a -> b -> b {-# INLINE mood #-} mood r s = case matchOnceText r s of Nothing -> empty Just (_,ma,_) -> fst (ma!0) doom :: (RegexLike a b,Monad m) => a -> b -> m b {-# INLINE doom #-} doom = actOn (\(_,ma,_)->fst (ma!0)) {- These run afoul of various restrictions if I say "instance RegexContext a b b where" so I am listing these cases explicitly -} instance RegexContext R1.Regex String String where match = mood; matchM = doom instance RegexContext R2.Regex String String where match = mood; matchM = doom instance RegexContext R3.Regex String String where match = mood; matchM = doom instance RegexContext R4.Regex String String where match = mood; matchM = doom instance RegexContext R1.Regex ByteString ByteString where match = mood; matchM = doom instance RegexContext R2.Regex ByteString ByteString where match = mood; matchM = doom instance RegexContext R3.Regex ByteString ByteString where match = mood; matchM = doom instance RegexContext R4.Regex ByteString ByteString where match = mood; matchM = doom -} nullArray :: Array Int a {-# INLINE nullArray #-} nullArray = listArray (1,0) [] nullFail :: (RegexContext regex source (AllMatches [] target),Monad m) => regex -> source -> m (AllMatches [] target) {-# INLINE nullFail #-} nullFail r s = case match r s of (AllMatches []) -> regexFailed xs -> return xs nullFailText :: (RegexContext regex source (AllTextMatches [] target),Monad m) => regex -> source -> m (AllTextMatches [] target) {-# INLINE nullFailText #-} nullFailText r s = case match r s of (AllTextMatches []) -> regexFailed xs -> return xs nullFail' :: (RegexContext regex source ([] target),Monad m) => regex -> source -> m ([] target) {-# INLINE nullFail' #-} nullFail' r s = case match r s of ([]) -> regexFailed xs -> return xs regexFailed :: (Monad m) => m b {-# INLINE regexFailed #-} regexFailed = fail $ "regex failed to match" actOn :: (RegexLike r s,Monad m) => ((s,MatchText s,s)->t) -> r -> s -> m t {-# INLINE actOn #-} actOn f r s = case matchOnceText r s of Nothing -> regexFailed Just preMApost -> return (f preMApost) -- ** Instances based on matchTest () instance (RegexLike a b) => RegexContext a b Bool where match = matchTest matchM r s = case match r s of False -> regexFailed True -> return True instance (RegexLike a b) => RegexContext a b () where match _ _ = () matchM r s = case matchTest r s of False -> regexFailed True -> return () -- ** Instance based on matchCount instance (RegexLike a b) => RegexContext a b Int where match = matchCount matchM r s = case match r s of 0 -> regexFailed x -> return x -- ** Instances based on matchOnce,matchOnceText instance (RegexLike a b) => RegexContext a b (MatchOffset,MatchLength) where match r s = maybe (-1,0) (!0) (matchOnce r s) matchM r s = maybe regexFailed (return.(!0)) (matchOnce r s) instance (RegexLike a b) => RegexContext a b (MatchResult b) where match r s = maybe (MR {mrBefore = s,mrMatch = empty,mrAfter = empty ,mrSubs = nullArray,mrSubList = []}) id (matchM r s) matchM = actOn (\(pre,ma,post) -> let ((whole,_):subs) = elems ma in MR { mrBefore = pre , mrMatch = whole , mrAfter = post , mrSubs = fmap fst ma , mrSubList = map fst subs }) instance (RegexLike a b) => RegexContext a b (b,MatchText b,b) where match r s = maybe (s,nullArray,empty) id (matchOnceText r s) matchM r s = maybe regexFailed return (matchOnceText r s) instance (RegexLike a b) => RegexContext a b (b,b,b) where match r s = maybe (s,empty,empty) id (matchM r s) matchM = actOn (\(pre,ma,post) -> let ((whole,_):_) = elems ma in (pre,whole,post)) instance (RegexLike a b) => RegexContext a b (b,b,b,[b]) where match r s = maybe (s,empty,empty,[]) id (matchM r s) matchM = actOn (\(pre,ma,post) -> let ((whole,_):subs) = elems ma in (pre,whole,post,map fst subs)) -- now AllSubmatches wrapper instance (RegexLike a b) => RegexContext a b MatchArray where match r s = maybe nullArray id (matchOnce r s) matchM r s = maybe regexFailed return (matchOnce r s) instance (RegexLike a b) => RegexContext a b (AllSubmatches [] (MatchOffset,MatchLength)) where match r s = maybe (AllSubmatches []) id (matchM r s) matchM r s = case matchOnce r s of Nothing -> regexFailed Just ma -> return (AllSubmatches (elems ma)) -- essentially AllSubmatches applied to (MatchText b) instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) (b, (MatchOffset, MatchLength))) where match r s = maybe (AllTextSubmatches nullArray) id (matchM r s) matchM r s = actOn (\(_,ma,_) -> AllTextSubmatches ma) r s instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] (b, (MatchOffset, MatchLength))) where match r s = maybe (AllTextSubmatches []) id (matchM r s) matchM r s = actOn (\(_,ma,_) -> AllTextSubmatches (elems ma)) r s instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] b) where match r s = maybe (AllTextSubmatches []) id (matchM r s) matchM r s = liftM AllTextSubmatches $ actOn (\(_,ma,_) -> map fst . elems $ ma) r s instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) b) where match r s = maybe (AllTextSubmatches nullArray) id (matchM r s) matchM r s = liftM AllTextSubmatches $ actOn (\(_,ma,_) -> fmap fst ma) r s -- ** Instances based on matchAll,matchAllText instance (RegexLike a b) => RegexContext a b (AllMatches [] (MatchOffset,MatchLength)) where match r s = AllMatches [ ma!0 | ma <- matchAll r s ] matchM r s = nullFail r s instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) (MatchOffset,MatchLength)) where match r s = maybe (AllMatches nullArray) id (matchM r s) matchM r s = case match r s of (AllMatches []) -> regexFailed (AllMatches pairs) -> return . AllMatches . listArray (0,pred $ length pairs) $ pairs -- No AllMatches wrapper instance (RegexLike a b) => RegexContext a b [MatchArray] where match = matchAll matchM = nullFail' instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) MatchArray) where match r s = maybe (AllMatches nullArray) id (matchM r s) matchM r s = case match r s of [] -> regexFailed mas -> return . AllMatches . listArray (0,pred $ length mas) $ mas -- No AllTextMatches wrapper instance (RegexLike a b) => RegexContext a b [MatchText b] where match = matchAllText matchM = nullFail' instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (MatchText b)) where match r s = maybe (AllTextMatches nullArray) id (matchM r s) matchM r s = case match r s of ([]) -> regexFailed (mts) -> return . AllTextMatches . listArray (0,pred $ length mts) $ mts instance (RegexLike a b) => RegexContext a b (AllTextMatches [] b) where match r s = AllTextMatches [ fst (ma!0) | ma <- matchAllText r s ] matchM r s = nullFailText r s instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) b) where match r s = maybe (AllTextMatches nullArray) id (matchM r s) matchM r s = case match r s of (AllTextMatches []) -> regexFailed (AllTextMatches bs) -> return . AllTextMatches . listArray (0,pred $ length bs) $ bs -- No AllTextMatches wrapper instance (RegexLike a b) => RegexContext a b [[b]] where match r s = [ map fst (elems ma) | ma <- matchAllText r s ] matchM r s = nullFail' r s instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) [b]) where match r s = maybe (AllTextMatches nullArray) id (matchM r s) matchM r s = case match r s of ([]) -> regexFailed (ls) -> return . AllTextMatches . listArray (0,pred $ length ls) $ ls instance (RegexLike a b) => RegexContext a b (AllTextMatches [] (Array Int b)) where match r s = AllTextMatches [ fmap fst ma | ma <- matchAllText r s ] matchM r s = nullFailText r s instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (Array Int b)) where match r s = maybe (AllTextMatches nullArray) id (matchM r s) matchM r s = case match r s of (AllTextMatches []) -> regexFailed (AllTextMatches as) -> return . AllTextMatches . listArray (0,pred $ length as) $ as