module HandleMain where

import Regexp
import HandleExtra
import HandlePattern
import Re2hsBasics
import HandleRe2hs

re2hsrepl :: String	-- an re2hs program
          -> String	-- a basic Haskell program equivalent

re2hsrepl xs = 
            let 
              doMain x preorg prenew inp = 
               case parseMain x preorg "" inp of 
                 (xs,NONE) -> prenew ++ xs
                 ([],RPAT org bef wh aft _ _ _ _ ) -> 
                     error ("unexpected re2hs pattern, line:" ++ show (numLines org +1)++"\n")
                 ([],DEF org bef wh aft nnew) ->
                     doMain nnew (org++wh) (prenew++bef++wh) aft
           in 
              doMain 1 "" "" xs

data CASE = 
            NONE

          | RPAT String -- all the original code before this pattern
                 String -- all the new code before this pattern
                 String -- the whole pattern
                 String -- everything after the pattern
                 String -- the name of the pattern
                 String -- the regexp
                 String -- the flags
                 Int	-- a numerical tag to distinguish this case expression

          | DEF String -- all the original code before this pattern
                String -- all the new code before this pattern
                String -- the pattern, of "_ ->" form
                String -- everything after the pattern
                Int    -- a numerical tag to distinguish this case expression


parseMain :: Int	-- the numerical tag to distinguish latest re2hs expression 
          -> String	-- all of the original code that would appear before this point
          -> String	-- all of the new code to appear before this point
          -> String	-- everything after current point
          -> (String,   -- the new code
	      CASE)     -- or if we've found part of a case
			-- expression, what remains of that

parseMain numnow orig bef inp =
  let
       n = numLines orig + 1
  in
	let
        matchResult1 =  searchExtS (" 1m@((?Multi_Line)--.*$(?Default_Line,Case_Sensitive))| 2m@(\"(?Default_Line,Case_Sensitive))| 3m@(\\{-(?Default_Line,Case_Sensitive))| 4m@(\\bcase\\b(?Default_Line,Case_Sensitive))| 5m1@((\\b name@(\\w+)\\@)?\\<\\/(?Default_Line,Case_Sensitive))| 6m1@(\\bsubst\\b(?Default_Line,Case_Sensitive))| 7m@(\\b_\\b(?Default_Line,Case_Sensitive))") [][][]
             inp 
        in
        if (matchedSubexp matchResult1 "1m") then
        let
          m = wholeMatch matchResult1
          m_before_ = beforeMatch matchResult1
          m_after_ = afterMatch matchResult1
        in
                                   
                      parseMain numnow (orig++m_before_++m) 
                                (bef++m_before_++m) m_after_

		
        else if (matchedSubexp matchResult1 "2m") then
        let
          m = wholeMatch matchResult1
          m_before_ = beforeMatch matchResult1
          m_after_ = afterMatch matchResult1
        in
                        
                    let origtext = orig ++ m_before_ ++ m
                        x = numLines origtext +1
                        text = bef++m_before_++m
                    in
		      case finishString x "" m_after_ of
                        (m,a) -> parseMain numnow (origtext++m) (text++m) a
    

		
        else if (matchedSubexp matchResult1 "3m") then
        let
          m = wholeMatch matchResult1
          m_before_ = beforeMatch matchResult1
          m_after_ = afterMatch matchResult1
        in
                        
		     let origtext = orig ++ m_before_ ++ m
                         x = numLines origtext +1
                         text = bef++m_before_++m
		     in
		       case doNest x m_after_ of
		         (m,a) -> parseMain numnow (origtext++m) (text++m) a

              	
        else if (matchedSubexp matchResult1 "4m") then
        let
          m = wholeMatch matchResult1
          m_before_ = beforeMatch matchResult1
          m_after_ = afterMatch matchResult1
        in
                       
                       let origtext = orig ++ m_before_ ++ m
                           befpat1 = m
                           x = numLines origtext + 1
                       in
                         case list x m_after_ of
                          (Just (lst,'o':'f':afterlist)) -> 
                           let origtext1 = origtext ++ lst ++ "of"
                               x1 = x + numLines lst
                               befpat2 = befpat1 ++ lst ++ "of"
      
                           in
                            case others x1 afterlist of
                             (Just (om,afterjunk)) -> 
                              let origtext2 = origtext1 ++ om    
                                  x2 = x1 + numLines om 
                                  befpat = befpat2 ++ om
                              in
                               let
                               matchResult1 =  searchExtS (" 1pattern@((?Multi_Line)\\A(\\b name@(\\w+)\\@)?\\<\\/ re@((--.*$|\\\\\\\\\\\\\\\\|\\\\\\\\.|\\\\[\\d\\w\"\\\\\'&]|[^\\/])*)\\/ flags@(.*?)\\>(?Default_Line,Case_Sensitive))") [][][]
                                    afterjunk 
                               in
                               if (matchedSubexp matchResult1 "1pattern") then
                               let
                                 pattern = wholeMatch matchResult1
                                 pattern_before_ = beforeMatch matchResult1
                                 pattern_after_ = afterMatch matchResult1
                                 name = subexpMatch matchResult1 "name"
                                 re = subexpMatch matchResult1 "re"
                                 flags = subexpMatch matchResult1 "flags"
                               in
                                   
                                 let origtext3 = origtext2 ++ pattern
                                     x3 = x2 + numLines pattern
                                 in
                                   case others x3 pattern_after_ of
                                    (Just (om,'-':'>':a)) ->
 
                                      case (parse_re2hs_case lst name re flags 

                                            (orig++m_before_) befpat (befpat++pattern++om++"->") a numnow )
                                      of
                                        (newcode,newpre,newafter,numnew) ->
                                          parseMain numnew newpre (bef++m_before_++newcode) newafter

                                    _ -> error ("error in case expression: line " ++ show x3++"\n")  
                                
                               else -- if not (matchedAny matchResult1) then
                                 
                                 parseMain numnow origtext2 (bef ++ m_before_ ++ befpat) afterjunk 

		
        else if (matchedSubexp matchResult1 "5m1") then
        let
          m1 = wholeMatch matchResult1
          m1_before_ = beforeMatch matchResult1
          m1_after_ = afterMatch matchResult1
          name = subexpMatch matchResult1 "name"
        in
                        
                  let origt1 = orig ++ m1_before_ ++ m1
                  in
                   let
                   matchResult1 =  searchExtS (" 1m@((?Multi_Line)\\A re@((--.*$|\\\\\\\\\\\\\\\\|\\\\\\\\.|\\\\[\\d\\w\"\\\\\'&]|[^\\/])*)\\/ flags@(.*?)\\>(?Default_Line,Case_Sensitive))") [][][]
                        m1_after_ 
                   in
                   if (matchedSubexp matchResult1 "1m") then
                   let
                     m = wholeMatch matchResult1
                     m_before_ = beforeMatch matchResult1
                     m_after_ = afterMatch matchResult1
                     re = subexpMatch matchResult1 "re"
                     flags = subexpMatch matchResult1 "flags"
                   in
                               
                     let origtext = origt1 ++ m
                         x = numLines origtext + 1
                     in
                      case others x m_after_ of
                       (Just (om,'=':a)) ->
		        parseMain (numnow+1) (origtext++om++"=")  
                         (bef++ m1_before_ ++ 
                          parse_re2hs_simple name re flags 
                                           (orig++m1_before_) (m1++m++om++"=") numnow)
                          a

                       (Just (om,'-':'>':a)) ->
		         ([],
                          RPAT (orig++m1_before_) (bef++m1_before_) (m1++m++om++"->") a 
                             name re flags numnow)

                       _ -> error ("re2hs pattern in illegal position: line "
                                   ++ show x++"\n")

                    
                   else -- if not (matchedAny matchResult1) then
                     error ("illegal re2hs pattern: line "++ show (numLines origt1)++"\n")                 

		
        else if (matchedSubexp matchResult1 "6m1") then
        let
          m1 = wholeMatch matchResult1
          m1_before_ = beforeMatch matchResult1
          m1_after_ = afterMatch matchResult1
        in
                       
                   let origtext = orig ++ m1_before_ ++ m1
                       x1 = numLines origtext + 1 
                   in
                   let
                   matchResult1 =  searchExtS (" 1m@((?Multi_Line)\\A<<1>>(\\b name@(\\w+)\\@)?\\<\\/ re@((\\\\\\\\\\\\\\\\|\\\\\\\\.|\\\\[\\d\\w\"\\\\\'&]|[^\\/]|--.*$)*)\\/ repl@((\\\\\\\\\\\\\\\\|\\\\\\\\.|\\\\[\\d\\w\"\\\\\'&]|[^\\/]|--.*$)*)\\/ flags@(.*?)\\>(?Default_Line,Case_Sensitive))") [][others x1][]
                        m1_after_ 
                   in
                   if (matchedSubexp matchResult1 "1m") then
                   let
                     m = wholeMatch matchResult1
                     m_before_ = beforeMatch matchResult1
                     m_after_ = afterMatch matchResult1
                     name = subexpMatch matchResult1 "name"
                     re = subexpMatch matchResult1 "re"
                     repl = subexpMatch matchResult1 "repl"
                     flags = subexpMatch matchResult1 "flags"
                   in
                                        
		         parseMain (numnow+1) (orig++m1_before_++m1++m)  
                          (bef++ m1_before_ ++ 
                          parse_re2hs_subst name re repl flags 
                                          (orig++m1_before_) (m1++m) numnow)
                          m_after_

                     
                   else -- if not (matchedAny matchResult1) then
                      parseMain numnow (orig++m1_before_++m1) 
                                      (bef++m1_before_++m1) m1_after_

                
        else if (matchedSubexp matchResult1 "7m") then
        let
          m = wholeMatch matchResult1
          m_before_ = beforeMatch matchResult1
          m_after_ = afterMatch matchResult1
        in
                       
                    let
                        origtext = orig ++ m_before_ ++ m
                        x = numLines origtext + 1
                    in
                     case others x m_after_ of 
                      (Just (om,'-':'>':a)) -> 		
	                ([],DEF (orig++m_before_) (bef++m_before_) (m++om++"->") a numnow)


                      _ -> parseMain numnow (orig++m_before_++m) 
                                     (bef++m_before_++m) m_after_

		
        else -- if not (matchedAny matchResult1) then
                 (bef ++ inp, NONE)









parse_re2hs_case :: String      -- the list to match against 
                 -> String      -- the name for the first pattern
                 -> String      -- the regexp of the first pattern
                 -> String      -- the flags to go with the first pattern
                 -> String      -- all original code before the case expression
                 -> String      -- all code from the word case to the
                                -- pattern, with this we can tell how
                                -- far the pattern was indented, 
                                -- to allow the layout rule to work
                 -> String      -- the whole of  "case list of ...</../>->"
                 -> String      -- everything after the pattern
                 -> Int         -- the label to use to distinguish
                                -- this expression
                 -> (String,    -- the new code
                     String,    -- all original code before last point
                     String,    -- code left still to parse
                     Int)       -- the next label to use for matchResult
 
parse_re2hs_case list name re flags before befpat whole after numnow =
  let   l = indent text         -- how far this pattern is indented
        text = before++befpat
        doit nnow pre b xs = 
                  case parseMain nnow pre "" xs of 
                        (new,NONE) -> [CODE "" (b++new)] -- got through rest of code
                                                         -- what's in orig code ceases 
                                                         -- to be important
 
                        ([],RPAT org bef wh aft name re flags nnew) -> -- found another </../> ->
                                if indent org == l then -- one of ours
                                  (CODE org (b++bef)):(PAT name re flags wh):doit nnew (org++wh) "" aft
                                else if indent org > l then  -- inner one, error  
                                       error ("unexpected re2hs pattern, line:"
                                         ++ show (numLines org +1)++"\n")
 
                                else -- belongs to outer one so we've finished in here
                                  [CODE org (b++bef),AFTER nnew (wh++aft)]
 
                        ([],DEF org bef wh aft nnew) -> -- got a _ -> default case
                                if indent org == l then -- one of ours
                                  [(CODE org (b++bef)),(ELSE wh),AFTER nnew aft]
                                else if indent org > l then -- inner one but 
                                                            -- not necessarily an re2hs one
                                  doit nnew (org++wh) (b++bef++wh) aft
                                  
                                else -- outer one so die now
                                  [CODE org (b++bef),AFTER nnew (wh++aft)]
 
  in 
         -- turn the whole case expression into basic library code
 
         handleCase numnow list before (PAT name re flags whole : doit numnow (before++whole) "" after)
 
