diff --git a/Hidden/ParseLib.hs b/Hidden/ParseLib.hs --- a/Hidden/ParseLib.hs +++ b/Hidden/ParseLib.hs @@ -1,13 +1,8 @@ --- --- ParseLib.lhs - --- Library functions for parsing --- Note that this is not a monadic approach to parsing. --- --- (c) Simon Thompson, 1995,1998. --- --- modified by Yoshikuni Jujo +-- ParseLib.hs -- +-- Author: Yoshikuni Jujo +-- + {-# OPTIONS_GHC -fglasgow-exts #-} {-# OPTIONS_GHC -fallow-undecidable-instances #-} diff --git a/Hidden/ParseLibCore.hs b/Hidden/ParseLibCore.hs --- a/Hidden/ParseLibCore.hs +++ b/Hidden/ParseLibCore.hs @@ -1,13 +1,6 @@ --- --- ParseLib.lhs - --- Library functions for parsing --- Note that this is not a monadic approach to parsing. --- --- (c) Simon Thompson, 1995,1998. --- --- Monadic parsing --- modified by Yoshikuni Jujo +-- ParseLibCore.hs +-- +-- Author: Yoshikuni Jujo -- {-# OPTIONS_GHC -fglasgow-exts #-} diff --git a/Hidden/ParseRegexStr.hs b/Hidden/ParseRegexStr.hs --- a/Hidden/ParseRegexStr.hs +++ b/Hidden/ParseRegexStr.hs @@ -1,20 +1,29 @@ +-- ParseRegexStr.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.ParseRegexStr ( RegexAction(..) , parseRegexStr ) where -import Hidden.RegexPRTypes ( RegexSrcParser, RegexAction(..), - reverseRegexAction ) -import Hidden.ParseLib ( runParse, spot, token, mplus, mzero, tokens, list, - greedyList, endOfInput ) -import Control.Monad.State( runStateT, get, modify, liftM ) -import Hidden.Tools ( isSymbol ) -import Data.Char ( isAlphaNum, isDigit ) -import Hidden.SrcRegActList ( plusesList, backSlashesList, parensesList) +import Hidden.RegexPRTypes ( RegexSrcParser, RegexAction(..), + reverseRegexAction, + getBR, modifyBR, isModeI, setModeI, + runRegexSrcParser ) +import Hidden.ParseLib( runParse, spot, token, mplus, mzero, tokens, + list, greedyList, optional, endOfInput ) +import Control.Monad.State( liftM ) +import Hidden.Tools ( isSymbol ) +import Data.Char ( isAlphaNum, isAlpha, isDigit, toUpper, toLower ) +import Hidden.SrcRegActList + ( plusesList, oneCharList, backSlashesList, parensesList ) parseRegexStr :: String -> [RegexAction] parseRegexStr - = fst . fst . head . (runParse $ runStateT parseRegexStrParser 1) . (,) [] + = fst . fst . head . (runParse $ runRegexSrcParser parseRegexStrParser) . + (,) [] parseRegexStrParser, parseTokensOr, parseTokens :: RegexSrcParser [RegexAction] parseRegexStrParser = parseTokensOr >>= endOfInput @@ -26,73 +35,72 @@ return $ [ RegexOr ra1 ra2 ] } parseTokens = greedyList parseTokenPlus -parseTokenPlus, parseToken :: RegexSrcParser RegexAction +parseTokenPlus, parseToken, parseAlpha :: RegexSrcParser RegexAction parseTokenPlus = do ra <- parseToken plus <- parsePluses plusesList `mplus` parseQuantifier return $ plus ra -parsePluses :: - [ (String, RegexAction -> RegexAction) ] -> - RegexSrcParser (RegexAction -> RegexAction) -parsePluses = foldr mplus mzero . map (\(t, act) -> tokens t >> return act) parseQuantifier :: RegexSrcParser (RegexAction -> RegexAction) parseQuantifier - = do { token '{'; m <- list (spot isDigit); token '}'; - return $ Repeat (read m) (Just $ read m) } - `mplus` - do { token '{'; m <- list (spot isDigit); tokens ",}"; - return $ Repeat (read m) Nothing } - `mplus` - do { token '{'; m <- list (spot isDigit); token ','; - n <- list (spot isDigit); token '}'; - return $ Repeat (read m) (Just $ read n) } - `mplus` - do { token '{'; m <- list (spot isDigit); tokens "}?"; - return $ RepeatNotGreedy (read m) (Just $ read m) } - `mplus` - do { token '{'; m <- list (spot isDigit); tokens ",}?"; - return $ RepeatNotGreedy (read m) Nothing } - `mplus` - do { token '{'; m <- list (spot isDigit); token ','; - n <- list (spot isDigit); tokens "}?"; - return $ RepeatNotGreedy (read m) (Just $ read n) } + = do { token '{'; + m <- list $ spot isDigit; + max <- do { cma <- optional $ token ','; + case cma of + "" -> return Nothing + _ -> list (spot isDigit) >>= return . Just; }; + token '}'; + nd <- optional (token '?') >>= return . null; + return $ (if nd then Repeat else RepeatNotGreedy) (read m) $ + case max of + Nothing -> Just $ read m + Just "" -> Nothing + Just n -> Just $ read n } parseToken - = do { token '.'; return $ Select (/='\n') } - `mplus` - do { token '$'; return $ RegexOr [EndOfInput] [Still [Select (=='\n')]] } - `mplus` - do { token '^'; return $ RegexOr [BeginningOfInput] - [Still [Backword [Select (=='\n')]]] } - `mplus` - do { c <- spot isAlphaNum; return $ Select (==c) } - `mplus` - do { spot (==' '); return $ Select (==' ') } + = do parseAlpha `mplus` - do { spot (==','); return $ Select (==',') } + do { c <- spot isDigit; return $ Select (==c) } `mplus` do { token '\\'; c <- spot isSymbol; return $ Select (==c) } `mplus` - do { token '\\'; - d1 <- spot isDigit; d2 <- greedyList $ spot isDigit; + do { token '\\'; d1 <- spot isDigit; d2 <- greedyList $ spot isDigit; return $ BackReference $ read $ d1:d2 } `mplus` - do { token '['; cl <- parseCharList; token ']'; - return $ Select (flip elem cl) } - `mplus` - do { token '['; token '^'; cl <- parseCharList; token ']'; - return $ Select (flip notElem cl) } + do { token '['; isNotNot <- optional (token '^') >>= return . null; + cl <- parseCharList; token ']'; + return $ Select $ flip (if isNotNot then elem else notElem) cl } `mplus` - do { i <- get; - token '('; modify (+1); ras <- parseTokensOr; token ')'; + do { i <- getBR; token '('; modifyBR (+1); ras <- parseTokensOr; token ')'; return $ Note i ras } `mplus` + do { tokens "(?"; token 'i'; token ')'; setModeI True; return NopRegex } + `mplus` + do { tokens "(?"; token 'i'; token ':'; + setModeI True; ras <- parseTokensOr; setModeI False; + token ')'; return $ Parens ras } + `mplus` + parseOneChar oneCharList + `mplus` parseBackSlashes backSlashesList `mplus` parseParenses parensesList `mplus` - do { tokens "(?#"; com <- list $ spot (/=')'); token ')'; - return $ Comment com } + 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) } + +parsePluses :: + [ (String, RegexAction -> RegexAction) ] -> + RegexSrcParser (RegexAction -> RegexAction) +parsePluses = foldr mplus mzero . map (\(t, act) -> tokens t >> return act) + +parseOneChar :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction +parseOneChar + = foldr mplus mzero . map (\(t, act) -> token t >> return act) parseBackSlashes :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction parseBackSlashes diff --git a/Hidden/RegexPRCore.hs b/Hidden/RegexPRCore.hs --- a/Hidden/RegexPRCore.hs +++ b/Hidden/RegexPRCore.hs @@ -1,3 +1,8 @@ +-- RegexPRCore.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.RegexPRCore ( matchRegexPRVerbose ) where @@ -59,6 +64,7 @@ PreMatchPoint -> guardEqual ask (lift ask) >> return "" Parens acts -> mkRegexParser isBack acts Comment _ -> return "" + NopRegex -> return "" >++> mkRegexParser isBack ras where selectParserFB = if isBack then selectParserBack else selectParser diff --git a/Hidden/RegexPRTypes.hs b/Hidden/RegexPRTypes.hs --- a/Hidden/RegexPRTypes.hs +++ b/Hidden/RegexPRTypes.hs @@ -1,6 +1,16 @@ +-- RegexPRTypes.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.RegexPRTypes ( reverseRegexAction , RegexSrcParser +, getBR +, modifyBR +, isModeI +, setModeI +, runRegexSrcParser , RegexAction(..) , RegexResult @@ -10,9 +20,9 @@ ) where import Hidden.ParseLib( Parse, runParse ) -import Control.Monad.State( StateT, runStateT ) +import Control.Monad.State( StateT, runStateT, gets, modify ) import Control.Monad.Reader( ReaderT(runReaderT) ) -import Hidden.Tools( modifySnd ) +import Hidden.Tools( modifySnd, modifyFst, first, modifyFirst ) type RegexResult = ( String, (String, String) ) type MatchList = [ (Int, String) ] @@ -22,7 +32,18 @@ RegexParser a -> (String, String) -> [((a, MatchList), (String, String))] runRegexParser point = runParse . flip runStateT [] . flip runReaderT point -type RegexSrcParser = StateT Int (Parse Char) +type RegexSrcParser = StateT (Int, (Bool, Bool, Bool)) (Parse Char) +getBR :: RegexSrcParser Int +getBR = gets fst +modifyBR :: (Int -> Int) -> RegexSrcParser () +modifyBR = modify . modifyFst +setModeI :: Bool -> RegexSrcParser () +setModeI = modify . modifySnd . modifyFirst . const +isModeI :: RegexSrcParser Bool +isModeI = gets $ first . snd +runRegexSrcParser :: RegexSrcParser a -> Parse Char (a, (Int,(Bool,Bool,Bool))) +runRegexSrcParser = flip runStateT (1, (False, False, False)) + data RegexAction = Select (Char -> Bool) | Repeat Int (Maybe Int) RegexAction | RepeatNotGreedy Int (Maybe Int) RegexAction | @@ -32,7 +53,7 @@ RegActNot [RegexAction] | BeginningOfInput | EndOfInput | PreMatchPoint | Parens [RegexAction] | - Comment String + Comment String | NopRegex reverseRegexAction :: RegexAction -> RegexAction reverseRegexAction (Note i ras) diff --git a/Hidden/SrcRegActList.hs b/Hidden/SrcRegActList.hs --- a/Hidden/SrcRegActList.hs +++ b/Hidden/SrcRegActList.hs @@ -1,5 +1,11 @@ +-- SrcRegActList.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.SrcRegActList ( plusesList +, oneCharList , backSlashesList , parensesList ) where @@ -16,6 +22,15 @@ , ( "+?", RepeatNotGreedy 1 Nothing ) , ( "?" , Repeat 0 $ Just 1 ) , ( "??", RepeatNotGreedy 0 $ Just 1 ) + ] + +oneCharList :: [ (Char, RegexAction) ] +oneCharList = [ + ('.', Select (/='\n')) + , ('$', RegexOr [EndOfInput] [Still [Select (=='\n')]]) + , ('^', RegexOr [BeginningOfInput] [Still [Backword [Select (=='\n')]]]) + , (',', Select (==',')) + , (' ', Select (==' ')) ] backSlashesList :: [ (Char, RegexAction) ] diff --git a/Hidden/TestMain.hs b/Hidden/TestMain.hs --- a/Hidden/TestMain.hs +++ b/Hidden/TestMain.hs @@ -1,3 +1,8 @@ +-- TestMain.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.TestMain where import Test.HUnit @@ -130,4 +135,9 @@ gsubRegexPR "(?<=\\d)(?=\\D)|(?<=\\D)(?=\\d)" "\t" "abc323def45" , Just ( ("ab cd", ("", "e")), [] ) ~=? matchRegexPR "ab cd" "ab cde" , Just ( ("ab,cd", ("", "e")), [] ) ~=? matchRegexPR "ab,cd" "ab,cde" + , Just ( ("cde", ("ab", "fg")), [] ) ~=? + matchRegexPR "c(?# comment)de" "abcdefg" + , Just ( ("abCde", ("d", "fg")), [] ) ~=? matchRegexPR "ab(?i)cDe" "dabCdefg" + , Just ( ("aBcdE", ("", "")), [] ) ~=? matchRegexPR "a(?i:bC)dE" "aBcdE" + , Nothing ~=? matchRegexPR "a(?i:bC)dE" "aBcde" ] diff --git a/Hidden/Tools.hs b/Hidden/Tools.hs --- a/Hidden/Tools.hs +++ b/Hidden/Tools.hs @@ -1,6 +1,14 @@ +-- Tools.hs +-- +-- Author: Yoshikuni Jujo +-- + module Hidden.Tools ( isSymbol +, modifyFst , modifySnd +, first +, modifyFirst , guardEqual ) where @@ -14,8 +22,16 @@ (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (p1 &&& p2) x = p1 x && p2 x +modifyFst :: (a -> c) -> (a, b) -> (c, b) +modifyFst f (x, y) = (f x, y) modifySnd :: (b -> c) -> (a, b) -> (a, c) modifySnd f (x, y) = (x, f y) guardEqual :: (MonadPlus m, Eq a) => m a -> m a -> m () guardEqual m1 m2 = do { x <- m1; y <- m2; guard (x == y) } + +first :: (a,b,c) -> a +first (x,_,_) = x + +modifyFirst :: (a -> d) -> (a, b, c) -> (d, b, c) +modifyFirst f (x, y, z) = (f x, y, z) diff --git a/Text/RegexPR.hs b/Text/RegexPR.hs --- a/Text/RegexPR.hs +++ b/Text/RegexPR.hs @@ -1,3 +1,8 @@ +-- RegexPR.hs +-- +-- Author: Yoshikuni Jujo +-- + module Text.RegexPR ( matchRegexPR , gsubRegexPR diff --git a/regexpr.cabal b/regexpr.cabal --- a/regexpr.cabal +++ b/regexpr.cabal @@ -1,5 +1,5 @@ Name: regexpr -Version: 0.1.3 +Version: 0.1.5 License: GPL License-File: LICENSE Author: Yoshikuni Jujo @@ -18,6 +18,7 @@ Regular expression library like Perl/Ruby's regular expression. This package has a module RegexPR. And RegexPR export function matchRegexPR and gsubRegexPR. + | some matchRegexPR :: String -> Maybe ((String, (String, String)), [(Int, String)]), gsubRegexPR :: String -> String -> String. Examples: matchRegexPR "ab(cde)f\\1" "kkkabcdefcdefgh" =>