implementation module CoreCombinators

import StdList, StdTuple, StdMisc, StdBool, StdOrdList
import Task, TaskContext, Util, HTTP, GenUpdate, UserDB, Store, SystemTypes, Time, Text, Shared, Func
import iTaskClass, InteractionTasks
from Map				import qualified get, put, del
from StdFunc			import id, const, o, seq
from IWorld				import :: IWorld(..), :: Control(..)
from ProcessDB			import :: Process{..}
from ProcessDB			import qualified class ProcessDB(..), instance ProcessDB IWorld
from iTasks				import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDecode
from CoreTasks			import return
from TuningCombinators	import :: Tag

derive class iTask ParallelTaskInfo, ParallelControl, TaskGUI
derive bimap Maybe, (,)

//Standard monadic bind
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) taska taskbfun = mkTask (taskMeta taska) init edit eval
where
	init taskNr iworld
		# taskaFuncs		= taskFuncs taska
		# (inita,iworld)	= taskaFuncs.initFun [0:taskNr] iworld
		= (TCBind (Left inita), iworld)
		
	//Event is targeted at first task of the bind
	edit taskNr event context=:(TCBind (Left cxta)) iworld	
		= case stepEvent 0 (Just event) of
			Nothing
				= (context, iworld)
			Just event
				# taskaFuncs		= taskFuncs taska
				# (newCxta,iworld)	= taskaFuncs.editFun [0:taskNr] event cxta iworld
				= (TCBind (Left newCxta), iworld)
	//Event is targeted at second task of the bind
	edit taskNr event context=:(TCBind (Right (vala,cxtb))) iworld
		= case stepEvent 1 (Just event) of
			Nothing	= (context,iworld)	//Mismatching event
			Just event
				//Compute the second task based on the result of the first
				= case fromJSON vala of
					Just a
						# taskbfun = taskFuncs (taskbfun a)
						# (newCxtb,iworld)	= taskbfun.editFun [1:taskNr] event cxtb iworld
						= (TCBind (Right (vala,newCxtb)), iworld)
					Nothing
						= (context, iworld)

	//Evaluate first task
	eval taskNr _ event tuiTaskNr _ _ (TCBind (Left cxta)) iworld 
		//Adjust the target of a possible event
		# taskaFuncs		= taskFuncs taska
		# (ilayout,playout)	= taskLayouters taska
		# (resa, iworld) 	= taskaFuncs.evalFun [0:taskNr] taska.Task.properties (stepEvent 0 event) (stepTarget 0 tuiTaskNr) ilayout playout cxta iworld
		= case resa of
			TaskBusy tui actions newCxta
				= (TaskBusy (tuiOk 0 tuiTaskNr tui) actions (TCBind (Left newCxta)), iworld)
			TaskFinished a
				//Directly continue with the second task
				# taskb				= taskbfun a
				# taskbfuncs		= taskFuncs taskb
				# (ilayout,playout)	= taskLayouters taskb
				# (cxtb,iworld)		= taskbfuncs.initFun [1:taskNr] iworld
				# (resb,iworld)		= taskbfuncs.evalFun [1:taskNr] taskb.Task.properties Nothing (stepTarget 1 tuiTaskNr) ilayout playout cxtb iworld 
				= case resb of
					TaskBusy tui actions newCxtb	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCBind (Right (toJSON a,newCxtb))),iworld)
					TaskFinished b					= (TaskFinished b, iworld)
					TaskException e str				= (TaskException e str, iworld)
			TaskException e str
				= (TaskException e str, iworld)	
	//Evaluate second task
	eval taskNr _ event tuiTaskNr _ _ (TCBind (Right (vala,cxtb))) iworld
		= case fromJSON vala of
			Just a
				# taskb				= taskbfun a
				# taskbfuncs		= taskFuncs taskb
				# (ilayout,playout)	= taskLayouters taskb
				# (resb, iworld)	= taskbfuncs.evalFun [1:taskNr] taskb.Task.properties (stepEvent 1 event) (stepTarget 1 tuiTaskNr) ilayout playout cxtb iworld 
				= case resb of
					TaskBusy tui actions newCxtb	= (TaskBusy (tuiOk 1 tuiTaskNr tui) actions (TCBind (Right (vala,newCxtb))),iworld)
					TaskFinished b					= (TaskFinished b, iworld)
					TaskException e str				= (TaskException e str, iworld)
			Nothing
				= (taskException "Corrupt task value in bind", iworld)
	//Incorred state
	eval taskNr _ event tuiTaskNr _ _ context iworld
		= (taskException "Corrupt task context in bind", iworld)
	
	//Check that when we want the TUI of a sub task that it is on the path
	tuiOk i [] tui		= tui
	tuiOk i [t:ts] tui	
		| i == t	= tui
		| otherwise	= Nothing 

(>>|) infixl 1 :: !(Task a) (Task b) -> Task b | iTask a & iTask b
(>>|) taska taskb = taska >>= \_ -> taskb

(>>+) infixl 1 :: !(Task a) !(TermFunc a b) -> Task b | iTask a & iTask b
(>>+) task=:{Task|type} termF = case type of
	ActionTask actionTaskF	= {Task|task & type = NormalTask (actionTaskF termF)}
	_						= task >>= \r -> showInformation (taskMeta task) [] r >>+ termF
	
noActions :: (TermFunc a b) | iTask a & iTask b
noActions = const (UserActions [])

returnAction :: Action -> (TermFunc a a) | iTask a
returnAction action = \{modelValue,localValid} -> UserActions [(action, if localValid (Just modelValue) Nothing)]

constActions :: [(Action,b)] -> (TermFunc a b) | iTask a & iTask b
constActions actions = const (UserActions [(a,Just v) \\ (a,v) <- actions])

// Parallel composition
INFOKEY id		:== "parallel_" +++ taskNrToString id +++ "-info"

:: ResultSet
	= RSException !Dynamic !String
	| RSStopped
	| RSResults ![(!Int, !TaskResult ParallelControl, !SubTaskContext)]
	

parallel :: !d !s (ResultFun s a) ![TaskContainer s] -> Task a | iTask s & iTask a & descr d
parallel description initState resultFun initTasks = mkTask description init edit eval 
where
	//Create initial set of tasks and initial state
	init taskNr iworld=:{IWorld|timestamp}
		# (subContexts, nextIdx, iworld)	= initSubContexts taskNr taskList 0 initTasks iworld  
		# meta								= {nextIdx = nextIdx, stateId = taskNrToString taskNr, stateChanged = timestamp, infoChanged = timestamp}
		# encState							= encodeState initState initState
		= (TCParallel encState meta subContexts, iworld)
	where
		taskList	= ParallelTaskList (taskNrToString taskNr)
		
		initSubContexts taskNr taskList i [] iworld = ([],i,iworld)
		initSubContexts taskNr taskList i [t:ts] iworld
			# (s,iworld)			= initSubContext taskNr taskList i t iworld
			# (ss, nextIdx, iworld) = initSubContexts taskNr taskList (i + 1) ts iworld
			= ([(i,s):ss], nextIdx, iworld)
			
			
	//Direct the event to the right place
	edit taskNr event context=:(TCParallel encState meta subs) iworld
		//Add the current state to the parallelStates scope in iworld
		# state							= decodeState encState initState 
		# iworld						= addParState taskNr state meta iworld
		//Put the initial parallel task info overview in the parallelStates scope in iworld
		# iworld						= addParTaskInfo taskNr subs meta.infoChanged iworld 
		//Evaluate sub(s)
		# (TCParallel encState meta subs,iworld)
			= case event of
				(TaskEvent [s:steps] val)
					//Evaluate only the matching sub-context
					= case [(i,sub) \\ (i,sub) <- subs | i == s] of	
						[(i,sub)] 
							# ((i,newSub),iworld) = editSub taskNr (TaskEvent steps val) (i,sub) iworld
							= (TCParallel encState meta [if (i == s) (i,newSub) (i,sub) \\(i,sub) <- subs],iworld)
						_ 
							= (context,iworld)
				(ProcessEvent path val)
					//Evaluate all sub-contexts
					# (subs, iworld) = mapSt (editSub taskNr event) subs iworld
					= (TCParallel encState meta subs, iworld)
				_	
					//The event is mistargeted, do nothing
					= (context,iworld)
		//Remove the current state from the parallelStates scope in iworld
		# (state,meta,iworld)			= removeParState taskNr meta iworld
		//Remove the task info overview
		# iworld						= removeParTaskInfo taskNr iworld
		//Encode state
		# encState	= encodeState state initState
		= (TCParallel encState meta subs,iworld)
				
	edit taskNr event context iworld
		= (context,iworld)
	
	editSub taskNr event (i,sub) iworld=:{IWorld|latestEvent=parentLatestEvent}
		 = case sub of
			//Active InBody task
			STCBody props (Just (encTask,subCxt))
				# task = fromJust (dynamicJSONDecode encTask)	//TODO: Add case for error
				# taskfuncs = taskFuncs` task
				# (newSubCxt,iworld) = taskfuncs.editFun [i:taskNr] event subCxt iworld
				= ((i,STCBody props (Just (encTask,newSubCxt))), iworld)		
			STCDetached props (Just (encTask,subCxt))
			//Same pattern as inbody tasks
				# task = fromJust (dynamicJSONDecode encTask)	//TODO: Also add case for error
				# taskfuncs = taskFuncs` task
				// change latest event timestamp for detached process
				# iworld = {IWorld|iworld & latestEvent = props.systemProperties.SystemProperties.latestEvent}
				# (newSubCxt,iworld) = taskfuncs.editFun [i:taskNr] event subCxt iworld
				# iworld = {IWorld|iworld & latestEvent = parentLatestEvent}
				= ((i,STCDetached props (Just (encTask,newSubCxt))), iworld)
			//Task is either completed already or hidden
			_
				= ((i,sub),iworld)
	
	
	//Eval all tasks in the set (in left to right order)
	eval taskNr meta event tuiTaskNr _ playout context=:(TCParallel encState pmeta subs) iworld
		//Add the current state to the parallelStates scope in iworld
		# state							= decodeState encState initState 
		# iworld						= addParState taskNr state pmeta iworld
		//Add the initial control structure to the parallelStates scope in iworld
		# iworld						= addParControl taskNr pmeta iworld
		//Put the initial parallel task info overview in the parallelStates scope in iworld
		# iworld						= addParTaskInfo taskNr subs pmeta.infoChanged iworld
		//Evaluate the sub tasks
		# (resultset,iworld)			= evalSubTasks taskNr event tuiTaskNr pmeta [] subs iworld
		//Remove the current state from the parallelStates scope in iworld
		# (state,pmeta,iworld)			= removeParState taskNr pmeta iworld
		//Remove the control structure from the parallelStates scope in iworld
		# (pmeta,iworld)				= removeParControl taskNr pmeta iworld
		//Remove the task info overview from the parallelStates scropr in iworld
		# iworld						= removeParTaskInfo taskNr iworld 
		//Remove parallel task info
		= case resultset of
			//Exception
			RSException e str	= (TaskException e str, iworld)
			RSStopped 			= (TaskFinished (resultFun Stopped state), iworld)
			RSResults results
				| allFinished results
					= (TaskFinished (resultFun AllRunToCompletion state), iworld)
				| otherwise
					# encState			= encodeState state initState
					# (tui,actions)		= mergeTUIs playout tuiTaskNr meta results
					# subs				= mergeContexts results
					= (TaskBusy tui actions (TCParallel encState pmeta subs), iworld)
		
	//Keep evaluating tasks and updating the state until there are no more subtasks
	//subtasks
	evalSubTasks taskNr event tuiTaskNr meta results [] iworld
		= (RSResults results, iworld)
	evalSubTasks taskNr event tuiTaskNr meta results [(idx,stcontext):stasks] iworld=:{IWorld|latestEvent=parentLatestEvent,timestamp}
		//Evaluate subtask
		# (result,stcontext,iworld)	= case stcontext of
			(STCHidden props (Just (encTask,context)))
				# task				= fromJust (dynamicJSONDecode encTask)
				# taskfuncs			= taskFuncs` task
				# (ilayout,playout)	= taskLayouters task
				# (result,iworld)	= taskfuncs.evalFun [idx:taskNr] task.Task.properties (stepEvent idx event) (stepTarget idx tuiTaskNr) ilayout playout context iworld 
				= case result of
					TaskBusy tui actions context	= (TaskBusy tui actions context, STCHidden props (Just (encTask, context)), iworld)
					TaskFinished r					= (TaskFinished r, STCHidden props Nothing, iworld)
					TaskException e str				= (TaskException e str, STCHidden props Nothing, iworld)
			(STCBody props (Just (encTask,context)))
				# task				= fromJust (dynamicJSONDecode encTask)
				# taskfuncs			= taskFuncs` task
				# (ilayout,playout)	= taskLayouters task
				# (result,iworld)	= taskfuncs.evalFun [idx:taskNr] task.Task.properties (stepEvent idx event) (stepTarget idx tuiTaskNr) ilayout playout context iworld 
				= case result of
					TaskBusy tui actions context	= (TaskBusy tui actions context, STCBody props (Just (encTask, context)), iworld)
					TaskFinished r					= (TaskFinished r, STCBody props Nothing, iworld)
					TaskException e str				= (TaskException e str, STCBody props Nothing, iworld)
			(STCDetached props (Just (encTask,context)))
				# task				= fromJust (dynamicJSONDecode encTask)
				# taskfuncs			= taskFuncs` task
				# (ilayout,playout)	= taskLayouters task
				//Evaluate the task with a different current worker set & changed latest event timestamp
				# (curUser,iworld)	= switchCurrentUser props.ProcessProperties.managerProperties.worker iworld
				# iworld			= {IWorld|iworld & latestEvent = props.systemProperties.SystemProperties.latestEvent}
				# (result,iworld)	= taskfuncs.evalFun [idx:taskNr] task.Task.properties (stepEvent idx event) (stepTarget idx tuiTaskNr) ilayout playout context iworld 
				# (_,iworld)		= switchCurrentUser curUser iworld
				# iworld			= {IWorld|iworld & latestEvent = parentLatestEvent}
				//Update first/latest event if request is targeted at this detached process
				# props = case tuiTaskNr of
					[t] | t == idx	=	{props & systemProperties =
						{ props.systemProperties
						& firstEvent	= Just (fromMaybe timestamp props.systemProperties.firstEvent)
						, latestEvent	= Just timestamp
						}}
					_				= props
				= case result of
					TaskBusy tui actions context	= (TaskBusy tui actions context, STCDetached props (Just (encTask, context)), iworld)
					TaskFinished r					= (TaskFinished r, STCDetached (markFinished props) Nothing, iworld)
					TaskException e str				= (TaskException e str, STCDetached (markExcepted props) Nothing, iworld)		
			_
				//This task is already completed
				= (TaskFinished Continue, stcontext, iworld)
		//Check for exception
		| isException result
			# (TaskException dyn str) = result
			= (RSException dyn str, iworld)
		//Check for stop result (discards any pending additions/removals to the set, since they will be pointless anyway)
		| isStopped result
			= (RSStopped, iworld)
		//Append current result to results so far
		# results	= results ++ [(idx,result,stcontext)]
		//Process controls
		# (controls, iworld)			= getControls meta iworld
		# (meta,results,stasks,iworld)	= processControls initState taskNr meta controls results stasks iworld
		//Evaluate remaining subtasks
		= evalSubTasks taskNr event tuiTaskNr meta results stasks iworld
		
	initSubContext taskNr taskList i taskContainer iworld=:{IWorld|timestamp}
		# subTaskNr = [i:taskNr]
		= case taskContainer of
			(DetachedTask managerProps, taskfun)
				# (task,funcs)	= mkSubTask taskfun
				# processProps	= initProcessProperties subTaskNr timestamp managerProps task
				# (cxt,iworld)	= funcs.initFun subTaskNr iworld
				= (STCDetached processProps (Just (hd (dynamicJSONEncode task), cxt)), iworld)
			//Window & dialogue now implemented as simple InBody tasks
			(WindowTask title, taskfun) 
				# (task,funcs)	= mkSubTask taskfun
				# taskProps		= initTaskProperties task
				# (cxt,iworld)	= funcs.initFun subTaskNr iworld
				= (STCBody taskProps (Just (hd (dynamicJSONEncode task), cxt)), iworld)
			(DialogTask title, taskfun)
				# (task,funcs)	= mkSubTask taskfun
				# taskProps		= initTaskProperties task
				# (cxt,iworld)	= funcs.initFun subTaskNr iworld
				= (STCBody taskProps (Just (hd (dynamicJSONEncode task), cxt)), iworld)
			(BodyTask, taskfun)
				# (task,funcs)	= mkSubTask taskfun
				# taskProps		= initTaskProperties task
				# (cxt,iworld)	= funcs.initFun subTaskNr iworld
				= (STCBody taskProps (Just (hd (dynamicJSONEncode task), cxt)), iworld)
			(HiddenTask, taskfun)
				# (task,funcs)	= mkSubTask taskfun
				# taskProps		= initTaskProperties task
				# (cxt,iworld)	= funcs.initFun subTaskNr iworld
				= (STCHidden taskProps (Just (hd (dynamicJSONEncode task), cxt)), iworld)
	where
		// apply task list reference to taskfun & convert to 'normal' (non-action) tasks
		mkSubTask taskfun
			# task			= taskfun taskList
			# funcs			= taskFuncs task
			# task			= {Task|task & type = NormalTask funcs}
			= (task,funcs)

	//Initialize a process properties record for administration of detached tasks
	initProcessProperties taskNr timestamp managerProps {Task|properties}
		= {ProcessProperties
		  |taskProperties = properties
		  ,managerProperties = managerProps
		  ,systemProperties
		  	= {SystemProperties
		  	  |taskId = taskNrToString taskNr
		  	  ,status = Running
		  	  ,issuedAt = timestamp
			  ,firstEvent = Nothing
			  ,latestEvent = Nothing
			  }
		   }
		   
	//Initialize a task properties record for administration of all other tasks
	initTaskProperties {Task|properties} = properties

	//IMPORTANT: The second argument is never used, but passed just to solve overloading
	encodeState :: !s s -> JSONNode | JSONEncode{|*|} s
	encodeState val _ = toJSON val
	
	//IMPORTANT: The second argument is never used, but passed just to solve overloading
	decodeState :: !JSONNode s -> s | JSONDecode{|*|} s
	decodeState encState _ = case fromJSON encState of
		Just val 	= val
		_			= abort "Could not decode parallel state"
		
	//Put the shared state in the scope
	addParState :: !TaskNr !s !ParallelMeta *IWorld -> *IWorld | TC s
	addParState taskNr state {stateId,stateChanged} iworld=:{parallelStates}
		= {iworld & parallelStates = 'Map'.put (toString (ParallelTaskList stateId)) (dynamic (state,stateChanged) :: (s^,Timestamp)) parallelStates}
	
	removeParState :: !TaskNr !ParallelMeta !*IWorld -> (!s,!ParallelMeta,!*IWorld) | TC s
	removeParState taskNr meta=:{stateId} iworld=:{parallelStates}
		= case 'Map'.get (toString (ParallelTaskList stateId)) parallelStates of
			Just ((state,ts) :: (s^,Timestamp))	= (state,{meta & stateChanged = ts},{iworld & parallelStates = 'Map'.del (toString (ParallelTaskList stateId)) parallelStates})
			_									= abort "Could not read parallel state"
	
	//IMPORTANT: first argument is never used, but passed just to solve overloading
	//Put the initial control structure in the scope
	addParControl :: !TaskNr !ParallelMeta *IWorld -> *IWorld
	addParControl taskNr meta=:{nextIdx,stateId} iworld=:{parallelControls}
		= {iworld & parallelControls = 'Map'.put key (nextIdx,[]) parallelControls}
	where
		key = toString (ParallelTaskList stateId)
		
	removeParControl :: !TaskNr !ParallelMeta *IWorld -> (!ParallelMeta,!*IWorld)
	removeParControl taskNr meta=:{stateId} iworld=:{parallelControls}
		= case 'Map'.get key parallelControls of
			Just (nextIdx,_)	= ({meta & nextIdx = nextIdx},{iworld & parallelControls = 'Map'.del key parallelControls})
			_					= abort "Could not read parallel control"
	where
		key	= toString (ParallelTaskList stateId)
	
	//Put a datastructure in the scope with info on all processes in this set (TODO: Use parallel meta for identification)
	addParTaskInfo :: !TaskNr ![(!Int,!SubTaskContext)] !Timestamp !*IWorld -> *IWorld
	addParTaskInfo taskNr subs ts iworld=:{parallelStates}
		= {iworld & parallelStates = 'Map'.put (INFOKEY taskNr) (dynamic (mkInfo subs,ts) :: ([ParallelTaskInfo],Timestamp) ) parallelStates}
	where
		mkInfo subs = [{ParallelTaskInfo|index = i, properties = props sub} \\ (i,sub) <- subs]
		props (STCHidden p _)	= Left p
		props (STCBody p _)		= Left p
		props (STCDetached p _)	= Right p		
	
	removeParTaskInfo :: !TaskNr !*IWorld -> *IWorld
	removeParTaskInfo taskNr iworld=:{parallelStates}
		= {iworld & parallelStates = 'Map'.del (INFOKEY taskNr) parallelStates}

	switchCurrentUser :: !User !*IWorld -> (!User,!*IWorld)
	switchCurrentUser newUser iworld=:{IWorld|currentUser}
		= (currentUser,{IWorld|iworld & currentUser = newUser})
	
	//Remove and return control values from the scope
	getControls :: !ParallelMeta !*IWorld -> ([Control], !*IWorld)
	getControls meta=:{stateId} iworld=:{parallelControls}
		= case 'Map'.get key parallelControls of
			Just (nextIdx, controls)
				= (controls, {iworld & parallelControls = 'Map'.put key (nextIdx,[]) parallelControls})
			_
				= abort "Could not load parallel control data"
	where
		key	= toString (ParallelTaskList stateId)
		
	processControls :: s !TaskNr !ParallelMeta [Control] [(!Int, !TaskResult ParallelControl, !SubTaskContext)] [(Int,!SubTaskContext)] !*IWorld -> (!ParallelMeta,![(!Int, !TaskResult ParallelControl, !SubTaskContext)], ![(Int,!SubTaskContext)],!*IWorld) | iTask s
	processControls s taskNr meta [] results remaining iworld = (meta,results,remaining,iworld)
	processControls s taskNr meta [c:cs] results remaining iworld
		# taskList = ParallelTaskList meta.ParallelMeta.stateId
		= case c of
			AppendTask idx (taskContainer :: (TaskContainer s^))
				# (context,iworld)	= initSubContext taskNr taskList idx taskContainer iworld
				# remaining			= remaining ++ [(idx,context)]
				= processControls s taskNr meta cs results remaining iworld
			RemoveTask idx
				# results			= [result \\ result=:(i,_,_) <- results | i <> idx]
				# remaining			= [sub \\ sub=:(i,_) <- remaining | i <> idx]
				= processControls s taskNr meta cs results remaining iworld
			_
				= processControls s taskNr meta cs results remaining iworld 		
	
	isException (TaskException _ _)	= True
	isException _					= False
	
	isStopped	(TaskFinished Stop)	= True
	isStopped	_					= False
	
	allFinished []							= True
	allFinished [(_,TaskFinished _,_):rs]	= allFinished rs
	allFinished _							= False
	
	markFinished properties=:{ProcessProperties|systemProperties}
		= {ProcessProperties|properties & systemProperties = {SystemProperties|systemProperties & status = Finished}}
	markExcepted properties=:{ProcessProperties|systemProperties}
		= {ProcessProperties|properties & systemProperties = {SystemProperties|systemProperties & status = Excepted}}
	
	updateProperties mprops (STCDetached props scontext)
		= (STCDetached {ProcessProperties|props & managerProperties = mprops} scontext)
	updateProperties _ context = context
	
	mergeContexts contexts
		= [(i,context) \\ (i,_,context) <- contexts]

	//User the parallel merger function to combine the user interfaces of all InBody tasks		
	mergeTUIs pmerge tuiTaskNr pmeta contexts
		= case tuiTaskNr of
			[]
				# items		= [(getMeta subContext, getTui subContext mbTui,actions) \\(i,TaskBusy mbTui actions _,subContext) <- contexts | not (isDetached subContext)]
				# (tui,actions) =
					pmerge {TUIParallel
				 		 |title = pmeta.TaskMeta.title
						 ,instruction = pmeta.TaskMeta.instruction
				 		 ,items = items
				 		 }
				= (Just tui, actions)
				where
					isHidden (STCHidden _ _) = True
					isHidden _ = False
					isDetached (STCDetached _ _) = True
					isDetached _ = False
					
					getMeta (STCHidden meta _)	= meta
					getMeta (STCBody meta _)	= meta		
					
					getTui (STCHidden _ _) _	= Nothing
					getTui (STCBody _ _) mbTui	= mbTui
					
			//We want to show the TUI of one of the detached tasks in this set
			[t]
				= case [(tui,actions,props) \\ (i,TaskBusy (Just tui) actions _,STCDetached props _) <- contexts | i == t] of
					[(tui,actions,props)]
						= (Just tui,actions)
					_
						= (Nothing,[])
				
				
			//We want to show the TUI of a task inside the parallel set
			[t:ts]
				= case [(tui,actions) \\ (i,TaskBusy (Just tui) actions _,_) <- contexts | i == t] of
					[(tui,actions)]	= (Just tui,actions)
					_				= (Nothing,[])
	
	taskFuncs` {Task|type} = case type of
		NormalTask fs	= fs
		_				= abort "action task in parallel"

/**
* Get the shared state of a task list
*/
taskListState :: (TaskList s) -> Shared s | TC s
taskListState tasklist = ReadWriteShared [identity] read write timestamp
where
	identity 	= toString tasklist
	
	read iworld=:{parallelStates}
		= case 'Map'.get identity parallelStates of
				Just ((val,_) :: (s^,Timestamp))	= (Ok val, iworld)
				_									= (Error ("Could not read shared parallel state of task list " +++ identity),iworld)
	
	write val iworld=:{parallelStates,timestamp}
			= (Ok Void, {iworld & parallelStates = 'Map'.put identity (dynamic (val,timestamp) :: (s^,Timestamp)) parallelStates })
	
	timestamp iworld=:{parallelStates}
			= case 'Map'.get identity parallelStates of
				Just ((_,ts) :: (s,Timestamp))		= (Ok ts, iworld)
				_									= (Error ("Could not read timestamp for shared state of task list " +++ identity),iworld)

/**
* Get the properties share of a task list
*/
taskListProperties	:: (TaskList s) -> Shared [ParallelTaskInfo]
taskListProperties tasklist = ReadWriteShared [identity] read write timestamp
where
	identity	= toString tasklist +++ "-info"
	
	read iworld=:{parallelStates}
		= case 'Map'.get identity parallelStates of
			Just ((val,_) :: ([ParallelTaskInfo],Timestamp))	= (Ok val, iworld)
			_													= (Error ("Could not read parallel task info of " +++ identity), iworld)
		
	write val iworld=:{parallelStates,timestamp} //TODO
		= (Ok Void, iworld)
			
	timestamp iworld=:{parallelStates}
		= case 'Map'.get identity parallelStates of
			Just ((_,ts) :: ([ParallelTaskInfo],Timestamp))	= (Ok ts, iworld)
			_												= (Error ("Could not read timestamp for parallel task info of " +++ identity), iworld)
		
/**
* Add a task to a task list
*/
appendTask :: !(TaskContainer s) !(TaskList s)	-> Task Int | TC s
appendTask container tasklist = mkInstantTask "Append a task to a task list" appendTask`
where
	identity	= toString tasklist
	appendTask` taskNr iworld=:{parallelControls}
		= case 'Map'.get identity parallelControls of
			Just (nextIdx,controls)
				//For the global tasklist we don't use the internal counter, but get the index from the
				//process database
				# (nextIdx, iworld) = case tasklist of
					GlobalTaskList
						# (WorkflowProcess next,iworld) = 'ProcessDB'.getNewWorkflowId iworld
						= (next,iworld)
					_				= (nextIdx,iworld)
				# parallelControls = 'Map'.put identity (nextIdx + 1, controls ++ [AppendTask nextIdx (dynamic container :: TaskContainer s^)]) parallelControls 
				= (TaskFinished nextIdx, {iworld & parallelControls = parallelControls, readShares = Nothing})
			_
				= (taskException ("Task list " +++ identity +++ " is not in scope"), iworld)
	
/**
* Removes (and stops) a task from a task list
*/
removeTask :: !Int !(TaskList s) -> Task Void | TC s
removeTask idx tasklist = mkInstantTask "Append a task to a task list" (removeTask` idx tasklist)
where
	removeTask` :: !Int !(TaskList s) TaskNr *IWorld -> (!TaskResult Void,!*IWorld) | TC s
	removeTask` idx tasklist taskNr iworld=:{parallelControls}
		= case 'Map'.get identity parallelControls of
			Just (nextIdx,controls)
				# parallelControls = 'Map'.put identity (nextIdx, controls ++ [RemoveTask idx]) parallelControls
				= (TaskFinished Void, {iworld & parallelControls = parallelControls })
			_
				= (taskException ("Task list " +++ identity +++ " is not in scope"), iworld)
	where
		identity	= toString tasklist


/*
* Alters the evaluation functions of a task in such a way
* that before evaluation the currentUser field in iworld is set to
* the given user, and restored afterwards.
*/
workAs :: !User !(Task a) -> Task a | iTask a
workAs user task=:{Task|type,layout} = case type of
	NormalTask funs
		# funs = {initFun = init funs.initFun
				 ,editFun = edit funs.editFun
				 ,evalFun = eval funs.evalFun
				 }
		= {Task|task & type = NormalTask funs, layout = layout}
	ActionTask fun
		= {Task|task & type = ActionTask (action fun), layout = layout}
where
	action f tfun
		# funs = f tfun
		= {initFun = init funs.initFun
		  ,editFun = edit funs.editFun
		  ,evalFun = eval funs.evalFun
		  }

	init f taskNr iworld=:{currentUser}
		# (context,iworld) = f taskNr {iworld & currentUser = user}
		= (context,{iworld & currentUser = currentUser})

	edit f taskNr event context iworld=:{currentUser}
		# (context,iworld) = f taskNr event context {iworld & currentUser = user}
		= (context,{iworld & currentUser = currentUser})
	
	eval f taskNr props event target ilayout playout context iworld=:{currentUser}
		# (result,iworld) = f taskNr props event target ilayout playout context {iworld & currentUser = user}
		= (result,{iworld & currentUser = currentUser})