regex-xmlschema 0.1.0 → 0.1.1
raw patch · 5 files changed
+125/−19 lines, 5 files
Files
- examples/test/Main.hs +2/−2
- regex-xmlschema.cabal +1/−1
- src/Text/Regex/XMLSchema/String.hs +56/−15
- src/Text/Regex/XMLSchema/String/Regex.hs +65/−0
- src/Text/Regex/XMLSchema/String/RegexParser.hs +1/−1
examples/test/Main.hs view
@@ -212,7 +212,7 @@ where tokenTest (re, inp, toks) = TestCase $- assertEqual ("tokenize " ++ show re ++ show inp ++ " = " ++ show toks)+ assertEqual ("tokenize " ++ show re ++ " " ++ show inp ++ " = " ++ show toks) toks (tokenize re inp) tests = [ ("", "", [] )@@ -220,7 +220,7 @@ , ("a", "b", [] ) , ("a", "ba", ["a"] ) , ("a*", "a", ["a"] )- , ("a*", "ba", ["", "a"] )+ , ("a*", "ba", ["","a"] ) , ("a*", "aba", ["a", "a"] ) , ("a*", "abba", ["a", "", "a"] ) , ("a+", "abba", ["a", "a"] )
regex-xmlschema.cabal view
@@ -1,5 +1,5 @@ name: regex-xmlschema-version: 0.1.0+version: 0.1.1 license: BSD3 license-file: LICENSE maintainer: Uwe Schmidt <uwe@fh-wedel.de>
src/Text/Regex/XMLSchema/String.hs view
@@ -22,6 +22,7 @@ ( GenRegex , Regex + , grep , match , matchSubex , sed@@ -44,12 +45,14 @@ , mkUnit , mkSym1 , mkSymRng+ , mkWord , mkDot , mkStar , mkAll , mkAlt , mkElse , mkSeq+ , mkSeqs , mkRep , mkRng , mkOpt@@ -67,6 +70,7 @@ import Control.Arrow +import Data.List import Data.Maybe import Text.Regex.XMLSchema.String.Regex@@ -149,13 +153,14 @@ = token'' where re1 = mkDiff re mkUnit- token'' = token' re- token1'' = token' re1+ token'' = token' re fcs+ token1'' = token' re1 fcs+ fcs = firstChars re - -- token' :: (Eq l, Show l) => GenRegex l -> String -> [String]- token' re' inp+ -- token' :: (Eq l, Show l) => GenRegex l -> CharSet -> String -> [String]+ token' re' fcs' inp | null inp = []- | otherwise = evalRes . splitWithRegex re' $ inp+ | otherwise = evalRes . splitWithRegexCS re' fcs' $ inp where evalRes Nothing = token'' (tail inp) -- re does not match any prefix evalRes (Just (toks, rest))@@ -225,13 +230,14 @@ = token'' "" where re1 = mkDiff re mkUnit- token'' = token' re- token1'' = token' re1+ token'' = token' re fcs+ token1'' = token' re1 fcs+ fcs = firstChars re - -- token' :: (Eq l, Show l) => GenRegex l -> String -> String -> [Either String String]- token' re' unmatched inp+ -- token' :: (Eq l, Show l) => GenRegex l -> CharSet -> String -> String -> [Either String String]+ token' re' fcs' unmatched inp | null inp = addUnmatched []- | otherwise = evalRes . splitWithRegex re' $ inp+ | otherwise = evalRes . splitWithRegexCS re' fcs' $ inp where addUnmatched | null unmatched = id@@ -276,13 +282,14 @@ = token'' where re1 = mkDiff re mkUnit- token'' = token' re- token1'' = token' re1+ token'' = token' re fcs+ token1'' = token' re1 fcs+ fcs = firstChars re - -- token' :: (Eq l, Show l) => GenRegex l -> String -> [(l,String)]- token' re' inp+ -- token' :: (Eq l, Show l) => GenRegex l -> CharSet -> String -> [(l,String)]+ token' re' fcs' inp | null inp = []- | otherwise = evalRes . splitWithRegex re' $ inp+ | otherwise = evalRes . splitWithRegexCS re' fcs' $ inp where evalRes Nothing = token'' (tail inp) -- re does not match any prefix evalRes (Just (toks, rest))@@ -377,5 +384,39 @@ matchSubex :: String -> String -> [(String, String)] matchSubex = matchSubexRE . parseRegex++-- ------------------------------------------------------------++-- | grep like filter for lists of strings+--+-- The regular expression may be prefixed with the usual context spec \"^\" for start of string,+-- and "\\<" for start of word.+-- and suffixed with \"$\" for end of text and "\\>" end of word.+-- Word chars are defined by the multi char escape sequence "\\w"+--+-- Examples+--+-- > grep "a" ["_a_", "_a", "a_", "a", "_"] => ["_a_", "_a", "a_", "a"]+-- > grep "^a" ["_a_", "_a", "a_", "a", "_"] => ["a_", "a"]+-- > grep "a$" ["_a_", "_a", "a_", "a", "_"] => ["_a", "a"]+-- > grep "^a$" ["_a_", "_a", "a_", "a", "_"] => ["a"]+-- > grep "\\<a" ["x a b", " ax ", " xa ", "xab"] => ["x a b", " ax "]+-- > grep "a\\>" ["x a b", " ax ", " xa ", "xab"] => ["x a b", " xa "]++grep :: String -> [String] -> [String]+grep re = filter (matchRE re')+ where+ re' = mkSeqs . concat $ [ startContext+ , (:[]) . parseRegex $ re2+ , endContext+ ]+ (startContext, re1)+ | "^" `isPrefixOf` re = ([], tail re)+ | "\\<" `isPrefixOf` re = ([parseRegex "(\\A\\W)?"], drop 2 re)+ | otherwise = ([mkStar mkDot], re)+ (endContext, re2)+ | "$" `isSuffixOf` re1 = ([], init re1)+ | "\\>" `isSuffixOf` re1 = ([parseRegex "(\\W\\A)?"], init . init $ re1)+ | otherwise = ([mkStar mkDot], re1) -- ------------------------------------------------------------
src/Text/Regex/XMLSchema/String/Regex.hs view
@@ -26,12 +26,14 @@ , mkSym , mkSym1 , mkSymRng+ , mkWord , mkDot , mkStar , mkAll , mkAlt , mkElse , mkSeq+ , mkSeqs , mkRep , mkRng , mkOpt@@ -50,10 +52,14 @@ , delta1 , delta + , firstChars+ , matchWithRegex , matchWithRegex' , splitWithRegex , splitWithRegex'+ , splitWithRegexCS+ , splitWithRegexCS' ) where @@ -150,6 +156,10 @@ mkSymRng c1 c2 = mkSym $ rangeCS c1 c2 {-# INLINE mkSymRng #-} +-- | mkSym generaized for strings+mkWord :: [Char] -> GenRegex l+mkWord = mkSeqs . map mkSym1+ -- | construct an r.e. for the set of all Unicode chars mkDot :: GenRegex l mkDot = Dot@@ -239,6 +249,10 @@ mkSeq (Seq e1 e2) e3 = mkSeq e1 (mkSeq e2 e3) mkSeq e1 e2 = Seq e1 e2 +-- | mkSeq extened to lists+mkSeqs :: [GenRegex l] -> GenRegex l+mkSeqs = foldr mkSeq mkUnit+ -- | Construct repetition r{i,} mkRep :: Eq l => Int -> GenRegex l -> GenRegex l mkRep 0 e = mkStar e@@ -474,6 +488,34 @@ -- ------------------------------------------------------------ +-- | FIRST for regular expressions+--+-- this is only an approximation, the real set of char may be smaller,+-- when the expression contains intersection, set difference or exor operators++firstChars :: GenRegex l -> CharSet++firstChars (Zero _) = emptyCS+firstChars Unit = emptyCS+firstChars (Sym p) = p+firstChars Dot = allCS++firstChars (Star e1) = firstChars e1+firstChars (Alt e1 e2) = firstChars e1 `unionCS` firstChars e2+firstChars (Else e1 e2) = firstChars e1 `unionCS` firstChars e2+firstChars (Seq e1 e2)+ | nullable e1 = firstChars e1 `unionCS` firstChars e2+ | otherwise = firstChars e1+firstChars (Rep _i e) = firstChars e+firstChars (Rng _i _j e) = firstChars e+firstChars (Diff e1 _e2) = firstChars e1 -- this is an approximation+firstChars (Isec e1 e2) = firstChars e1 `intersectCS` firstChars e2 -- this is an approximation+firstChars (Exor e1 e2) = firstChars e1 `unionCS` firstChars e2 -- this is an approximation+firstChars (Br _l e _s) = firstChars e+firstChars (Cbr e _ss) = firstChars e++-- ------------------------------------------------------------+ delta1 :: Eq l => GenRegex l -> Char -> GenRegex l delta1 e@(Zero _) _ = e delta1 Unit c = mkZero $@@ -485,6 +527,7 @@ delta1 Dot _ = mkUnit +delta1 e@(Star Dot) _ = e delta1 e@(Star e1) c = mkSeq (delta1 e1 c) e delta1 (Alt e1 e2) c = mkAlt (delta1 e1 c) (delta1 e2 c)@@ -545,6 +588,11 @@ (re', rest) <- splitWithRegex' (mkBr' re) inp return ( snd . nullable' $ re', rest) +splitWithRegexCS :: Eq l => GenRegex l -> CharSet -> String -> Maybe ([(Label l,String)], String)+splitWithRegexCS re cs inp = do+ (re', rest) <- splitWithRegexCS' (mkBr' re) cs inp+ return ( snd . nullable' $ re', rest)+ -- | The main scanner function splitWithRegex' :: Eq l => GenRegex l -> String -> Maybe (GenRegex l, String)@@ -560,5 +608,22 @@ | nullable re = Just (re, inp) | otherwise = Nothing evalRes res = res++-- | speedup version for splitWithRegex'+--+-- This function checks whether the input starts with a char from FIRST re.+-- If this is not the case, the split fails. The FIRST set can be computed once+-- for a whole tokenizer and reused by every call of split++splitWithRegexCS' :: Eq l => GenRegex l -> CharSet -> String -> Maybe (GenRegex l, String)++splitWithRegexCS' re _cs ""+ | nullable re = Just (re, "")+ | otherwise = Nothing++splitWithRegexCS' re cs inp@(c : _)+ | c `elemCS` cs = splitWithRegex' re inp+ | nullable re = Just (re, inp)+ | otherwise = Nothing -- ------------------------------------------------------------
src/Text/Regex/XMLSchema/String/RegexParser.hs view
@@ -127,7 +127,7 @@ seqList = do rs <- many piece- return $ foldr mkSeq mkUnit rs+ return $ mkSeqs rs piece :: Parser Regex piece