{-- ---------------------------------------------------------------------------
 --
 -- A daemonized version of Xcerpt listening on a network socket for
 -- requests to be evaluated.
 -- 
 -- ---------------------------------------------------------------------------}

module Main where


import Network

import Data.Char (isAlphaNum,isSpace,toUpper,toLower)
import System (getArgs)
import System.Exit
import System.IO (hGetLine,hPutStrLn,hFlush,hClose,Handle)
import System.Console.GetOpt

import Control.Concurrent (forkIO)


import Xcerpt.Data.Term
import Xcerpt.Data.Program
import Xcerpt.Data.Formula

import Xcerpt.Parser.XcerptV2 (parseProgram,parseGoal,parseTerm) 
-- RA: was Xcerpt.Parser.Xcerpt which is V1
-- RA: assume V1 no longer needed, since Xcerpt.Engine.* seem to be gone
import Xcerpt.Parser.XML          (parseProgramXML,parseXML)
#ifdef __EngineNG__
import Xcerpt.EngineNG.Solver       (solve, solveCS)
import Xcerpt.EngineNG.Program      (evalQuery,runProgram,hRunProgram, RunDesc(..))
-- RA: did not include RunDesc which is needed to call hRunProgram
-- RA: and included evalQueryCompat which is not defined in Xcerpt.EngineNG.Program
import Xcerpt.EngineNG.Substitution (getSubstitutions,Substitution,showSubstitutions)
import Xcerpt.EngineNG.Matrix
#else
import Xcerpt.Engine.Solver       (solve)
import Xcerpt.Engine.Program      (evalQuery,hRunProgram)
import Xcerpt.Engine.Substitution (getSubstitutions,Substitution,showSubstitutions)
import Xcerpt.Engine.Matrix
#endif

import Xcerpt.Show.Xcerpt         (showXcerpt)
import Xcerpt.Show.XML            (showXML)

import Xcerpt.Misc
import Xcerpt.Version        (version, versions)


port = 15003


-- data structure is not used at the moment, evaluation is done with parsing
data Protocol = Execute Program         -- EXECUTE (finish with ".")
	      | XcerptP2XML Program     -- convert a program in Xcerpt syntax to XML syntax
	      | XMLP2Xcerpt Program     -- convert a program in XML syntax to Xcerpt syntax
	      | Xcerpt2XML Term         -- convert a term in Xcerpt syntax to XML syntax
	      | XML2Xcerpt Term         -- convert a term in XML syntax to Xcerpt syntax
	      | XcerptValidateP String  -- check whether a string is a syntactically valid program
	      | XMLValidateP String     -- check whether a string is a syntactically valid program
	      | Validate String         -- check whether a String is a syntactically valid term
	      | Quit                    -- QUIT



initSocket = listenOn 


handleConnections :: Socket -> IO ()
handleConnections s = do (handle,host,port) <- accept s
			 forkIO $ do putStrLn ("Accepted connection from "++host++", port "++(show port))
				     hPutStrLn handle ("WELCOME to the Xcerpt Daemon (version "++version++").")
				     hFlush handle
				     handleProtocol handle
			 handleConnections s			 
			 

handleProtocol :: Handle -> IO ()
handleProtocol h = do hPutStrLn h ("READY. Awaiting your input.")
		      hFlush h
		      line <- hGetLine h
		      case (span (not . isSpace) $ map toUpper $ line) 
			   of
			   ("EXECUTE",_) -> do rest <- recvRest h					       
					       putStrLn ("Evaluating Program ...")
					       hPutStrLn h ("RESULT. Program evaluation result follows:")
					       hRunProgram (RunDesc h "xcerpt" False) (parseProgram rest) []
					       -- RA: call to hRunProgram was outdated, missing
					       -- RA: RunDesc and pars (empty, no real support)
					       hPutStrLn h ("END.")
					       hFlush h
					       handleProtocol h

			   ("XCERPT2XML",_)  -> do rest <- recvRest h
						   hPutStrLn h ("RESULT. Conversion (Xcerpt -> XML) result follows:")
						   hPutStrLn h $ showXML $ parseTerm rest
						   hPutStrLn h ("END.")
						   hFlush h
						   handleProtocol h

			   ("XCERPTP2XML",_) -> do rest <- recvRest h
						   hPutStrLn h ("RESULT. Program conversion (Xcerpt -> XML) result follows:")
						   hPutStrLn h $ showXML $ parseProgram rest
						   hPutStrLn h ("END.")
						   hFlush h
						   handleProtocol h


			   ("XML2XCERPT",_)  -> do rest <- recvRest h
						   hPutStrLn h ("RESULT. Conversion (XML -> Xcerpt) result follows:")
						   hPutStrLn h $ showXcerpt $ parseXML rest
						   hPutStrLn h ("END.")
						   hFlush h
						   handleProtocol h


			   ("XMLP2XCERPT",_) -> do rest <- recvRest h
						   hPutStrLn h ("RESULT. Program conversion (XML -> Xcerpt) result follows:")
						   hPutStrLn h $ showXcerpt $ parseProgramXML rest
						   hPutStrLn h ("END.")
						   hFlush h
						   handleProtocol h

			   ("XCERPTVALIDATEP",_) -> do rest <- recvRest h
						       hPutStrLn h ("ERROR. Not implemented.")
						       hFlush h
						       handleProtocol h

			   ("XMLVALIDATEP",_)    -> do rest <- recvRest h
						       hPutStrLn h ("ERROR. Not implemented.")
						       hFlush h
						       handleProtocol h


			   ("XCERPTVALIDATE",_)  -> do rest <- recvRest h
						       hPutStrLn h ("ERROR. Not implemented.")
						       hFlush h
						       handleProtocol h


			   ("QUIT",_)    -> do hPutStrLn h ("BYE BYE.")
					       hClose h
					       return ()


recvRest :: Handle -> IO String
recvRest = recvRest' ""
    where recvRest' s h = do l <- hGetLine h
			     case span (not . isSpace) l of
				    (".",_)   -> do hPutStrLn h "OK. Input Received."
				                    hFlush h
				                    return s
				    ("END.",_) -> do hPutStrLn h "OK. Input Received."
				                     -- RA: was END, conflicted with Xcerpt syntax
				                     -- RA: (END terminates rules and goals)
				                     hFlush h
				                     return s
				    _         -> recvRest' (s++"\n"++l) h


getPort :: [String] -> PortID
getPort [] = PortNumber port
getPort (arg:[]) = PortNumber (fromInteger (read arg))
getPort _ = error ("usage: xcerptd [PortNumber defaults to "++(show port)++")]")

main = withSocketsDo $ do args <- getArgs
			  socket <- initSocket (getPort args)
			  (PortNumber p) <- socketPort socket
			  putStrLn versions
			  putStrLn ("Initialized daemon, now accepting connections on port "++(show p))
			  handleConnections socket
			  return ()