module Main where

import Data.List (dropWhile)
import Data.Char (isSpace)
import System.IO (hFlush, readFile, stdout)
import System.Environment (getArgs)
import Control.Monad.List (runListT)

import ParseTree
import Lexer
import Parser

import Automaton
import Eval
import Complement
import Tupling
import Updatability

parseProgram :: String -> Either String (ParseTree AlexPosn)
parseProgram s = do
  tokens <- scanTokens s
  prog   <- parseProg tokens
  return $ prog 

parseExpression :: String -> Either String (SymbolTree AlexPosn)
parseExpression s = do
  tokens <- scanTokens s 
  exp    <- parseExp tokens
  return $ exp

data Directive 
    = LoadFile String -- Load View Definition Functions
    | Quit            -- Quit System
    | OSource  String -- Set original source
    | Evaluate String -- Evaluation for debuging 
    | Reflect  String -- Backward Transformation of View

dprefix = ':'

parseline s = 
    let s' = dropWhile isSpace s 
    in case s' of 
         prefix:'q':'u':'i':'t':rs | prefix == dprefix ->
               Quit 
         prefix:'q':rs | prefix == dprefix -> 
               Quit
         prefix:'l':'o':'a':'d':rs | prefix == dprefix ->
               LoadFile (dropWhile isSpace rs)
         prefix:'l':rs | prefix == dprefix ->
               LoadFile (dropWhile isSpace rs)
         prefix:'r':'e':'f':'l':'e':'c':'t':rs | prefix == dprefix ->
               Reflect rs 
         prefix:'r':rs | prefix == dprefix ->
               Reflect rs
         _ ->
             Evaluate s'
      

evaluate_command (p@(pt,pt_compl,pt_tuple,pt_inv)) command = 
    case command of 
      Quit ->
          return ()
      LoadFile l ->
          do cont <- readFile l
             case (parseProgram $! cont) of 
               Left s -> 
                   do putStr $ show s
                      interactive_input p
               Right t ->
                   do t_cmpl  <- return $ deriveComplement t
--                      putStrLn $ showDeclInfo t
                      t_tuple <- return $ doTupling t t_cmpl
                      t_inv   <- return $ getInverse t_tuple 
                      putStr $take 80 $ "== Original Source " ++ replicate 80 '='
                      putStrLn $show t
                      putStr $take 80 $ "== Derived Complement " ++ replicate 80 '='
                      putStrLn $ show t_cmpl
                      putStr $take 80 $ "== Tupled Functions " ++ replicate 80 '='
                      putStrLn $ show t_tuple
                      putStr $take 80 $ "== Inverted Tupled Functions " ++ replicate 80 '='
                      putStrLn $ show t_inv 
                      interactive_input (t,t_cmpl,t_tuple,t_inv)
      Evaluate str ->
          case (dropWhile isSpace str) of 
            [] -> interactive_input p 
            _  ->
                case (parseExpression $! str) of 
                  Left s ->
                      do putStrLn $ show s
                         interactive_input p
                  Right exp ->
                      do val <- return $ evaluate pt exp 
                         case runListT val of 
                           Left s -> 
                               do putStrLn $ show s 
                                  interactive_input p
                           Right v ->
                               do putStrLn $ show v
                                  interactive_input p
      Reflect str ->
          case (parseExpression $! str) of 
            Left s -> putStrLn s >> interactive_input p
            Right (exp@(SNode (Function f a) es)) ->
                case (evalE pt exp) of 
                  Left s -> putStrLn s >> interactive_input p          
                  Right val ->
                      case (evalE (pt_compl++pt) (SNode (Function ('_':f) a) es)) of 
                        Left s -> putStrLn s >> interactive_input p
                        Right cval -> 
                            do putStrLn $ "Current View: "++show val
                               putStrLn $ show $updatabilityChecker pt_tuple ('#':f) cval
                               putStrLn ""
                               putStr "Update To? " >> hFlush stdout
                               ustr <- getLine
                               case (parseevalE pt ustr) of 
                                 Left s -> putStrLn s >> interactive_input p
                                 Right uval -> 
                                     let exp' = (SNode (Function ("#"++f++"#Inv") a)
                                                          [uval, cval]) 
                                     in case (evalE pt_inv exp') of 
                                          Left  s  -> 
                                              do putStrLn ("Update Failed") 
                                                 putStrLn s >> interactive_input p
                                          Right v  ->
                                              do putStrLn ("Update Succeeded: ") 
                                                 putStrLn ("  "++show v) >> interactive_input p
            Right _ ->
                do putStrLn "Function is Required"
                   interactive_input p 
    where parseevalE pt str =
              case (parseExpression $! str) of 
                Right exp ->
                    evalE pt exp
                Left s ->
                    Left s 
          evalE pt exp = 
              case (runListT $ evaluate pt exp) of
                Left s    -> Left s 
                Right [v] -> Right v 
                Right []  -> Left $"Expression \""++show exp++"\" is Undefined"
                Right vs  -> Left $"Fatal: Non-determism is detected"++show vs
              


interactive_input (p@(pt,pt_compl,pt_tuple,pt_inv)) =
    pt `seq` pt_compl `seq` pt_tuple `seq` pt_inv `seq`
    do hFlush stdout  
       putStr "bt> "
       hFlush stdout
       str <- getLine 
       evaluate_command p (parseline $! str) 

main = do 
  args <- getArgs
  case args of
    [] -> 
        interactive_input ([],[],[],[])
    s:_ ->
        evaluate_command ([],[],[],[]) (LoadFile s)

-- main = do 
--    str <- getContents 
--    case (parseProgram $! str) of 
--      Left  s -> putStr $ show s
--      Right t -> do
-- --         putStr $ showDeclInfo t
--          t'  <- return $ deriveComplement t    
--          t'' <- return $ doTupling t t'
--          it  <- return $ getInverse t''
--          putStr $take 80 $ "== Derived Complement " ++ replicate 80 '='
--          putStrLn $ show t'
--          putStr $take 80 $ "== Tupled Functions " ++ replicate 80 '='
--          putStrLn $ show t''
--          putStr $take 80 $ "== Inverted Tupled Functions " ++ replicate 80 '='
--          putStrLn $ show it