regexpr 0.2.0 → 0.2.1
raw patch · 4 files changed
+75/−59 lines, 4 filessetup-changed
Files
- Hidden/ParseRegexStr.hs +48/−57
- Hidden/Tools.hs +16/−0
- Setup.hs +10/−1
- regexpr.cabal +1/−1
Hidden/ParseRegexStr.hs view
@@ -8,65 +8,61 @@ , parseRegexStr ) where -import Hidden.RegexPRTypes ( RegexSrcParser, RegexAction(..),- reverseRegexAction,- getBR, modifyBR,- isModeI, isModeM, isModeX, setMode,- runRegexSrcParser )-import Hidden.ParseLib( runParse, spot, token, mplus, mzero, tokens,- list, greedyList, optional, endOfInput )-import Control.Monad.State( liftM )-import Hidden.Tools ( isSymbol, (|||), isBit7On )-import Data.Char ( isAlphaNum, isAlpha, isDigit, isSpace,- toUpper, toLower )-import Hidden.SrcRegActList- ( plusesList, oneCharList, backSlashesList, parensesList, charClassList )+import Hidden.RegexPRTypes ( RegexSrcParser, runRegexSrcParser,+ RegexAction(..), reverseRegexAction,+ getBR, modifyBR,+ setMode, isModeI, isModeM, isModeX )+import Hidden.ParseLib ( runParse, spot, token, mplus, mzero, token, tokens,+ list, greedyList, optional, endOfInput )+import Control.Monad.State ( liftM )+import Hidden.Tools ( isSymbol, (|||), isBit7On, bifurcate, cat2funcL,+ modifySnd, skipRet, (>..>) )+import Data.Char ( isAlphaNum, isAlpha, isDigit, isSpace,+ toUpper, toLower )+import Data.Ix ( inRange )+import Hidden.SrcRegActList( plusesList, oneCharList, backSlashesList,+ parensesList, charClassList ) parseRegexStr :: String -> [RegexAction]-parseRegexStr- = fst . fst . head . (runParse $ runRegexSrcParser parseRegexStrParser) .- (,) []+parseRegexStr =+ fst . fst . head . (runParse $ runRegexSrcParser parseRegexStrParser) . (,) [] parseRegexStrParser, parseTokensOr, parseTokens :: RegexSrcParser [RegexAction] parseRegexStrParser = parseTokensOr >>= endOfInput parseTokensOr = parseTokens `mplus`- do { ra1 <- parseTokens;- token '|';- ra2 <- parseTokensOr;+ do { ra1 <- parseTokens; token '|'; ra2 <- parseTokensOr; return $ [ RegexOr ra1 ra2 ] } parseTokens = greedyList parseTokenPlus -parseTokenPlus, parseToken, parseAlpha :: RegexSrcParser RegexAction+parseTokenPlus, parseToken, parseAlphaNum :: RegexSrcParser RegexAction parseTokenPlus = do ra <- parseToken plus <- parsePluses plusesList `mplus` parseQuantifier return $ plus ra- parseQuantifier :: RegexSrcParser (RegexAction -> RegexAction) parseQuantifier = do { token '{';- m <- list $ spot isDigit;+ min <- list $ spot isDigit; max <- do { cma <- optional $ token ','; case cma of "" -> return Nothing- _ -> list (spot isDigit) >>= return . Just; };+ _ -> list (spot isDigit) >>= return . Just }; token '}'; nd <- optional (token '?') >>= return . null;- return $ (if nd then Repeat else RepeatNotGreedy) (read m) $+ return $ (if nd then Repeat else RepeatNotGreedy) (read min) $ case max of- Nothing -> Just $ read m+ Nothing -> Just $ read min Just "" -> Nothing Just n -> Just $ read n } parseToken- = do parseAlpha- `mplus`- do { c <- spot isDigit; return $ Select (==c) }+ = parseAlphaNum `mplus`- do { token '\\'; c <- spot isSymbol; return $ Select (==c) }+ ( token '\\' >> spot isSymbol >>= return . Select . (==) ) `mplus`- do { token '\\'; optional $ token '{'; d1 <- spot isDigit;- d2 <- greedyList $ spot isDigit; optional $ token '}';+ do { token '\\'; optional (token '{');+ d1 <- spot isDigit; d2 <- greedyList (spot isDigit);+ optional (token '}'); return $ BackReference $ read $ d1:d2 } `mplus` do { token '['; isNotNot <- optional (token '^') >>= return . null;@@ -79,13 +75,10 @@ do { tokens "(?"; list parseMode >>= mapM_ (uncurry setMode); token ')'; return NopRegex } `mplus`- do { tokens "(?";- modes <- list parseMode;- mapM_ (uncurry setMode) modes;- token ':';+ do { tokens "(?"; modes <- list parseMode; token ':';+ flip mapM_ modes $ uncurry setMode; ras <- parseTokensOr;- mapM_ (\(m,b) -> setMode m $ not b) modes;- token ')';+ flip mapM_ modes $ uncurry setMode . modifySnd not; token ')'; return $ Parens ras } `mplus` do { m <- isModeM;@@ -103,21 +96,21 @@ `mplus` do { tokens "(?#"; c <- list $ spot (/=')'); token ')'; return $ Comment c } -parseAlpha- = do i <- isModeI- if i then do { c <- spot isAlpha; return $ Select $ flip elem- $ [toUpper c, toLower c] }- else do { c <- spot isAlpha; return $ Select (==c) }+parseAlphaNum = do+ { i <- isModeI;+ spot isAlpha >>= return . Select .+ if i then flip elem . bifurcate (cat2funcL toUpper toLower)+ else (==) }+ `mplus` ( spot isDigit >>= return . Select . (==) ) parseMode :: RegexSrcParser (Char, Bool) parseMode = do b <- optional (token '-') >>= return . null spot (flip elem "imx") >>= return . flip (,) b parseTokenX :: RegexSrcParser RegexAction-parseTokenX = do { spot isSpace; return NopRegex }- `mplus`- do { token '#'; c <- list $ spot (/='\n'); token '\n';- return $ Comment c }+parseTokenX = ( spot isSpace >> return NopRegex ) `mplus`+ ( token '#' >> list (spot (/='\n')) >>= skipRet (token '\n') >>=+ return . Comment ) parsePluses :: [ (String, RegexAction -> RegexAction) ] ->@@ -135,19 +128,17 @@ parseParenses :: [ (String, [RegexAction] -> RegexAction) ] -> RegexSrcParser RegexAction parseParenses- = foldr mplus mzero . map (\(t, act) -> do tokens ('(':t) - ras <- parseTokensOr- token ')'- return $ act ras)+ = foldr mplus mzero . map ( \(t, act) ->+ tokens ('(':t) >> parseTokensOr >>= skipRet (token ')') >>= return . act ) parseCharList :: RegexSrcParser (Char -> Bool) parseCharList = do- cl <- greedyList (parseChar `mplus` parseCharArea `mplus` parseCharClass)- return $ \c -> or $ zipWith ($) cl (repeat c)+ cl <- greedyList (parseChar `mplus` parseCharArea `mplus` parseCharClass);+ return $ or . zipWith ($) cl . repeat where parseChar = (spot isAlphaNum `mplus` (token '\\' >> spot isSymbol))- >>= return . (==)- parseCharArea = do { b <- spot isAlphaNum; token '-'; e <- spot isAlphaNum;- return $ flip elem [b..e] }+ >>= return . (==)+ parseCharArea = (spot isAlphaNum >>= skipRet (token '-')) >..>+ spot isAlphaNum >>= return . inRange parseCharClass = foldr mplus mzero $- map (\(s, p) -> tokens ("[:"++s++":]") >> return p) charClassList- -- tokens "[:alnum:]" >> return isAlphaNum+ map (\(s, p) -> tokens ("[:"++s++":]") >> return p)+ charClassList
Hidden/Tools.hs view
@@ -17,6 +17,10 @@ , (|||) , (&&&) , isBit7On+, bifurcate+, cat2funcL+, skipRet+, (>..>) ) where import Control.Monad.State( StateT(StateT, runStateT), lift, MonadTrans )@@ -55,3 +59,15 @@ isBit7On :: Char -> Bool isBit7On c = ord c .&. (shiftL 1 7) /= 0++bifurcate :: (a -> a -> b) -> a -> b+bifurcate f x = f x x++cat2funcL :: (a -> c) -> (b -> c) -> a -> b -> [c]+cat2funcL f g x y = [f x, g y ]++skipRet :: Monad m => m b -> a -> m a+skipRet p x = p >> return x++(>..>) :: Monad m => m a -> m b -> m (a, b)+m1 >..> m2 = do { x <- m1; y <- m2; return (x, y) }
Setup.hs view
@@ -3,6 +3,15 @@ import System.Exit(ExitCode(ExitSuccess)) import qualified Hidden.TestMain(main) +class Ret a where+ ret :: a++instance Ret () where+ ret = ()++instance Ret ExitCode where+ ret = ExitSuccess+ main = defaultMainWithHooks defaultUserHooks { runTests = \_ _ _ _ -> Hidden.TestMain.main >>- return ExitSuccess }+ return ret }
regexpr.cabal view
@@ -1,5 +1,5 @@ Name: regexpr-Version: 0.2.0+Version: 0.2.1 License: GPL License-File: LICENSE Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>