implementation module ExceptionCombinators
/**
* This module contains iTask combinators for Exception Handling
*/
import StdList, StdArray, StdTuple, OSError, File, FilePath, Map, JSON
import Task, TaskContext, ProcessDB, Util

derive class iTask FileException, ParseException, CallException, SharedException, RPCException, OSException, WorkOnException
derive class iTask FileError
derive bimap Maybe,(,)

instance toString FileException
where
	toString (FileException path error) = case error of
		CannotOpen	= "Cannot open file '" +++ path +++ "'"
		CannotClose	= "Cannot close file '" +++ path +++ "'"
		IOError		= "Error reading/writing file '" +++ path +++ "'"
	
instance toString ParseException
where
	toString (CannotParse err) = "Parser error: " +++ err
	
instance toString CallException
where
	toString (CallFailed (_,err)) = "Error calling external process: " +++ err
	
instance toString SharedException
where
	toString (SharedException err) = "Error performing operation on shared:" +++ err
	
instance toString RPCException
where
	toString (RPCException err) = "Error performing RPC call: " +++ err
	
instance toString OSException
where
	toString (OSException (_,err)) = "Error performing OS operation: " +++ err
	
instance toString WorkOnException
where
	toString WorkOnNotFound				= "Error working on process: cannot find process"
	toString WorkOnEvalError			= "Error working on process: evaluation error"
	toString WorkOnDependencyCycle		= "Error working on process: cycle in dependencies detected"
	
try :: !(Task a) (e -> Task a) -> Task a | iTask a & iTask, toString e
try normalTask handlerTaskFun = mkTask (taskMeta normalTask) init edit eval
where
	normalTaskFuncs = taskFuncs normalTask
	
	init taskNr iworld
		# (cxt,iworld)	= normalTaskFuncs.initFun [0:taskNr] iworld
		= (TCTry (Left cxt), iworld)
		
	edit taskNr event context=:(TCTry (Left cxtNormal)) iworld
		= case stepEvent 0 (Just event) of
			Nothing
				= (context, iworld)
			Just event 
				# (newCxtNormal,iworld) = normalTaskFuncs.editFun [0:taskNr] event cxtNormal iworld
				= (TCTry (Left newCxtNormal), iworld)

	edit taskNr event context=:(TCTry (Right (encEx, cxtHandler))) iworld
		= case stepEvent 1 (Just event) of
			Nothing
				= (context, iworld)
			Just event
				= case (fromJSON encEx) of
					Just e
						# handler = taskFuncs (handlerTaskFun e)
						# (newCxtHandler,iworld) = handler.editFun [1:taskNr] event cxtHandler iworld
						= (TCTry (Right (encEx, newCxtHandler)), iworld)
					Nothing
						= (context, iworld)


	//Normal execution still possible
	eval taskNr _ event tuiTaskNr _ _ context=:(TCTry (Left cxtNormal)) iworld
		# (ilayout,playout)	= taskLayouters normalTask 
		# (result, iworld)	= normalTaskFuncs.evalFun [0:taskNr] normalTask.Task.properties (stepEvent 0 event) (stepTarget 0 tuiTaskNr) ilayout playout cxtNormal iworld
		= case result of
			TaskBusy tui actions newCxtNormal
				= (TaskBusy (tuiOk 0 tuiTaskNr tui) actions (TCTry (Left newCxtNormal)), iworld)
			TaskFinished a
				= (TaskFinished a, iworld)
			//Matching exception
			TaskException (ex :: e^) str 
				//Run the handler immediately
				# handler				= handlerTaskFun ex
				# handlerFuncs			= taskFuncs handler
				# (ilayout,playout)		= taskLayouters handler
				# (cxtHandler,iworld)	= handlerFuncs.initFun [1:taskNr] iworld
				# (result,iworld)		= handlerFuncs.evalFun [1:taskNr] handler.Task.properties (stepEvent 1 event) (stepTarget 1 tuiTaskNr) ilayout playout cxtHandler iworld
				= case result of
					TaskBusy tui actions newCxtHandler	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCTry (Right (toJSON ex,newCxtHandler))), iworld)
					TaskFinished a						= (TaskFinished a,iworld)
					TaskException e str					= (TaskException e str, iworld)
			//Other exception (pass through
			TaskException ex str
				= (TaskException ex str, iworld)
			
	//Handling the exception
	eval taskNr _ event tuiTaskNr _ _ context=:(TCTry (Right (encEx,cxtHandler))) iworld
		= case fromJSON encEx of
			Just e
				# handler			= handlerTaskFun e
				# handlerFuncs		= taskFuncs handler
				# (ilayout,playout)	= taskLayouters handler
				# (result,iworld)	= handlerFuncs.evalFun [1:taskNr] handler.Task.properties (stepEvent 1 event) (stepTarget 1 tuiTaskNr) ilayout playout cxtHandler iworld
				= case result of
					TaskBusy tui actions newCxtHandler	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCTry (Right (encEx,newCxtHandler))), iworld)
					TaskFinished a						= (TaskFinished a,iworld)
					TaskException e str					= (TaskException e str, iworld)
			Nothing
				= (taskException "Corrupt exception value in try" ,iworld)
	eval taskNr _ event tuiTaskNr _ _ context iworld
		= (taskException "Corrupt task context in try", iworld)
	
tuiOk i [] tui		= tui
tuiOk i [t:ts] tui	
	| i == t	= tui
	| otherwise	= Nothing
									
throw :: !e -> Task a | iTask a & iTask, toString e
throw e = mkInstantTask "Throw an exception" eval
where
	eval taskNr iworld = (TaskException (dynamic e) (toString e),iworld)


//TODO: Rewrite to a common base function for try and catchAll 	
catchAll :: !(Task a) (String -> Task a) -> Task a | iTask a
catchAll normalTask handlerTaskFun = mkTask (taskMeta normalTask) init edit eval
where
	normalTaskFuncs = taskFuncs normalTask

	init taskNr iworld
		# (cxt, iworld) = normalTaskFuncs.initFun [0:taskNr] iworld
		= (TCTry (Left cxt), iworld)
		
	edit taskNr (TaskEvent [0:steps] (path,val)) context=:(TCTry (Left cxtNormal)) iworld
		# (newCxtNormal,iworld) = normalTaskFuncs.editFun [0:taskNr] (TaskEvent steps (path,val)) cxtNormal iworld
		= (TCTry (Left newCxtNormal), iworld)

	edit taskNr (TaskEvent [1:steps] (path,val)) context=:(TCTry (Right (encEx, cxtHandler))) iworld
		= case (fromJSON encEx) of
			Just e
				# handler = taskFuncs (handlerTaskFun e)
				# (newCxtHandler,iworld) = handler.editFun [1:taskNr] (TaskEvent steps (path,val)) cxtHandler iworld
				= (TCTry (Right (encEx, newCxtHandler)), iworld)
			Nothing
				= (context, iworld)
	edit taskNr event context iworld
		= (context, iworld)

	//Normal execution still possible
	eval taskNr _ event tuiTaskNr _ _ context=:(TCTry (Left cxtNormal)) iworld
		# (ilayout,playout)	= taskLayouters normalTask
		# (result, iworld)	= normalTaskFuncs.evalFun [0:taskNr] normalTask.Task.properties (stepEvent 0 event) (stepTarget 0 tuiTaskNr) ilayout playout cxtNormal iworld
		= case result of
			TaskBusy tui actions newCxtNormal
				= (TaskBusy (tuiOk 0 tuiTaskNr tui) actions (TCTry (Left newCxtNormal)), iworld)
			TaskFinished a
				= (TaskFinished a, iworld)
			//Matching exception
			TaskException _ str 
				//Run the handler immediately
				# handler				= handlerTaskFun str
				# handlerFuncs			= taskFuncs handler
				# (ilayout,playout)		= taskLayouters handler
				# (cxtHandler,iworld)	= handlerFuncs.initFun [1:taskNr] iworld
				# (result,iworld)		= handlerFuncs.evalFun [1:taskNr] handler.Task.properties (stepEvent 1 event) (stepTarget 1 tuiTaskNr) ilayout playout cxtHandler iworld
				= case result of
					TaskBusy tui actions newCxtHandler	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCTry (Right (toJSON str,newCxtHandler))), iworld)
					TaskFinished a						= (TaskFinished a,iworld)
					TaskException e str					= (TaskException e str, iworld)

	//Handling the exception
	eval taskNr _ event tuiTaskNr _ _ context=:(TCTry (Right (encEx,cxtHandler))) iworld
		= case fromJSON encEx of
			Just e
				# handler			= handlerTaskFun e
				# handlerFuncs		= taskFuncs handler
				# (ilayout,playout)	= taskLayouters handler
				# (result,iworld)	= handlerFuncs.evalFun [1:taskNr] handler.Task.properties (stepEvent 1 event) (stepTarget 1 tuiTaskNr) ilayout playout cxtHandler iworld
				= case result of
					TaskBusy tui actions newCxtHandler	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCTry (Right (encEx,newCxtHandler))), iworld)
					TaskFinished a						= (TaskFinished a,iworld)
					TaskException e str					= (TaskException e str, iworld)
			Nothing
				= (taskException "Corrupt exception value in catchAll" ,iworld)
				
	eval taskNr _ event tuiTaskNr _ _ context iworld
		= (taskException "Corrupt task context in catchAll", iworld)