diff --git a/examples/colorizeProgs/ColorizeSourceCode.hs b/examples/colorizeProgs/ColorizeSourceCode.hs
--- a/examples/colorizeProgs/ColorizeSourceCode.hs
+++ b/examples/colorizeProgs/ColorizeSourceCode.hs
@@ -22,16 +22,14 @@
import Control.Arrow
import Data.List
-import Data.Maybe
-import System
-import System.IO -- import the IO and commandline option stuff
import System.Environment
+import System.IO -- import the IO and commandline option stuff
import System.Console.GetOpt
import System.Exit
import Text.Regex.XMLSchema.String
-import Text.XML.HXT.Arrow
+import Text.XML.HXT.Core
import Text.XML.HXT.Parser.XhtmlEntities
@@ -48,6 +46,7 @@
, inputFile :: String
}
+defaultProcess :: Process
defaultProcess = P { inFilter = id
, tokenRE = plainRE
, markupRE = id
@@ -98,6 +97,7 @@
usage
exitWith (ExitFailure (-1))
+evalArgs :: ([(String, String)], [FilePath], [String]) -> IO Process
evalArgs (opts, files, errs)
| not (null errs) = exitErr ("illegal arguments " ++ show errs)
| null files = evalOpts opts defaultProcess
@@ -147,6 +147,7 @@
evalOpt ("html", "1") p = return $ p { formatToken = formatHtmlTok
, formatDoc = formatHtmlDoc }
evalOpt ("full", "1") p = return $ p { outFilter = outFilter p >>> fullHtml (inputFile p) }
+evalOpt (opt, _v ) p = exitErr ("illegal option " ++ show opt) >> return p
usage :: IO ()
usage = hPutStrLn stderr use
@@ -166,13 +167,13 @@
>>> outFilter p
addMarkup :: Regex -> Regex
-addMarkup = mkElse (parseRegex . mkLE $ markupT)
+addMarkup = mkElse (parseRegexExt . mkLE $ markupT)
tokenizeLines :: String -> [(String, String)]
tokenizeLines = map (\ l -> ("",l ++ "\n")) . lines
numberLines :: [String] -> [String]
-numberLines = zipWith addNum [1..]
+numberLines = zipWith addNum [(1::Int)..]
where
addNum i l = "" ++ fmt 4 i ++ "" ++ l
fmt l = sed (const " ") " "
@@ -185,6 +186,7 @@
substTabs :: String -> String
substTabs = subs 0
+subs :: Int -> String -> String
subs _ "" = ""
subs i (x:xs)
| x == '\t' = replicate (8 - (i `mod` 8)) ' ' ++ subs 0 xs
@@ -207,6 +209,7 @@
formatTok :: String -> String -> String
formatTok kw tok = " (" ++ show kw ++ ",\t" ++ show tok ++ "\t)\n"
+formatHtmlDoc :: [String] -> String
formatHtmlDoc = map (("" ++) . (++ "
") . preserveEmptyLines)
>>> ("" :)
>>> (++ ["
"])
@@ -216,14 +219,19 @@
preserveEmptyLines l = l
formatHtmlTok :: (String, String) -> String
+formatHtmlTok ("markup", t@(x:_))
+ | x `elem` "<&" = t
formatHtmlTok (m, t)
- | m == "markup" = t
| otherwise = colorizeTokens m (escapeText >>> sed (const " ") " " $ t)
escapeText :: String -> String
-escapeText = concat . runLA (xshow (mkText >>> escapeHtmlDoc))
+escapeText = foldr cquote ""
+ where
+ cquote = fst escapeHtmlRefs
+-- escapeText = concat . runLA (xshowEscapeXml mkText)
+
fullHtml :: String -> String -> String
fullHtml fn s = unlines
[ ""
@@ -302,7 +310,7 @@
-- ------------------------------------------------------------
buildRegex :: [(String, String)] -> Regex
-buildRegex = foldr1 mkElse . map (uncurry mkBr') . map (second parseRegex)
+buildRegex = foldr1 mkElse . map (uncurry mkBr') . map (second parseRegexExt)
where
mkBr' "" = id
mkBr' l = mkBr l
@@ -317,11 +325,13 @@
mkLE :: (String, String) -> String
mkLE (l, re) = "({" ++ l ++ "}(" ++ re ++ "))"
+ws1RE, ws1RE',ws0RE :: String
ws1RE = "\\s+"
ws1RE' = "[ \t]+"
ws0RE = "[ \t]*"
-javacmt1, javacmt, strconst,
+ws, ws', javacmt1, javacmt, shcmt1, strconst,
+ markupT,
charconst, number,
par, xxx :: (String, String)
@@ -457,6 +467,7 @@
-- ------------------------------------------------------------
+bnfRE :: Regex
bnfRE = buildRegex
[ ws
, ("bnfnt" , "[A-Z][a-zA-Z0-9_]*" )
@@ -553,6 +564,7 @@
-- ------------------------------------------------------------
+shRE :: Regex
shRE = buildRegex
[ ws
, shcmt1
@@ -585,6 +597,7 @@
-- ------------------------------------------------------------
+rubyRE :: Regex
rubyRE = buildRegex
[ ws
, rubycmt
diff --git a/hxt-regex-xmlschema.cabal b/hxt-regex-xmlschema.cabal
--- a/hxt-regex-xmlschema.cabal
+++ b/hxt-regex-xmlschema.cabal
@@ -1,5 +1,5 @@
Name: hxt-regex-xmlschema
-Version: 9.0.4
+Version: 9.1.0
Synopsis: A regular expression library for W3C XML Schema regular expressions
Description: This library supports full W3C XML Schema regular expressions
inclusive all Unicode character sets and blocks.
diff --git a/src/Text/Regex/XMLSchema/String.hs b/src/Text/Regex/XMLSchema/String.hs
--- a/src/Text/Regex/XMLSchema/String.hs
+++ b/src/Text/Regex/XMLSchema/String.hs
@@ -6,7 +6,7 @@
License : MIT
Maintainer : Uwe Schmidt
- Stability : experimental
+ Stability : stable
Portability: portable
Convenient functions for W3C XML Schema Regular Expression Matcher.
@@ -24,6 +24,8 @@
, grep
, grepExt
+ , grepRE
+ , grepREwithLineNum
, match
, matchExt
@@ -76,12 +78,12 @@
, parseRegex -- re-export of Text.Regex.XMLSchema.String.RegexParser
, parseRegexExt
+ , parseContextRegex
)
where
import Control.Arrow
-import Data.List
import Data.Maybe
import Text.Regex.XMLSchema.String.Regex
@@ -270,12 +272,12 @@
addMatched t = addUnmatched . ((Right t) :)
- evalRes Nothing = token'' ((head inp) : unmatched) (tail inp) -- re does not match any prefix
+ evalRes Nothing = token'' ((head inp) : unmatched) (tail inp) -- re does not match any prefix
evalRes (Just (toks, rest))
- | null tok = addMatched tok $ token'' (take 1 rest) (tail rest) -- re is nullable and only the empty prefix matches
- -- discard one char and try again
- | otherwise = addMatched tok $ token1'' "" rest -- real token found, next token must not be empty
+ | null tok = addMatched tok $ token'' (take 1 rest) (tail rest) -- re is nullable and only the empty prefix matches
+ -- discard one char and try again
+ | otherwise = addMatched tok $ token1'' "" rest -- real token found, next token must not be empty
where
tok = snd . head $ toks
@@ -448,19 +450,16 @@
grepExt = grep' parseRegexExt
grep' :: (String -> Regex) -> String -> [String] -> [String]
-grep' parseRegex' re = filter (matchRE re')
- where
- re' = mkSeqs . concat $ [ startContext
- , (:[]) . parseRegex' $ re2
- , endContext
- ]
- (startContext, re1)
- | "^" `isPrefixOf` re = ([], tail re)
- | "\\<" `isPrefixOf` re = ([parseRegexExt "(\\A\\W)?"], drop 2 re)
- | otherwise = ([mkStar mkDot], re)
- (endContext, re2)
- | "$" `isSuffixOf` re1 = ([], init re1)
- | "\\>" `isSuffixOf` re1 = ([parseRegexExt "(\\W\\A)?"], init . init $ re1)
- | otherwise = ([mkStar mkDot], re1)
+grep' parseRegex' = grepRE . parseContextRegex parseRegex'
+
+-- | grep with already prepared Regex (ususally with 'parseContextRegex')
+
+grepRE :: Regex -> [String] -> [String]
+grepRE re = filter (matchRE re)
+
+-- | grep with Regex and line numbers
+
+grepREwithLineNum :: Regex -> [String] -> [(Int,String)]
+grepREwithLineNum re = filter (matchRE re . snd) . zip [(1::Int)..]
-- ------------------------------------------------------------
diff --git a/src/Text/Regex/XMLSchema/String/Regex.hs b/src/Text/Regex/XMLSchema/String/Regex.hs
--- a/src/Text/Regex/XMLSchema/String/Regex.hs
+++ b/src/Text/Regex/XMLSchema/String/Regex.hs
@@ -575,7 +575,10 @@
-- ------------------------------------------------------------
delta :: Eq l => GenRegex l -> String -> GenRegex l
-delta = foldl' delta1
+delta e [] = e
+delta e@(Zero _) _xs = e
+delta e@(Star Dot) _xs = e
+delta e (x : xs) = delta (delta1 e x) xs
matchWithRegex :: Eq l => GenRegex l -> String -> Bool
matchWithRegex e = nullable . delta e
diff --git a/src/Text/Regex/XMLSchema/String/RegexParser.hs b/src/Text/Regex/XMLSchema/String/RegexParser.hs
--- a/src/Text/Regex/XMLSchema/String/RegexParser.hs
+++ b/src/Text/Regex/XMLSchema/String/RegexParser.hs
@@ -22,6 +22,7 @@
module Text.Regex.XMLSchema.String.RegexParser
( parseRegex
, parseRegexExt
+ , parseContextRegex
)
where
@@ -29,6 +30,8 @@
import Data.Char.Properties.UnicodeCharProps
import Data.Char.Properties.XMLCharProps
+import Data.List ( isPrefixOf, isSuffixOf )
+
import Data.Maybe
import Data.Set.CharSet
@@ -67,6 +70,35 @@
eof
return r
) ""
+
+-- ------------------------------------------------------------
+
+-- | parse a regular expression surrounded by contenxt spec
+--
+-- a leading @^@ denotes start of text,
+-- a trailing @$@ denotes end of text,
+-- a leading @\\<@ denotes word start,
+-- a trailing @\\>@ denotes word end.
+--
+-- The 1. param ist the regex parser ('parseRegex' or 'parseRegexExt')
+
+parseContextRegex :: (String -> Regex) -> String -> Regex
+parseContextRegex parseRe re
+ = re'
+ where
+ re' = mkSeqs . concat $ [ startContext
+ , (:[]) . parseRe $ re2
+ , endContext
+ ]
+ (startContext, re1)
+ | "^" `isPrefixOf` re = ([], tail re)
+ | "\\<" `isPrefixOf` re = ([parseRegexExt "(\\A\\W)?"], drop 2 re)
+ | otherwise = ([mkStar mkDot], re)
+ (endContext, re2)
+ | "$" `isSuffixOf` re1 = ([], init re1)
+ | "\\>" `isSuffixOf` re1 = ([parseRegexExt "(\\W\\A)?"], init . init $ re1)
+ | otherwise = ([mkStar mkDot], re1)
+
-- ------------------------------------------------------------