{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
-- arch-tag: 1498020a-9de2-44e3-ae69-14bb1febb77e
{- |
basic usage:
string =~ 'regular expression' returns different things depending on context
type - what it evaluates to
---------------------------
Int - number of times the regular expression matches
String - matching portion of string
(String,String,String) - (text before match, matching text, text after match)
[Either String String] - list of matching and nonmatching strings, if concated, the original string results. Left = notmatching, Right = matching.
Bool - whether the string matches
() - always returns () (useful in monad context, see below)
[String] - list of matches
Array Int String - list of substring matches for first match
(String, Array Int String) - full matching text and substring matches
[(String, Array Int String)] - all matches, full match plus substrings
[Array Int String] - all substrings from all matches
also, there is the monadic version (=~~) which always behaves exactly the same
as (=~) except when the match fails, instead of returning a default value, the
monad fails.
regular expressions:
these may be strings, which are interpreted as regular expressions, or Regex's
from the Text.Regex module. or any other instance of the RegexLike class.
when using strings, you may prefix the regex by "(?flags)" where flags is one
of 'i' for a case insensitive match and 'm' means a multi-line match. other
flags may be available depending on your implementation
advanced features:
not just strings can be matched, but rather lists of anything a matcher is
defined for. RegexLikeImp data class can be used for in-place code generated
by template haskell for compile-time checked regular expresions
-}
module RRegex.Syntax(
RegexLike(..),
RegexContext(..),
(!~~),
MatchResult(..)) where
import Data.Array
import RRegex.PCRE as PCRE
--import RRegex
import Data.Maybe
import Control.Monad
import System.IO.Unsafe
-- | instances of this class may be used as regular expressions with this syntax.
class RegexLike r a | r -> a where
-- | Test whether the regex matches at all
matchTest :: r -> [a] -> Bool
-- | Count the number of times the regex matches
matchCount :: r -> [a] -> Int
-- | return all matches
matchAll :: r -> [a] -> [(Array Int (Int,Int))]
-- | match once
matchOnce :: r -- ^ Regular Expression
-> [a] -- ^ String to match
-> Bool -- ^ Whether we are at the begining of the string (as opposed to continuing a previous match)
-> Maybe (Array Int (Int,Int)) -- ^ array of matched expression
matchShow :: r -> String -- ^ Used for error messages
matchTest r xs = isJust (matchOnce r xs True)
matchCount r xs = length (matchAll r xs)
matchAll r xs = f 0 xs where
f t xs = case matchOnce r xs (t == 0) of
Nothing -> []
Just a | l == 0 -> [na]
| otherwise -> na:f (t + x) (drop x xs) where
(o,l) = a!0
x = o + l
na = fmap (adj t) a
adj t (x,y) = ((,) $! x + t) $! y
matchShow _ = "Unknown"
data MatchResult a = MR {
mrBefore :: [a],
mrMatch :: [a],
mrAfter :: [a],
mrSubList :: [[a]],
mrSubs :: Array Int [a]
}
instance RegexLike PCRE.Regex Char where
matchOnce re cs bol = unsafePerformIO (PCRE.execute re cs (if not bol then pcreNotbol else 0))
matchShow _ = "PCRE Regex"
class RegexContext x a where
-- | match a list against a regular expression, changing its behavior based on its result type.
(=~) :: RegexLike r x => [x] -> r -> a
-- | Monadic version of (=~). behaves identically, except it causes the monad to fail when the expression does not match, rather than returning a default value.
(=~~) :: (Monad m, RegexLike r x) => [x] -> r -> m a
-- | check if regular expression does not match
(!~~) :: RegexLike r x => [x] -> r -> Bool
s !~~ re = not (s =~ re)
regexFailed :: (RegexLike r a, Monad m) => r -> m b
regexFailed re = fail $ "regex failed to match: " ++ matchShow re
-- | return number of expressions matched
instance RegexContext x Int where
s =~ re = matchCount re s
s =~~ re = case (s =~ re) of
0 -> regexFailed re
xs -> return $ xs
instance RegexContext x ([x],[x],[x]) where
s =~ re = maybe (s,[],[]) id (s =~~ re)
s =~~ re = case matchOnce re s True of
Nothing -> regexFailed re
Just a -> let (o,l) = a!o in return (take o s,take l (drop o s),drop (o + l) s)
instance RegexContext x ([x],[x],[x],Array Int [x]) where
s =~ re = maybe (s,[],[], listArray (1,0) []) id (s =~~ re)
s =~~ re = case s =~~ re of
Nothing -> regexFailed re
Just z -> return (mrBefore z,mrMatch z, mrAfter z, mrSubs z)
instance RegexContext x (MatchResult x) where
s =~ re = maybe MR {mrBefore = s,mrMatch = [],mrAfter = [],mrSubs = listArray (1,0) [], mrSubList = []} id (s =~~ re)
s =~~ re = case matchOnce re s True of
Nothing -> regexFailed re
Just z -> return $ MR {mrBefore = take o s, mrAfter = drop (o + l) s, mrMatch = a!0, mrSubs = a, mrSubList = tail (elems a) } where
a = fmap f z
f (o,l) = take l (drop o s)
(o,l) = z!0
{-
instance RegexContext x [Either [x] [x]] where
s =~ re = map f $ matchAll re s where
f (Left s) = Left s
f (Right (x,_)) = Right x
s =~~ re = case (s =~ re) of
[Left _] -> regexFailed re
xs -> return $ xs
-}
extract :: [a] -> (Int, Int) -> [a]
extract s (x,y) = take y (drop x s)
instance RegexContext x [x] where
s =~ re = case s =~~ re of
Nothing -> []
Just z -> mrMatch z
s =~~ re = liftM mrMatch (s =~~ re)
-- useful in non-monad context
instance RegexContext x Bool where
s =~ re = matchTest re s
s =~~ re = case s =~ re of
False -> regexFailed re
True -> return True
-- useful in monad context
instance RegexContext x () where
_ =~ _ = ()
s =~~ re = case s =~ re of
False -> regexFailed re
True -> return ()
instance RegexContext x [[x]] where
s =~ re = [extract s (a!0) | a <- matchAll re s]
s =~~ re = case (s =~ re) of
[] -> regexFailed re
xs -> return xs
instance RegexContext x [Array Int [x]] where
s =~ re = [fmap (extract s) x | x <- matchAll re s]
s =~~ re = case (s =~ re) of
[] -> regexFailed re
xs -> return xs
{-
instance RegexContext x [Array Int (Int,Int)] where
s =~ re = matchAll re s
s =~~ re = case (s =~ re) of
[] -> regexFailed re
xs -> return xs
-}
instance RegexContext x [Array Int ([x],(Int,Int))] where
s =~ re = [fmap (\z -> (extract s z,z)) x | x <- matchAll re s]
s =~~ re = case (s =~ re) of
[] -> regexFailed re
xs -> return xs
instance RegexContext x (Array Int [x]) where
s =~ re = maybe (listArray (1,0) []) id (s =~~ re)
s =~~ re = case s =~~ re of
Nothing -> regexFailed re
Just z -> return $ mrSubs z
instance RegexLike String Char where
matchOnce re xs bol = matchOnce (c re) xs bol where
c s = unsafePerformIO $
PCRE.compile s 0 >>= \x -> case x of
Left (i,err) -> fail $ "PCRE Regular Expression Error:\n" ++ re ++ "\n" ++ replicate i ' ' ++ "^ " ++ err
Right p -> return p
matchShow s = s
{-
instance RegexLike Regex Char where
matchOnce re xs = fmap f (matchRegexAll re xs) where
f (x,y,z,ls) = MR { mrBefore = x,mrMatch = y ,mrAfter = z,mrSubs = listArray (1,length ls) ls}
matchShow _ = "Regex"
instance RegexLike String Char where
--matchOnce re xs = fmap f (matchRegexAll (mr re) xs) where
-- f (x,y,z,ls) = (x,y,z,listArray (1,length ls) ls)
matchOnce re xs = fmap f (matchRegexAll (mr re) xs) where
f (x,y,z,ls) = MR { mrBefore = x,mrMatch = y ,mrAfter = z,mrSubs = listArray (1,length ls) ls}
mr ('i':'/':re) = mkRegexWithOpts re True False
mr ('s':'/':re) = mkRegexWithOpts re False True
mr ('i':'s':'/':re) = mkRegexWithOpts re False False
mr ('s':'i':'/':re) = mkRegexWithOpts re False False
mr ('/':re) = mkRegex re
mr (re) = mkRegex re
matchShow re = re
-}