module HandlePattern

where

import Regexp

infixr 9 `thenReM_`, `thenReM`

   
{- RegexpM is a monad to allow information to be stripped from an re2hs pattern
   It is used with both re2hs standard patterns and replace patterns,
   though in the latter case many of it's features are not used.
-}

type RegexpM a =   Int	-- name to use for subexpressions
		-> Int	-- name supply for user defined matcher functions
		-> Int	-- name supply for user defined assertions
		-> [String]	-- user defined matcher functions
		-> [String]	-- user defined assertions
		-> [String]	-- the subexps
		-> (a,		-- the RegexpM thing
		    Int,	-- new name supply for matcher fncts
		    Int,	-- new name supply for assertions
		    [String],	-- new matcher fncts
		    [String],	-- new assertions
		    [String])	-- the subexps

initReM :: (String -> RegexpM String)
                                -- the function to which uses the monad
        -> String		-- the RegexpM pattern
        -> Int			-- name to use for subexps
        -> Int			-- start value for matcher function name supply
        -> Int			-- start value for assertions name supply
        -> (String,		-- the returned RegexpM pattern 
	    [String],		-- all the subexps in the pattern
            [String],		-- all the matcher functs in the pattern
            [String])		-- all the assertions in the pattern

initReM act thing sename mstart astart = 
            case act thing sename mstart astart [] [] [] of
		      (newthing,_,_,mfs,afs,ses) ->
			(newthing, reverse ses, reverse mfs, reverse afs)

returnReM :: a -> RegexpM a
returnReM thing nses nms nas ms as ses
		= (thing,nms,nas,ms,as,ses) 

-- get the prefix name for the subexp, this distinguishes it in re2hs
-- case pattern
getSE :: RegexpM Int
getSE nses nms nas ms as ses
		= (nses,nms,nas,ms,as,ses)

{- get new name for the latest matcher function
-}
getNewMF :: RegexpM Int
getNewMF nses nms nas ms as ses
		= (nms,nms+1,nas,ms,as,ses)

{- get new name for the latest assertion
-}
getNewAS :: RegexpM Int
getNewAS nses nms nas ms as ses
		= (nas,nms,nas+1,ms,as,ses)

{- add a new subexp
-}
updateSES :: String -> RegexpM String
updateSES se nses nms nas ms as ses
		= (se,nms,nas,ms,as,se:ses)

{- add a new matcher function
-}
updateMF :: String -> RegexpM String
updateMF mf nses nms nas ms as ses
		= (mf,nms,nas,mf:ms,as,ses)

{- add a new assertion
-}
updateAS :: String -> RegexpM String
updateAS af nses nms nas ms as ses
		= (af,nms,nas,ms,af:as,ses)

thenReM :: RegexpM a -> (a -> RegexpM b) -> RegexpM b
thenReM act1 act2 nses nms nas ms as ses
		= case act1  nses nms nas ms as ses of
		  (res,newnms,newnas,newms,newas,newses) ->
			act2 res nses newnms newnas newms newas newses

thenReM_ :: RegexpM a -> RegexpM b -> RegexpM b
thenReM_ act1 act2 nses nms nas ms as ses
		= case act1  nses nms nas ms as ses of
		  (_,newnms,newnas,newms,newas,newses) ->
			act2 nses newnms newnas newms newas newses

{- handleReplace - converts an re2hs substitution replacement pattern 
                   into a basic library pattern, stripping out the 
                   necessary information
-}

handleReplace :: String		-- and re2hs replace pattern 
              -> RegexpM String	-- the basic library equivalent

handleReplace repl = let
                     matchResult1 =  searchExtS (" 1m@(\\\\\\\\[^M](?Default_Line,Case_Sensitive))| 2m@(\\s+(?Default_Line,Case_Sensitive))| 3m@((?Multi_Line)--.*$(?Default_Line,Case_Sensitive))| 4m@(\\\\\\\\M ref@(.) name@(\\w+?)${ref}(?Default_Line,Case_Sensitive))| 5m@(\\<\\< fnct@(.*?)\\>\\>(?Default_Line,Case_Sensitive))| 6m@(\\$\\{ refname@(\\w+?)\\}(?Default_Line,Case_Sensitive))") [][][]
                          repl 
                     in
                     if (matchedSubexp matchResult1 "1m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                     in
                              	handleReplace m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ m ++ after)

			
                     else if (matchedSubexp matchResult1 "2m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                     in
                               	handleReplace m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ after)

			
                     else if (matchedSubexp matchResult1 "3m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                     in
                                handleReplace m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ after)

			
                     else if (matchedSubexp matchResult1 "4m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                       ref = subexpMatch matchResult1 "ref"
                       name = subexpMatch matchResult1 "name"
                     in
                              	handleReplace m_after_ `thenReM` \after ->
				returnReM (m_before_ 
					   ++ "\" ++ " ++ name ++ " ++ \"" 
					   ++ after)

			
                     else if (matchedSubexp matchResult1 "5m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                       fnct = subexpMatch matchResult1 "fnct"
                     in
                                handleReplace m_after_ `thenReM` \after ->
				returnReM (m_before_ 
					   ++ "\" ++" ++ fnct ++ "++ \"" 
					   ++ after)
                        
                     else if (matchedSubexp matchResult1 "6m") then
                     let
                       m = wholeMatch matchResult1
                       m_before_ = beforeMatch matchResult1
                       m_after_ = afterMatch matchResult1
                       refname = subexpMatch matchResult1 "refname"
                     in
                               handleReplace m_after_ `thenReM` \after ->
                               returnReM(m_before_ 
					   ++ "\" ++" ++ refname ++ "++ \"" 
					   ++ after)

			
                     else -- if not (matchedAny matchResult1) then
                         returnReM repl

{- handleRegexp - converts an re2hs pattern into a basic library
		  pattern, stripping out the necessary information
-}

handleRegexp :: String		-- an re2hs pattern
             -> RegexpM String	-- info from re2hs pattern

handleRegexp regexp = let
                      matchResult1 =  searchExtS (" 1m@(\\b name@(\\w+)\\@\\((?Default_Line,Case_Sensitive))| 2m@(\\\\\\\\[^M](?Default_Line,Case_Sensitive))| 3m@(\\s+(?Default_Line,Case_Sensitive))| 4m@((?Multi_Line)--.*$(?Default_Line,Case_Sensitive))| 5m@(\\\\\\\\M ref@(.) name@(\\w+?)${ref}(?Default_Line,Case_Sensitive))| 6m@(\\<\\< fnct@(.*?)\\>\\>(?Default_Line,Case_Sensitive))| 7m@(\\(\\?= as@(.*?)\\)(?Default_Line,Case_Sensitive))") [][][]
                           regexp 
                      in
                      if (matchedSubexp matchResult1 "1m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                        name = subexpMatch matchResult1 "name"
                      in
                                getSE `thenReM` \num ->
				updateSES name `thenReM_`
				handleRegexp m_after_ `thenReM` \after ->
                                returnReM (m_before_ ++ " " ++ name 
					   ++ "@(" ++ after)
				-- ensure a space is included at the front
				-- and that all subexp names are different, 
                                -- between different case exps.

			
                      else if (matchedSubexp matchResult1 "2m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                      in
                              	handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ m ++ after)

			
                      else if (matchedSubexp matchResult1 "3m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                      in
                               	handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ after)

			
                      else if (matchedSubexp matchResult1 "4m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                      in
                                handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ ++ after)

			
                      else if (matchedSubexp matchResult1 "5m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                        ref = subexpMatch matchResult1 "ref"
                        name = subexpMatch matchResult1 "name"
                      in
                              	handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ 
					   ++ "\" ++ " ++ name ++ " ++ \"" 
					   ++ after)

			
                      else if (matchedSubexp matchResult1 "6m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                        fnct = subexpMatch matchResult1 "fnct"
                      in
                              	
				getNewMF `thenReM` \name ->
				updateMF fnct `thenReM_`
				handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ 
					   ++ "<<" ++ (show name) ++ ">>" 
					   ++ after)

			
                      else if (matchedSubexp matchResult1 "7m") then
                      let
                        m = wholeMatch matchResult1
                        m_before_ = beforeMatch matchResult1
                        m_after_ = afterMatch matchResult1
                        as = subexpMatch matchResult1 "as"
                      in
                              	
				getNewAS `thenReM` \name ->
				updateAS as `thenReM_`
				handleRegexp m_after_ `thenReM` \after ->
				returnReM (m_before_ 
					   ++ "(?=" ++ (show name) ++ ")" 
					   ++ after)
			
			
                      else -- if not (matchedAny matchResult1) then
                         returnReM regexp




       





