diff --git a/Hidden/ParseLib.hs b/Hidden/ParseLib.hs --- a/Hidden/ParseLib.hs +++ b/Hidden/ParseLib.hs @@ -30,9 +30,9 @@ import Hidden.ParseLibCore ( Parse(runParse), MonadParse(..), MonadPlus(..) ) import Control.Monad( replicateM ) --- --- token t recognises t as the first value in the input. --- +-- +-- token t recognises t as the first value in the input. +-- token, tokenBack :: (Eq a, MonadParse a m) => a -> m a token x = spot (==x) tokenBack x = spotBack (==x) @@ -46,18 +46,18 @@ repeatParse, greedyRepeatParse :: MonadPlus m => Int -> Maybe Int -> m b -> m [b] -repeatParse min (Just max) p - | min == max = replicateM min p - | min < max = replicateM min p `mplus` - (p >:> repeatParse min (Just $ max - 1) p) -repeatParse min Nothing p - = replicateM min p `mplus` (p >:> repeatParse min Nothing p) -greedyRepeatParse min (Just max) p - | min == max = replicateM min p - | min < max = (p >:> greedyRepeatParse min (Just $ max - 1) p) `mplus` - replicateM min p -greedyRepeatParse min Nothing p - = (p >:> greedyRepeatParse min Nothing p) `mplus` replicateM min p +repeatParse mn (Just mx) p + | mn == mx = replicateM mn p + | mn < mx = replicateM mn p `mplus` + (p >:> repeatParse mn (Just $ mx - 1) p) +repeatParse mn Nothing p + = replicateM mn p `mplus` (p >:> repeatParse mn Nothing p) +greedyRepeatParse mn (Just mx) p + | mn == mx = replicateM mn p + | mn < mx = (p >:> greedyRepeatParse mn (Just $ mx - 1) p) `mplus` + replicateM mn p +greedyRepeatParse mn Nothing p + = (p >:> greedyRepeatParse mn Nothing p) `mplus` replicateM mn p optional, greedyOptional :: MonadPlus m => m a -> m [a] optional = repeatParse 0 (Just 1) diff --git a/Hidden/ParseLibCore.hs b/Hidden/ParseLibCore.hs --- a/Hidden/ParseLibCore.hs +++ b/Hidden/ParseLibCore.hs @@ -64,13 +64,13 @@ spt p (pre,(x:xs)) | p x = [(x,(x:pre,xs))] | otherwise = [] - spt p (_,[]) = [] + spt _ (_,[]) = [] spotBack = Parse . sptbck where sptbck p ((x:xs),post) | p x = [(x,(xs,x:post))] | otherwise = [] - sptbck p ([],_) = [] + sptbck _ ([],_) = [] still p = Parse $ \inp -> do (ret,_) <- runParse p inp return (ret,inp) parseNot x (Parse p) = Parse $ \inp -> case p inp of @@ -80,7 +80,7 @@ instance Monad (Parse a) where return = Parse . \val inp -> [(val,inp)] - (Parse pr) >>= f + (Parse pr) >>= f = Parse (\st -> concat [ runParse (f a) rest | (a,rest) <- pr st ]) instance MonadPlus (Parse a) where diff --git a/Hidden/ParseRegexStr.hs b/Hidden/ParseRegexStr.hs --- a/Hidden/ParseRegexStr.hs +++ b/Hidden/ParseRegexStr.hs @@ -9,13 +9,12 @@ ) where import Hidden.RegexPRTypes ( RegexSrcParser, runRegexSrcParser, - RegexAction(..), reverseRegexAction, + RegexAction(..), getBR, modifyBR, setMode, isModeI, isModeM, isModeX ) -import Hidden.ParseLib ( runParse, spot, token, mplus, mzero, token, tokens, +import Hidden.ParseLib ( runParse, spot, mplus, mzero, token, tokens, list, greedyList, optional, endOfInput ) -import Control.Monad.State ( liftM ) -import Hidden.Tools ( isSymbol, (|||), isBit7On, bifurcate, cat2funcL, +import Hidden.Tools ( isSymbol, isBit7On, bifurcate, cat2funcL, modifySnd, skipRet, (>..>) ) import Data.Char ( isAlphaNum, isAlpha, isDigit, isSpace, toUpper, toLower ) @@ -42,16 +41,16 @@ parseQuantifier :: RegexSrcParser (RegexAction -> RegexAction) parseQuantifier = do { token '{'; - min <- list $ spot isDigit; - max <- do { cma <- optional $ token ','; + mn <- list $ spot isDigit; + mx <- 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 min) $ - case max of - Nothing -> Just $ read min + return $ (if nd then Repeat else RepeatNotGreedy) (read mn) $ + case mx of + Nothing -> Just $ read mn Just "" -> Nothing Just n -> Just $ read n } diff --git a/Hidden/RegexPRCore.hs b/Hidden/RegexPRCore.hs --- a/Hidden/RegexPRCore.hs +++ b/Hidden/RegexPRCore.hs @@ -1,6 +1,6 @@ --- RegexPRCore.hs +-- RegexPRCore.hs -- --- Author: Yoshikuni Jujo +-- Author: Yoshikuni Jujo -- module Hidden.RegexPRCore ( @@ -12,12 +12,12 @@ build, tokens, tokensBack, repeatParse, greedyRepeatParse, beginningOfInput, endOfInput, - MonadPlus(..), (>++>), (>:>) ) + MonadPlus(..), (>++>) ) import Hidden.ParseRegexStr ( RegexAction(..), parseRegexStr ) import Control.Monad.State ( StateT, runStateT, gets, modify, lift, liftM ) import Control.Monad.Reader( ask ) import Hidden.Tools ( guardEqual ) -import Control.Monad ( guard, when ) +import Control.Monad ( when ) matchRegexPRVerbose :: String -> (String, String) @@ -25,7 +25,7 @@ matchRegexPRVerbose reg str = case (runRegexParserTrials . mkRegexParserTrials . parseRegexStr) reg str of [] -> Nothing - (((ret, pre), ml), sp):_ -> Just ( (reverse pre, ret, sp), ml ) + (((ret, pre), ml), sp):_ -> Just ( (reverse pre, ret, sp), ml ) runRegexParserTrials :: StateT String RegexParser a -> @@ -44,27 +44,27 @@ mkRegexParser isBack (ra:ras) = case ra of Select s -> selectParserFB s - Repeat min max ra -> liftM concat . (greedyRepeatParse min max) $ - mkRegexParser isBack [ra] - RepeatNotGreedy min max ra - -> liftM concat . (repeatParse min max) $ - mkRegexParser isBack [ra] - Note i acts -> noteParens isBack i $ mkRegexParser isBack acts - BackReference ri -> backReference isBack ri - RegexOr ra1 ra2 -> mkRegexParser isBack ra1 `mplus` - mkRegexParser isBack ra2 - EndOfInput -> endOfInput "" - BeginningOfInput -> beginningOfInput "" - Still [Backword acts] - -> still (mkRegexParser True acts) >> - when (not isBack) (modify reverse) >> return "" - Still acts -> still (mkRegexParser False acts) >> return "" - Backword acts -> mkRegexParser True acts - RegActNot acts -> parseNot "" $ mkRegexParser isBack acts - PreMatchPoint -> guardEqual ask (lift ask) >> return "" - Parens acts -> mkRegexParser isBack acts - Comment _ -> return "" - NopRegex -> return "" + Repeat mn mx rb -> liftM concat . (greedyRepeatParse mn mx) $ + mkRegexParser isBack [rb] + RepeatNotGreedy mn mx rb + -> liftM concat . (repeatParse mn mx) $ + mkRegexParser isBack [rb] + Note i acts -> noteParens isBack i $ mkRegexParser isBack acts + BackReference ri -> backReference isBack ri + RegexOr ra1 ra2 -> mkRegexParser isBack ra1 `mplus` + mkRegexParser isBack ra2 + EndOfInput -> endOfInput "" + BeginningOfInput -> beginningOfInput "" + Still [Backword acts] + -> still (mkRegexParser True acts) >> + when (not isBack) (modify reverse) >> return "" + Still acts -> still (mkRegexParser False acts) >> return "" + Backword acts -> mkRegexParser True acts + RegActNot acts -> parseNot "" $ mkRegexParser isBack acts + 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 @@ -75,7 +75,7 @@ noteParens :: Bool -> Int -> RegexParser String -> RegexParser String noteParens isBack i p = do x <- p modify ((i, (if isBack then reverse else id) x):) - return x + return x backReference :: Bool -> Int -> RegexParser String backReference isBack i diff --git a/Hidden/RegexPRTypes.hs b/Hidden/RegexPRTypes.hs --- a/Hidden/RegexPRTypes.hs +++ b/Hidden/RegexPRTypes.hs @@ -37,14 +37,18 @@ runRegexParser point = runParse . flip runStateT [] . flip runReaderT point type RegexSrcParser = StateT (Int, (Bool, Bool, Bool)) (Parse Char) + getBR :: RegexSrcParser Int getBR = gets fst + modifyBR :: (Int -> Int) -> RegexSrcParser () 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 + isModeI, isModeM, isModeX :: RegexSrcParser Bool isModeI = gets $ first . snd isModeM = gets $ second . snd diff --git a/Hidden/TestMain.hs b/Hidden/TestMain.hs --- a/Hidden/TestMain.hs +++ b/Hidden/TestMain.hs @@ -1,20 +1,18 @@ --- TestMain.hs +-- TestMain.hs -- --- Author: Yoshikuni Jujo +-- Author: Yoshikuni Jujo -- module Hidden.TestMain where import Test.HUnit -import Text.RegexPR( matchRegexPR, gsubRegexPR ) +import Text.RegexPR ( matchRegexPR, gsubRegexPR ) --- main :: IO () +main :: IO Counts main = runTestTT $ test suite suite :: [ Test ] -suite = [ - "base" ~: testBase - ] +suite = ["base" ~: testBase] testBase :: [ Test ] testBase = [ diff --git a/Hidden/Tools.hs b/Hidden/Tools.hs --- a/Hidden/Tools.hs +++ b/Hidden/Tools.hs @@ -23,7 +23,6 @@ , (>..>) ) where -import Control.Monad.State( StateT(StateT, runStateT), lift, MonadTrans ) import Data.Char ( isAlphaNum, isSpace, isPrint, ord ) import Data.Bits ( (.&.), shiftL ) import Control.Monad ( MonadPlus, guard ) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,17 +1,4 @@ -import Distribution.Simple(defaultMainWithHooks, defaultUserHooks, - UserHooks(runTests)) -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 +#! /usr/bin/env runhaskell -main = defaultMainWithHooks - defaultUserHooks { runTests = \_ _ _ _ -> Hidden.TestMain.main >> - return ret } +import Distribution.Simple +main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,19 @@ +2008.1.12 Sat. +(?> ) +(?ixm-ixm) +(?ixm-ixm: ) +日本語(UTF-8)対応 + +2008.1.17 Thr. +(? ) +日本語(UTF-8)対応。 diff --git a/Text/RegexPR.hs b/Text/RegexPR.hs --- a/Text/RegexPR.hs +++ b/Text/RegexPR.hs @@ -1,11 +1,12 @@ --- RegexPR.hs +-- RegexPR.hs -- --- Author: Yoshikuni Jujo +-- Author: Yoshikuni Jujo -- module Text.RegexPR ( matchRegexPR , gsubRegexPR +, subRegexPR ) where import Hidden.RegexPRCore ( matchRegexPRVerbose ) @@ -20,8 +21,8 @@ subRegexPR :: String -> String -> String -> String subRegexPR reg sub src = case matchRegexPRVerbose reg ("",src) of - Just all@((pre, ret, sp), ml) -> pre ++ subBackRef all sub ++ snd sp - Nothing -> src + Just al@((pre, _, sp), _) -> pre ++ subBackRef al sub ++ snd sp + Nothing -> src gsubRegexPR :: String -> String -> String -> String gsubRegexPR reg sub src = gsubRegexPRGen Nothing reg sub ("", src) @@ -30,22 +31,22 @@ Maybe (String, String) -> String -> String -> (String, String) -> String gsubRegexPRGen pmp reg sub src = case matchRegexPRVerbose reg src of - Just all@((pre, ret, sp@(~(p,x:xs))), ml) - -> case (pmp, sp) of - (Just (_, ""), _) -> "" - _ | Just sp == pmp -> pre ++ [x] ++ - gsubRegexPRGen (Just sp) reg sub (x:p, xs) - | otherwise -> pre ++ subBackRef all sub ++ - gsubRegexPRGen (Just sp) reg sub sp + Just al@((pre, _, sp@(~(p,x:xs))), _) + -> case (pmp, sp) of + (Just (_, ""), _) -> "" + _ | Just sp == pmp -> pre ++ [x] ++ + gsubRegexPRGen (Just sp) reg sub (x:p, xs) + | otherwise -> pre ++ subBackRef al sub ++ + gsubRegexPRGen (Just sp) reg sub sp Nothing -> snd src subBackRef :: ((String, String, (String, String)), MatchList) -> String -> String -subBackRef all@(_, ml) "" = "" -subBackRef all@(_, ml) ('\\':str) +subBackRef (_, _) "" = "" +subBackRef al@(_, ml) ('\\':str) = maybe "" id (lookup (read $ takeWhile isDigit str) ml) - ++ - subBackRef all ( case dropWhile isDigit str of - ';':rest -> rest - rest -> rest ) -subBackRef all (c:cs) = c : subBackRef all cs + ++ + subBackRef al ( case dropWhile isDigit str of + ';':rest -> rest + rest -> rest ) +subBackRef al (c:cs) = c : subBackRef al cs diff --git a/localConfigure b/localConfigure new file mode 100644 --- /dev/null +++ b/localConfigure @@ -0,0 +1,3 @@ +#!/bin/sh + +runhaskell Setup.hs configure --prefix=$HOME/local --user diff --git a/regexpr.cabal b/regexpr.cabal --- a/regexpr.cabal +++ b/regexpr.cabal @@ -1,27 +1,35 @@ Name: regexpr -Version: 0.2.1 +Version: 0.2.2 License: GPL License-File: LICENSE Author: Yoshikuni Jujo Maintainer: PAF01143@nifty.ne.jp Synopsis: regular expression like Perl/Ruby in Haskell +Description: + Regular expression library like Perl/Ruby's regular expressions. + This package has a module RegexPR. + And RegexPR export functions matchRegexPR and gsubRegexPR. + . + matchRegexPR :: String -> Maybe ((String, (String, String)), [(Int, String)]) + . + gsubRegexPR :: String -> String -> String + . + Examples: + . + matchRegexPR "ab(cde)f\\1" "kkkabcdefcdefgh" => + Just (("abcdefcde", ("kkk", "fgh")),[(1,"cde")]) + . + matchRegexPR "(?<=hij)abc" "kkkabchijabcde" => + Just (("abc",("kkkabchij","de")),[]) + . + gsubRegexPR "\\G(\\d\\d\\d)" "\\1," "123456 789" => "123,456, 789" Category: Text Build-Depends: base, mtl, HUnit -Exposed-modules:Text.RegexPR +Build-Type: Simple +Exposed-modules: Text.RegexPR Other-modules: Hidden.RegexPRTypes, Hidden.Tools, Hidden.ParseLib, Hidden.ParseLibCore, Hidden.RegexPRCore, - Hidden.ParseRegexStr, Hidden.SrcRegActList + Hidden.ParseRegexStr, Hidden.SrcRegActList, Hidden.TestMain -Extensions: -ld-options: -Description: - Regular expression library like Perl/Ruby's regular expression. - This package has a module RegexPR. - And RegexPR export function matchRegexPR and gsubRegexPR. - matchRegexPR :: String -> Maybe ((String, (String, String)), [(Int, String)]), - gsubRegexPR :: String -> String -> String. - Examples: matchRegexPR "ab(cde)f\\1" "kkkabcdefcdefgh" => - Just (("abcdefcde", ("kkk", "fgh")),[(1,"cde")]), - matchRegexPR "(?<=hij)abc" "kkkabchijabcde" => - Just (("abc",("kkkabchij","de")),[]), - gsubRegexPR "\\G(\\d\\d\\d)" "\\1," "123456 789" => "123,456, 789" +Extra-source-files: TODO, localConfigure +ghc-options: -Wall -O2 -optl-Wl,-s