implementation module TaskEval

import StdList, StdBool
import Error
import SystemTypes, IWorld, Shared, Task, TaskContext
import LayoutCombinators

from CoreCombinators	import :: ParallelTaskType(..), :: ParallelTask(..)
from TaskStore			import newSessionId, loadTaskInstance, storeTaskInstance, deleteTaskInstance

from Map				import qualified fromList, get, put
import iTaskClass

setUnstable :: !ProgressMeta -> ProgressMeta
setUnstable meta = {meta & status = Unstable}

setStable :: !ProgressMeta -> ProgressMeta
setStable meta = {meta & status = Stable}

setExcepted :: !ProgressMeta  -> ProgressMeta
setExcepted meta = {meta & status = Excepted}

getTaskMeta	:: !TaskRep -> [(!String,!String)]
getTaskMeta NoRep					= []
getTaskMeta (TUIRep (_,_,_,attr))	= attr
getTaskMeta (ServiceRep (_,_,attr))	= attr

//Tasks are packed in container to have all required overloading resolved for
//completely independent evaluation
createTaskContainer :: (ParallelTask a) -> Dynamic | iTask a
createTaskContainer parTask = (dynamic (Container parTask) :: Container (ParallelTask a^) a^)

//Final task results are wrapped in a container to be able to serialize it in
//a webservice response
createValueContainer :: a -> Dynamic | iTask a
createValueContainer val = (dynamic (Container val) :: Container a^ a^)

//Lifts any task to a task that can be added to the "sessions" task list
toSessionTask :: (Task a) -> ParallelTask Void
toSessionTask task=:{evalFun} = \_ -> {task & evalFun = evalFun`}
where
	evalFun` mbE mbC repAs state iworld = case evalFun mbE mbC repAs state iworld of
		(TaskUnstable mba rep state,iworld)	= (TaskUnstable (fmap (\_ -> Void) mba) rep state, iworld)
		(TaskStable a rep state, iworld)	= (TaskStable Void rep state, iworld)
		(TaskException e str, iworld)		= (TaskException e str, iworld)

createTaskState :: !(Either SessionId TopNo) !Dynamic !ManagementMeta !User !*IWorld -> (!TopInstance, !*IWorld)
createTaskState topId container=:(Container parTask :: Container (ParallelTask a) a) mmeta user iworld =:{IWorld|localDateTime}
	# taskId				= case topId of
		Left _		= TaskId 0 0
		Right topNo	= TaskId topNo 0
	# taskList				= taskListShare TopLevelTaskList
	# task					= parTask taskList
	# (state,iworld) 		= task.initFun taskId {iworld & nextTaskNo = 1, evalStack = [taskId]}		
	# (nextTaskNo,iworld)	= getNextTaskNo iworld 
	# pmeta	 = {issuedAt = localDateTime
			   ,issuedBy = user
			   , status  = Unstable
			   , firstEvent = Nothing
			   , latestEvent = Nothing
			   }
	= ({TopInstance|instanceId=topId,nextTaskNo=nextTaskNo,progress=pmeta,management=mmeta,task=container,state=Left state,attributes=[]},iworld)
where
	getNextTaskNo iworld=:{IWorld|nextTaskNo} = (nextTaskNo,iworld)
	
//Evaluate the given context and yield the result of the main task indicated by target
evalInstance :: !(Maybe EditEvent) !(Maybe CommitEvent) !(Maybe TaskId) !Bool !TopInstance  !*IWorld -> (!MaybeErrorString (TaskResult Dynamic), !TopInstance, !*IWorld)
evalInstance editEvent commitEvent repTarget genGUI topInstance=:{TopInstance|instanceId,nextTaskNo=curNextTaskNo,progress,task=(Container parTask :: Container (ParallelTask a) a),state=Left taskState} iworld=:{nextTaskNo,evalStack}
	//Eval instance
	# taskList					= taskListShare TopLevelTaskList
	# task						= parTask taskList
	# repAs						= if genGUI (RepAsTUI repTarget task.layout) (RepAsService repTarget)
	//Update current process id & eval stack in iworld
	# taskId					= case instanceId of
		(Left _)		= TaskId 0 0
		(Right topNo)	= TaskId topNo 0
	# iworld					= {iworld & evalStack = [taskId:evalStack], nextTaskNo = curNextTaskNo} 
	//Apply task's eval function and take updated nextTaskId from iworld
	# (result,iworld)			= task.evalFun editEvent commitEvent repAs taskState iworld
	# (updNextTaskNo,iworld)	= getNextTaskNo iworld
	//Restore current process id & nextTask id in iworld
	# iworld			= {iworld & nextTaskNo = nextTaskNo, evalStack = evalStack}
	= case result of
		TaskUnstable _ rep state
			# topInstance = {TopInstance|topInstance & nextTaskNo = updNextTaskNo, progress = setUnstable progress, state = Left state}
			= (Ok (TaskUnstable Nothing rep state), topInstance , iworld)
		TaskStable val rep state
			# topInstance = {TopInstance|topInstance & nextTaskNo = updNextTaskNo, progress = setStable progress, state = Left state}
			= (Ok (TaskStable (createValueContainer val) rep state), topInstance , iworld)
		TaskException e str
			# topInstance = {TopInstance|topInstance & nextTaskNo = updNextTaskNo, progress = setExcepted progress, state = Right str}
			= (Ok (TaskException e str), topInstance, iworld)
where
	getNextTaskNo iworld=:{IWorld|nextTaskNo} = (nextTaskNo,iworld)
evalInstance _ _ _ _ topInstance=:{TopInstance|state=Right e} iworld
	= (Ok (taskException e), topInstance, iworld)
evalInstance _ _ _ _ topInstance iworld	
	= (Ok (taskException "Could not unpack instance state"), topInstance, iworld)

createSessionInstance :: !(Task a) !(Maybe EditEvent) !(Maybe CommitEvent) !Bool !*IWorld -> (!MaybeErrorString (!TaskResult Dynamic, !SessionId), !*IWorld) |  iTask a
createSessionInstance task editEvent commitEvent genGUI iworld
	# (sessionId,iworld)	= newSessionId iworld
	# (state, iworld)		= createTaskState (Left sessionId) (createTaskContainer (toSessionTask task)) noMeta AnyUser iworld
	# (mbRes,iworld)		= evalTopInstance editEvent commitEvent genGUI state iworld
	= case mbRes of
		Ok result	= (Ok (result, sessionId), iworld)
		Error e		= (Error e, iworld)

evalSessionInstance :: !SessionId !(Maybe EditEvent) !(Maybe CommitEvent) !Bool !*IWorld -> (!MaybeErrorString (!TaskResult Dynamic, !SessionId), !*IWorld)
evalSessionInstance sessionId editEvent commitEvent genGUI iworld
	# (mbContext,iworld)	= loadTaskInstance (Left sessionId) iworld
	= case mbContext of
		Error e				= (Error e, iworld)
		Ok context
			# (mbRes,iworld)	= evalTopInstance editEvent commitEvent genGUI context iworld
			= case mbRes of
				Ok result		= (Ok (result, sessionId), iworld)
				Error e			= (Error e, iworld)

evalTopInstance :: !(Maybe EditEvent) !(Maybe CommitEvent) !Bool !TopInstance !*IWorld -> (!MaybeErrorString (TaskResult Dynamic), !*IWorld)
evalTopInstance editEvent commitEvent genGUI state iworld
	//Initialize the toplevel task list
	# iworld 	= {iworld & parallelControls = 'Map'.fromList [("taskList:" +++ toString TopLevelTaskList,(0,[]))]}
	
	//If an event was present evaluate an extra time without events for a consistent picture
	# (mbResult, state, iworld) = case (editEvent,commitEvent) of
		(Nothing,Nothing)	= evalInstance editEvent commitEvent Nothing genGUI state iworld 
		_					
			//Evaluate twice: First with events, but without generating a GUI, then once without events
			# (_,state,iworld)	= evalInstance editEvent commitEvent Nothing False state iworld 
			//Save the intermediate state and process controls (or you won't see completed/added/removed processes)
			# iworld			= storeTaskInstance state iworld		
			# iworld			= processControls iworld
			= evalInstance Nothing Nothing Nothing genGUI state iworld
	//Store context & process controls
	# iworld	= storeTaskInstance state iworld		
	# iworld	= processControls iworld 
	= (mbResult, iworld)
		
processControls :: !*IWorld -> *IWorld
processControls iworld = processControls` [] iworld
where	
	processControls` queue iworld=:{currentUser}
		//Check for additions/removals in the toplevel task list
		# (controls, iworld)	= getControls iworld
		//Execute the additions/removals. Additions are appended to the queue to be evaluated
		# (queue, iworld)		= execControls controls queue iworld
		//Eval an element of the queue and recurse
		= case queue of 
			[]		= iworld
			[c:cs]
				//Evaluate and store the context only. We do not want any result	
				# iworld		= {iworld & currentUser = issueUser c}
				# (_,c,iworld)	= evalInstance Nothing Nothing Nothing False c iworld
				# iworld		= storeTaskInstance c iworld
				= processControls` cs {iworld & currentUser = currentUser}

	//Extracts controls and resets the toplevel task list
	getControls iworld=:{parallelControls}
		# listId = "taskList:" +++ toString TopLevelTaskList
		= case 'Map'.get listId parallelControls of
			Just (_,controls)	= (controls, {iworld & parallelControls = 'Map'.put listId (0,[]) parallelControls})
			_					= ([],iworld)

	execControls [] queue iworld = (queue,iworld)
	execControls [c:cs] queue iworld = case c of
		AppendTask {ParallelItem|taskId=TaskId tid 0,task=(parTask :: ParallelTask Void), management}
			# container			= createTaskContainer parTask
			# management		= fromMaybe noMeta management
			# user				= fromMaybe AnyUser management.worker
			# (state,iworld)	= createTaskState (Right tid) container management AnyUser iworld	
			= execControls cs (queue ++ [state]) iworld
		RemoveTask (TaskId tid 0)
			//Remove task instance
			# iworld				= deleteTaskInstance (Right tid) iworld
			= execControls cs queue iworld
		_
			= execControls cs queue iworld		
		
	issueUser {TopInstance|progress={ProgressMeta|issuedBy}} = issuedBy

taskListShare :: !(TaskListId s) -> (SharedTaskList s) | iTask s
taskListShare listId = (makeReadOnlySharedError "taskList" listKey read getVersion)
where
	listKey = toString listId
	
	read iworld=:{parallelLists}
		= case 'Map'.get ("taskList:" +++ listKey) parallelLists of
			Just (_,items)	= (Ok (mkTaskList items), iworld)
			_				= (Error ("Could not read parallel task list of " +++ toString listId), iworld)
		
	getVersion iworld=:{parallelLists}
			= case ('Map'.get ("taskList:" +++ listKey) parallelLists) of
				(Just (v,_))	= (Ok v, iworld)
				_				= (Error ("Could not read timestamp for shared state of task list " +++ listKey),iworld)

	mkTaskList items = {TaskList|listId = listId, state = state, items = litems}
	where
		state	= [fromJSON lastValue \\ {ParallelItem|lastValue} <- items]
		litems	= map toMeta items
		
		toMeta {ParallelItem|taskId,progress,management,state,lastAttributes}
			= {TaskListItem|taskId = taskId, taskMeta = lastAttributes, progressMeta = progress, managementMeta = management
			  ,subItems = stateToTaskListItems state}