module RRegex.Syntax(
RegexLike(..),
RegexContext(..),
(!~~),
MatchResult(..)) where
import Data.Array
import RRegex.PCRE as PCRE
import Data.Maybe
import Control.Monad
import System.IO.Unsafe
class RegexLike r a | r -> a where
matchTest :: r -> [a] -> Bool
matchCount :: r -> [a] -> Int
matchAll :: r -> [a] -> [(Array Int (Int,Int))]
matchOnce :: r
-> [a]
-> Bool
-> Maybe (Array Int (Int,Int))
matchShow :: r -> String
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
(=~) :: RegexLike r x => [x] -> r -> a
(=~~) :: (Monad m, RegexLike r x) => [x] -> r -> m a
(!~~) :: 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
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
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)
instance RegexContext x Bool where
s =~ re = matchTest re s
s =~~ re = case s =~ re of
False -> regexFailed re
True -> return True
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 ([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