diff --git a/Hidden/ParseLib.hs b/Hidden/ParseLib.hs --- a/Hidden/ParseLib.hs +++ b/Hidden/ParseLib.hs @@ -20,6 +20,8 @@ , greedyOptional , list , greedyList +, neList +, greedyNeList , beginningOfInput , endOfInput @@ -60,13 +62,14 @@ greedyRepeatParse mn Nothing p = (p >:> greedyRepeatParse mn Nothing p) `mplus` replicateM mn p -optional, greedyOptional :: MonadPlus m => m a -> m [a] +optional, greedyOptional, list, greedyList, neList, greedyNeList :: + MonadPlus m => m a -> m [a] optional = repeatParse 0 (Just 1) greedyOptional = greedyRepeatParse 0 (Just 1) - -list, greedyList :: MonadPlus m => m b -> m [b] -list = repeatParse 0 Nothing -greedyList = greedyRepeatParse 0 Nothing +list = repeatParse 0 Nothing +greedyList = greedyRepeatParse 0 Nothing +neList = repeatParse 1 Nothing +greedyNeList = greedyRepeatParse 1 Nothing -- beginning and end of input diff --git a/Hidden/ParseLibCore.hs b/Hidden/ParseLibCore.hs --- a/Hidden/ParseLibCore.hs +++ b/Hidden/ParseLibCore.hs @@ -28,7 +28,7 @@ spot :: (a -> Bool) -> m a spotBack :: (a -> Bool) -> m a still :: m b -> m b - parseNot :: b -> m b -> m b + parseNot :: c -> m b -> m c askHere :: m ([a],[a]) noBacktrack :: m b -> m b diff --git a/Hidden/ParseRegexStr.hs b/Hidden/ParseRegexStr.hs --- a/Hidden/ParseRegexStr.hs +++ b/Hidden/ParseRegexStr.hs @@ -8,23 +8,26 @@ , parseRegexStr ) where -import Hidden.RegexPRTypes ( RegexSrcParser, runRegexSrcParser, - RegexAction(..), +import Hidden.RegexPRTypes ( RegexAction(..), + RegexSrcParser, runRegexSrcParser, getBR, modifyBR, - setMode, isModeI, isModeM, isModeX ) -import Hidden.ParseLib ( runParse, spot, mplus, mzero, token, tokens, - list, greedyList, optional, endOfInput ) -import Hidden.Tools ( isSymbol, isBit7On, -- bifurcate, cat2funcL, - modifySnd, skipRet, (>..>), ignoreCase ) -import Data.Char ( isAlphaNum, isAlpha, isDigit, isSpace, - {- toUpper, toLower -} ) + setMode, setModes, getModes, + isModeI, isModeM, isModeX ) +import Hidden.ParseLib ( runParse, spot, token, tokens, mzero, mplus, + still, parseNot, endOfInput, MonadParse, + MonadPlus, + list, greedyNeList, optional ) +import Hidden.Tools ( isSymbol, ignoreCase, skipRet, (>..>), ifM, + applyIf, (&&&), headOrErr, modifyFst ) +import Data.Char ( isAlphaNum, isDigit, isSpace ) import Data.Ix ( inRange ) -import Hidden.SrcRegActList( plusesList, oneCharList, backSlashesList, - parensesList, charClassList, selfList ) +import Hidden.SrcRegActList( selfTest, oneCharList, backSlashesList, plusesList, + parensesList, charClassList ) parseRegexStr :: String -> [RegexAction] parseRegexStr = - fst . fst . head . (runParse $ runRegexSrcParser parseRegexStrParser) . (,) [] + fst . fst . headOrErr "parse error: regex is uncorrect" . + (runParse $ runRegexSrcParser parseRegexStrParser) . (,) [] parseRegexStrParser, parseTokensOr, parseTokens :: RegexSrcParser [RegexAction] parseRegexStrParser = parseTokensOr >>= endOfInput @@ -32,9 +35,9 @@ `mplus` do { ra1 <- parseTokens; token '|'; ra2 <- parseTokensOr; return $ [ RegexOr ra1 ra2 ] } -parseTokens = greedyList parseTokenPlus +parseTokens = list parseTokenPlus -parseTokenPlus, parseToken, parseAlphaNum :: RegexSrcParser RegexAction +parseTokenPlus, parseToken :: RegexSrcParser RegexAction parseTokenPlus = do ra <- parseToken plus <- parsePluses plusesList `mplus` parseQuantifier return $ plus ra @@ -43,9 +46,9 @@ = do { token '{'; mn <- list $ spot isDigit; mx <- do { cma <- optional $ token ','; - case cma of - "" -> return Nothing - _ -> list (spot isDigit) >>= return . Just }; + case cma of + "" -> return Nothing + _ -> list (spot isDigit) >>= return . Just }; token '}'; nd <- optional (token '?') >>= return . null; return $ (if nd then Repeat else RepeatNotGreedy) (read mn) $ @@ -55,104 +58,90 @@ Just n -> Just $ read n } parseToken - = parseAlphaNum + = ifM isModeX parseTokenX mzero `mplus` - ( token '\\' >> spot isSymbol >>= return . Select . (==) ) + ( isModeI >>= \ic -> + spot selfTest >>= return . Select . applyIf ic ignoreCase . (==) ) `mplus` - do { token '\\'; optional (token '{'); - d1 <- spot isDigit; d2 <- greedyList (spot isDigit); - optional (token '}'); - return $ BackReference $ read $ d1:d2 } + ( flip (ifM isModeM) mzero $ token '.' >> return (Select $ const True) ) `mplus` - do { token '['; isNotNot <- optional (token '^') >>= return . null; - cl <- parseCharList; token ']'; - return $ Select $ (if isNotNot then id else (not.)) cl } + ( token '\\' >> spot isSymbol >>= return . Select . (==) ) `mplus` - do { i <- getBR; token '('; modifyBR (+1); ras <- parseTokensOr; token ')'; - return $ Note i ras } + ( token '\\' >> optional (token '{') >> greedyNeList (spot isDigit) >>= + skipRet (optional $token '}') >>= return . BackReference . read ) `mplus` - do { tokens "(?"; list parseMode >>= mapM_ (uncurry setMode); token ')'; - return NopRegex } + ( token '[' >> optional (token '^') >>= return . not . null >>= \isNot -> + parseCharList >>= skipRet (token ']') >>= + return . Select . applyIf isNot (not.) ) `mplus` - do { tokens "(?"; modes <- list parseMode; token ':'; - flip mapM_ modes $ uncurry setMode; - ras <- parseTokensOr; - flip mapM_ modes $ uncurry setMode . modifySnd not; token ')'; - return $ Parens ras } + ( getBR >>= \i -> token '(' >> modifyBR (+1) >> parseTokensOr + >>= skipRet (token ')') >>= return . Note i ) `mplus` - do { m <- isModeM; - if m then token '.' >> return (Select $ const True) else mzero } + ( tokens "(?" >> list parseMode >>= mapM_ (uncurry setMode) >> token ')' + >> return NopRegex ) `mplus` - do { x <- isModeX; if x then parseTokenX else mzero } + ( getModes >>= \preModes -> + tokens "(?" >> list parseMode >>= mapM_ (uncurry setMode) >> token ':' >> + parseTokensOr >>= skipRet (setModes preModes >> token ')') + >>= return . Parens ) `mplus` parseOneChar oneCharList `mplus` - ( foldr mplus mzero $ map ((>>= return . Select . (==)) . token) selfList ) - `mplus` parseBackSlashes backSlashesList `mplus` parseParenses parensesList `mplus` - ( spot isBit7On >>= return . Select . (==) ) - `mplus` - do { tokens "(?#"; c <- list $ spot (/=')'); token ')'; return $ Comment c } - -parseAlphaNum = do - { i <- isModeI; - spot isAlpha >>= return . Select . - if i then ignoreCase . (==) - -- flip elem . bifurcate (cat2funcL toUpper toLower) - else (==) } - `mplus` ( spot isDigit >>= return . Select . (==) ) + ( tokens "(?#" >> list (spot (/=')')) >>= skipRet (token ')') >>= + return . Comment ) parseMode :: RegexSrcParser (Char, Bool) -parseMode = do b <- optional (token '-') >>= return . null - spot (flip elem "imx") >>= return . flip (,) b +parseMode = optional (token '-') >..> spot (flip elem "imx") + >>= return . uncurry (flip (,)) . modifyFst null parseTokenX :: RegexSrcParser RegexAction -parseTokenX = ( spot isSpace >> return NopRegex ) `mplus` - ( token '#' >> list (spot (/='\n')) >>= - skipRet (token '\n' `mplus` endOfInput '\n') >>= - return . Comment ) +parseTokenX + = ( spot isSpace >> return NopRegex ) `mplus` + ( token '#' >> list (spot (/='\n')) >>= + skipRet (token '\n' `mplus` endOfInput '\n') >>= return . Comment ) parsePluses :: [ (String, RegexAction -> RegexAction) ] -> RegexSrcParser (RegexAction -> RegexAction) -parsePluses = foldr mplus mzero . map (\(t, act) -> tokens t >> return act) +parsePluses = concatMapParse (\(t, act) -> tokens t >> return act) parseOneChar :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction parseOneChar - = foldr mplus mzero . map (\(t, act) -> token t >> return act) + = concatMapParse (\(t, act) -> token t >> return act) parseBackSlashes :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction parseBackSlashes - = foldr mplus mzero . map (\(t, act) -> tokens ['\\', t] >> return act) + = concatMapParse (\(t, act) -> tokens ['\\', t] >> return act) parseParenses :: [ (String, [RegexAction] -> RegexAction) ] -> RegexSrcParser RegexAction parseParenses - = foldr mplus mzero . map ( \(t, act) -> + = concatMapParse ( \(t, act) -> tokens ('(':t) >> parseTokensOr >>= skipRet (token ')') >>= return . act ) parseCharList :: RegexSrcParser (Char -> Bool) parseCharList = do modei <- isModeI - cl1 <- parseOne `mplus` - (foldr mplus mzero $ map ((>>= return . (==)) . token) "[]") - cl2 <- greedyList $ parseOne `mplus` - (foldr mplus mzero $ map ((>>= return . (==)) . token) "^") - return $ (if modei then ignoreCase else id) $ or . zipWith ($) (cl1 : cl2) - . repeat + cl1 <- parseOne `mplus` (concatMapParse ((>>= return . (==)) . token) "-]") + cl2 <- list $ parseOne `mplus` (token '^' >>= return . (==)) + return $ applyIf modei ignoreCase $ or . zipWith ($) (cl1 : cl2) . repeat where parseOne = (parseChar >>= return . (==)) `mplus` parseCharArea `mplus` parseCharClass - parseChar = ( spot isAlphaNum ) - `mplus` - ( token '\\' >> spot isSymbol ) - `mplus` - ( foldr mplus mzero $ map ((>>= return ) . token) - $ filter (/='-') selfList ) - parseCharArea = (parseChar >>= skipRet (token '-')) >..> parseChar >>= - return . inRange - parseCharClass = foldr mplus mzero $ - map (\(s, p) -> tokens ("[:"++s++":]") >> return p) - charClassList + parseChar = ( spot isAlphaNum ) `mplus` + ( token '\\' >> spot isSymbol ) `mplus` + ( spot $ selfTest &&& flip notElem "-]" ) `mplus` + ( token '+' ) `mplus` + ( token '[' >>= skipRet (still $ parseNot () + $ token ':') ) + parseCharArea = (parseChar >>= skipRet (token '-')) >..> parseChar + >>= return . inRange + parseCharClass = concatMapParse + (\(s, p) -> tokens ("[:"++s++":]") >> return p) + charClassList + +concatMapParse :: MonadPlus m => (b -> m a) -> [b] -> m a +concatMapParse f = foldr mplus mzero . map f diff --git a/Hidden/RegexPRTypes.hs b/Hidden/RegexPRTypes.hs --- a/Hidden/RegexPRTypes.hs +++ b/Hidden/RegexPRTypes.hs @@ -12,6 +12,8 @@ , isModeM , isModeX , setMode +, setModes +, getModes , runRegexSrcParser , RegexAction(..) @@ -25,8 +27,9 @@ import Control.Monad.State( StateT, runStateT, gets, modify ) import Control.Monad.Reader( ReaderT(runReaderT) ) import Hidden.Tools( modifySnd, modifyFst, - first, second, third, - modifyFirst, modifySecond, modifyThird ) + -- first, second, third, + -- modifyFirst, modifySecond, modifyThird + ) type RegexResult = ( String, (String, String) ) type MatchList = [ (Int, String) ] @@ -36,7 +39,8 @@ RegexParser a -> (String, String) -> [((a, MatchList), (String, String))] runRegexParser point = runParse . flip runStateT [] . flip runReaderT point -type RegexSrcParser = StateT (Int, (Bool, Bool, Bool)) (Parse Char) +type Modes = String +type RegexSrcParser = StateT (Int, Modes) (Parse Char) getBR :: RegexSrcParser Int getBR = gets fst @@ -45,17 +49,20 @@ modifyBR = modify . modifyFst setMode :: Char -> Bool -> RegexSrcParser () -setMode 'i' = modify . modifySnd . modifyFirst . const -setMode 'm' = modify . modifySnd . modifySecond . const -setMode 'x' = modify . modifySnd . modifyThird . const -setMode m = error $ "no " ++ [m] ++ " mode" +setMode c True = modify $ modifySnd (c:) +setMode c False = modify $ modifySnd (filter (/=c)) +getModes :: RegexSrcParser Modes +getModes = gets snd +setModes :: Modes -> RegexSrcParser () +setModes ms = modify $ modifySnd $ const ms + isModeI, isModeM, isModeX :: RegexSrcParser Bool -isModeI = gets $ first . snd -isModeM = gets $ second . snd -isModeX = gets $ third . snd -runRegexSrcParser :: RegexSrcParser a -> Parse Char (a, (Int,(Bool,Bool,Bool))) -runRegexSrcParser = flip runStateT (1, (False, False, False)) +isModeI = gets $ elem 'i' . snd +isModeM = gets $ elem 'm' . snd +isModeX = gets $ elem 'x' . snd +runRegexSrcParser :: RegexSrcParser a -> Parse Char (a, (Int,String)) +runRegexSrcParser = flip runStateT (1, "") data RegexAction = Select (Char -> Bool) | Repeat Int (Maybe Int) RegexAction | diff --git a/Hidden/SrcRegActList.hs b/Hidden/SrcRegActList.hs --- a/Hidden/SrcRegActList.hs +++ b/Hidden/SrcRegActList.hs @@ -4,19 +4,23 @@ -- module Hidden.SrcRegActList ( - plusesList + selfTest +, plusesList , oneCharList , backSlashesList , parensesList , charClassList -, selfList ) where -import Hidden.RegexPRTypes( RegexAction(..), reverseRegexAction ) -import Hidden.Tools( (&&&), (|||), isSymbol ) -import Data.Char( isAlphaNum, isAlpha, isUpper, isLower, - isDigit, isHexDigit, isSpace, isPrint, isControl ) +import Hidden.RegexPRTypes ( RegexAction(..), reverseRegexAction ) +import Data.Char ( isAlphaNum, isAlpha, isUpper, isLower, + isDigit, isHexDigit, isSpace, isPrint, isControl ) +import Hidden.Tools ( (&&&), (|||), isSymbol, isBit7On ) +selfTest :: Char -> Bool +selfTest + = flip elem "\n\f\r\t !\"#%&',-/:;<=>@]_'~" ||| isAlphaNum ||| isBit7On + plusesList :: [ (String, RegexAction -> RegexAction) ] plusesList = [ ( "" , id ) @@ -28,24 +32,17 @@ , ( "??", RepeatNotGreedy 0 $ Just 1 ) ] -selfList :: [ Char ] -selfList = ", <>-!:#@\n_\f\r\t=" - oneCharList :: [ (Char, RegexAction) ] oneCharList = [ ('.', Select (/='\n')) , ('$', RegexOr [EndOfInput] [Still [Select (=='\n')]]) , ('^', RegexOr [BeginningOfInput] [Still [Backword [Select (=='\n')]]]) --- , (',', Select (==',')) --- , (' ', Select (==' ')) --- , ('<', Select (=='<')) --- , ('>', Select (=='>')) ] backSlashesList :: [ (Char, RegexAction) ] backSlashesList = [ - ( 'w', Select $ isAlphaNum ||| (=='_') ) - , ( 'W', Select $ (not . isAlphaNum) &&& (/='_') ) + ( 'w', Select isWord ) + , ( 'W', Select $ not . isWord ) , ( 's', Select (flip elem " \t\n\r\f") ) , ( 'S', Select (flip notElem " \t\n\r\f") ) , ( 'd', Select isDigit ) @@ -54,16 +51,16 @@ , ( 'Z', RegexOr [EndOfInput] [Still [Select (=='\n'), EndOfInput]] ) , ( 'z', EndOfInput ) , ( 'b', regexOr [ - [ lookBehind [Select isAlphaNum], Still [selectNot isAlphaNum] ] - , [ lookBehind [selectNot isAlphaNum], Still [Select isAlphaNum] ] - , [ BeginningOfInput, Still [Select isAlphaNum] ] - , [ lookBehind [Select isAlphaNum], EndOfInput ] + [ lookBehind [Select isWord], Still [selectNot isWord] ] + , [ lookBehind [selectNot isWord], Still [Select isWord] ] + , [ BeginningOfInput, Still [Select isWord] ] + , [ lookBehind [Select isWord], EndOfInput ] ] ) , ( 'B', RegActNot [ regexOr [ - [ lookBehind [Select isAlphaNum], Still [selectNot isAlphaNum] ] - , [ lookBehind [selectNot isAlphaNum], Still [Select isAlphaNum] ] - , [ BeginningOfInput, Still [Select isAlphaNum] ] - , [ lookBehind [Select isAlphaNum], EndOfInput ] + [ lookBehind [Select isWord], Still [selectNot isWord] ] + , [ lookBehind [selectNot isWord], Still [Select isWord] ] + , [ BeginningOfInput, Still [Select isWord] ] + , [ lookBehind [Select isWord], EndOfInput ] ] ] ) , ( 'G', PreMatchPoint ) ] @@ -72,7 +69,7 @@ parensesList = [ ( "?<=", Still . (:[]) . Backword . reverse . map reverseRegexAction ) , ( "? Bool) ] charClassList = [ - ( "alnum", isAlphaNum ) - , ( "alpha", isAlpha ) - , ( "blank", isSpace ) - , ( "cntrl", isControl ) - , ( "digit", isDigit ) - , ( "graph", isPrint &&& (not.) isSpace ) - , ( "lower", isLower ) - , ( "print", isPrint ) - , ( "punct", isSymbol ) - , ( "space", isSpace ) - , ( "upper", isUpper ) - , ( "xdigit", isHexDigit ) + ( "alnum" , isAlphaNum ) + , ( "alpha" , isAlpha ) + , ( "blank" , isSpace ) + , ( "cntrl" , isControl ) + , ( "digit" , isDigit ) + , ( "graph" , isPrint &&& (not.) isSpace ) + , ( "lower" , isLower ) + , ( "print" , isPrint ) + , ( "punct" , isSymbol ) + , ( "space" , isSpace ) + , ( "upper" , isUpper ) + , ( "xdigit", isHexDigit ) ] + +isWord :: Char -> Bool +isWord = isAlphaNum ||| (=='_') regexOr :: [[RegexAction]] -> RegexAction regexOr = head . foldr1 (\ra1 ra2 -> [RegexOr ra1 ra2]) diff --git a/Hidden/TestMain.hs b/Hidden/TestMain.hs --- a/Hidden/TestMain.hs +++ b/Hidden/TestMain.hs @@ -12,10 +12,13 @@ main = runTestTT $ test suite suite :: [ Test ] -suite = ["base" ~: testBase] +suite = [ + "base1" ~: testBase1 + , "base2" ~: testBase2 + ] -testBase :: [ Test ] -testBase = [ +testBase1, testBase2 :: [ Test ] +testBase1 = [ Just ( ("" , ("", "" )), [] ) ~=? matchRegexPR "" "" , Just ( ("" , ("", "abcde" )), [] ) ~=? matchRegexPR "" "abcde" , Just ( ("a", ("", "" )), [] ) ~=? matchRegexPR "." "a" @@ -55,7 +58,9 @@ , Nothing ~=? matchRegexPR "cde$" "abcdefg" , Just ( ("abc", ("", "defg")), [] ) ~=? matchRegexPR "^abc" "abcdefg" , Just ( ("abc", ("def\n", "")), [] ) ~=? matchRegexPR "^abc" "def\nabc" - , Just ( ("abcd", ("", "e")), [(1,"abc")] ) + ] +testBase2 = [ + Just ( ("abcd", ("", "e")), [(1,"abc")] ) ~=? matchRegexPR "(abc(?=de))d" "abcde" , Just ( ("def", ("abc", "")), [] ) ~=? matchRegexPR "(?<=abc)def" "abcdef" , Just ( ("aaaa", ("b", "cd")), [] ) ~=? matchRegexPR "a+" "baaaacd" @@ -179,7 +184,23 @@ , Just ( ("ab", (" \t\f", "\n\r ")), [] ) ~=? matchRegexPR "[^ \f\n\r\t]+" " \t\fab\n\r " - , Just ( ("a^[b]", ("c", "kk")), [] ) ~=? matchRegexPR "[[\\]^ab]+" "ca^[b]kk" + , Just ( ("a^[b]", ("c", "kk")), [] ) ~=? matchRegexPR "[][^ab]+" "ca^[b]kk" , Just ( ("flag =\t1", ("", "")), [] ) ~=? matchRegexPR "flag[ \t]*=[ \t]*\\w" "flag =\t1" + , Just ( (", <>-!:#@\n_\f\r\t=", ("", "")), [] ) + ~=? + matchRegexPR ", <>-!:#@\n_\f\r\t=" ", <>-!:#@\n_\f\r\t=" + , Just ( ("/usr/bin/env", ("#!", " runhaskell")), [] ) + ~=? + matchRegexPR "/usr/bin/env" "#!/usr/bin/env runhaskell" + , Just ( ("-100.5", ("", "")), [] ) ~=? + matchRegexPR "[-+]?\\d+\\.\\d+" "-100.5" + , "abc defabc defghiabc " ~=? + gsubRegexPR "abc" "\\0 " "abcdefabcdefghiabc" + , "ca1at ha1at da1ad" ~=? + gsubRegexPR "((((((((((a))))))))))" "\\{10}1\\{10}" "cat hat dad" + , "Is a b? No, a is not b" ~=? + gsubRegexPR "c(a)t|(b)ad" "\\+" "Is cat bad? No, cat is not bad" + , "aababcabcdabcdeabcdefabcdefg" ~=? gsubRegexPR "." "\\`" "abcdefgh" + , "bcdefghcdefghdefghefghfghghh" ~=? gsubRegexPR "." "\\'" "abcdefgh" ] diff --git a/Hidden/Tools.hs b/Hidden/Tools.hs --- a/Hidden/Tools.hs +++ b/Hidden/Tools.hs @@ -22,14 +22,17 @@ , skipRet , (>..>) , ignoreCase +, ifM +, applyIf +, headOrErr ) where -import Data.Char ( isAlphaNum, isSpace, isPrint, ord, toUpper, toLower ) +import Data.Char ( ord, toUpper, toLower ) import Data.Bits ( (.&.), shiftL ) import Control.Monad ( MonadPlus, guard ) isSymbol :: Char -> Bool -isSymbol = (not . isAlphaNum) &&& (not . isSpace) &&& isPrint +isSymbol = flip elem "!\"#$%&'()*+,-./:;<=>?@[\\]^_'{|}~" modifyFst :: (a -> c) -> (a, b) -> (c, b) modifyFst f (x, y) = (f x, y) @@ -76,3 +79,16 @@ ignoreCase :: (Char -> Bool) -> Char -> Bool ignoreCase p c = p (toLower c) || p (toUpper c) + +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM p mt me = do b <- p + if b then mt + else me + +applyIf :: Bool -> (a -> a) -> a -> a +applyIf True f = f +applyIf False _ = id + +headOrErr :: String -> [a] -> a +headOrErr err [] = error err +headOrErr _ (x:_) = x diff --git a/Text/RegexPR.hs b/Text/RegexPR.hs --- a/Text/RegexPR.hs +++ b/Text/RegexPR.hs @@ -6,8 +6,9 @@ module Text.RegexPR ( matchRegexPR , gmatchRegexPR -- EXPERIMENTAL -, gsubRegexPR , subRegexPR +, gsubRegexPR +, splitRegexPR ) where import Hidden.RegexPRCore ( matchRegexPRVerbose ) @@ -59,11 +60,19 @@ subBackRef :: ((String, String, (String, String)), MatchList) -> String -> String -subBackRef (_, _) "" = "" -subBackRef al@(_, ml) ('\\':str) - = maybe "" id (lookup (read $ takeWhile isDigit str) ml) - ++ - subBackRef al ( case dropWhile isDigit str of - ';':rest -> rest - rest -> rest ) -subBackRef al (c:cs) = c : subBackRef al cs +subBackRef (_, _) "" = "" +subBackRef al@((_, match, (hasRead,post)), ml) ('\\':str@(c:rest)) + | elem c "&0" = match ++ subBackRef al rest + | c == '`' = reverse (drop (length match) hasRead) ++ subBackRef al rest + | c == '\'' = post ++ subBackRef al rest + | c == '+' = snd (head ml) ++ subBackRef al rest + | c == '{' = maybe "" id (lookup (read $ takeWhile (/='}') rest) ml) ++ + subBackRef al (tail $ dropWhile (/='}') str) + | otherwise = maybe "" id (lookup (read $ takeWhile isDigit str) ml) ++ + subBackRef al (dropWhile isDigit str) +subBackRef al (c:cs) = c : subBackRef al cs + +splitRegexPR :: String -> String -> [String] +splitRegexPR reg str + = let gmatched = gmatchRegexPR reg str + in map (fst.snd.fst) gmatched ++ [(snd.snd.fst.last) gmatched] diff --git a/regexpr.cabal b/regexpr.cabal --- a/regexpr.cabal +++ b/regexpr.cabal @@ -1,5 +1,5 @@ Name: regexpr -Version: 0.2.6 +Version: 0.2.8 License: GPL License-File: LICENSE Author: Yoshikuni Jujo