regexpr-0.1.5: Hidden/ParseRegexStr.hs

--	ParseRegexStr.hs
--
--	Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--

module Hidden.ParseRegexStr (
  RegexAction(..)
, parseRegexStr
) where

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 $ runRegexSrcParser parseRegexStrParser) .
      (,) []

parseRegexStrParser, parseTokensOr, parseTokens :: RegexSrcParser [RegexAction]
parseRegexStrParser = parseTokensOr >>= endOfInput
parseTokensOr = parseTokens
		`mplus`
                do { ra1 <- parseTokens;
	             token '|';
		     ra2 <- parseTokensOr;
		     return $ [ RegexOr ra1 ra2 ] }
parseTokens = greedyList parseTokenPlus

parseTokenPlus, parseToken, parseAlpha :: 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;
         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 parseAlpha
    `mplus`
    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;
         return $ BackReference $ read $ d1:d2 }
    `mplus`
    do { token '['; isNotNot <- optional (token '^') >>= return . null;
         cl <- parseCharList; token ']';
         return $ Select $ flip (if isNotNot then elem else notElem) cl }
    `mplus`
    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 "(?#"; 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
  = foldr mplus mzero . map (\(t, act) -> tokens ['\\', t] >> return act)

parseParenses ::
  [ (String, [RegexAction] -> RegexAction) ] -> RegexSrcParser RegexAction
parseParenses
  = foldr mplus mzero . map (\(t, act) -> do tokens ('(':t) 
                                             ras <- parseTokensOr
					     token ')'
					     return $ act ras)

parseCharList :: RegexSrcParser String
parseCharList =
  liftM concat $ greedyList
    ((parseChar >>= return . (:[])) `mplus` parseCharArea)
  where parseChar = spot isAlphaNum `mplus` ( token '\\' >> spot isSymbol )
        parseCharArea = do { b <- parseChar; token '-'; e <- parseChar;
			     return [b..e] }