implementation module iTasks.API.Core.CoreCombinators

import StdList, StdTuple, StdMisc, StdBool, StdOrdList

import Internet.HTTP, GenEq, System.Time, Text, Data.Func, Data.Tuple, Data.List, Data.Error, Data.Either, Text.JSON
import iTasks.Framework.Task, iTasks.Framework.TaskState, iTasks.Framework.TaskStore, iTasks.Framework.TaskEval
import iTasks.Framework.Util, iTasks.Framework.Shared, iTasks.Framework.Store
import iTasks.Framework.Generic, iTasks.Framework.UIDefinition
import iTasks.API.Core.SystemTypes, iTasks.API.Core.LayoutCombinators

import iTasks.Framework.Client.Override

from Data.Map						import qualified get, put, del, newMap, toList, fromList
from StdFunc					import id, const, o, seq
from iTasks						import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDecode
from iTasks.Framework.IWorld	import :: IWorld(..)
from iTasks.Framework.TaskEval	import localShare, parListShare, topListShare
from iTasks.API.Core.CoreTasks	import return
from Data.SharedDataSource			import write, writeFilterMsg, read, readRegister

derive class iTask ParallelTaskType, WorkOnStatus

getNextTaskId :: *IWorld -> (!TaskId,!*IWorld)
getNextTaskId iworld=:{currentInstance,nextTaskNo} = (TaskId currentInstance nextTaskNo, {IWorld|iworld & nextTaskNo = nextTaskNo + 1})

transform :: ((TaskValue a) -> TaskValue b) !(Task a) -> Task b | iTask a & iTask b 
transform f (Task evala) = Task eval
where
	eval event repOpts tree iworld = case evala event repOpts tree iworld of
		(ValueResult val lastEvent rep tree,iworld)	= (ValueResult (f val) lastEvent rep tree, iworld)	//TODO: guarantee stability
		(ExceptionResult e str, iworld)				= (ExceptionResult e str, iworld)
		(DestroyedResult, iworld)					= (DestroyedResult, iworld)

project	:: ((TaskValue a) r -> Maybe w) (ReadWriteShared r w) !(Task a) -> Task a | iTask a
project projection share (Task evala) = Task eval
where
	eval event repOpts (TCDestroy (TCProject taskId encprev treea)) iworld	//Cleanup duty simply passed to inner task
		= evala event repOpts (TCDestroy treea) iworld

	eval event repOpts state iworld
		# (taskId,prev,statea) = case state of
			(TCInit taskId _)					= (taskId,NoValue,state)
			(TCProject taskId encprev statea)	= (taskId,fromJust (fromJSON encprev),statea)
			
		# (resa, iworld) 	= evala event repOpts statea iworld
		= case resa of
			ValueResult val ts rep ncxta
				# result = ValueResult val ts rep (TCProject taskId (toJSON val) ncxta)
				| val =!= prev
					= projectOnShare val result iworld
				| otherwise
					= (result,iworld)
			ExceptionResult e str
				= (ExceptionResult e str,iworld)
	
	projectOnShare val result iworld=:{currentInstance}
		# (er, iworld) = read share iworld
   		= case er of
			Ok r = case projection val r of
				Just w
					# (ew, iworld) = write w share iworld
					= case ew of
						Ok _	= (result, iworld)
						Error e	= (exception e, iworld)
				Nothing = (result, iworld)
			Error e = (exception e, iworld)

step :: !(Task a) ((Maybe a) -> (Maybe b)) [TaskStep a b] -> Task b | iTask a & iTask b
step (Task evala) lhsValFun conts = Task eval
where
	eval event repOpts (TCInit taskId ts) iworld
		# (taskIda,iworld)	= getNextTaskId iworld
		= eval event repOpts (TCStep taskId ts (Left (TCInit taskIda ts))) iworld

	//Eval left-hand side
	eval event repOpts (TCStep taskId ts (Left treea)) iworld=:{taskTime}
		# (resa, iworld) 	= evala event {repOpts & appFinalLayout = False} treea iworld
		# ts				= case event of
							(FocusEvent _ focusId)	= if (focusId == taskId) taskTime ts
							_						= ts
		# mbcommit			= case event of
			(ActionEvent _ t action)
				| t == taskId 		= Just action
			_						= Nothing
		# mbCont			= case resa of
			ValueResult val info rep ntreea = case searchContValue val mbcommit conts of
				Nothing			
					# info = {TaskInfo|info & lastEvent = max ts info.TaskInfo.lastEvent}
                    # value = maybe NoValue (\v -> Value v False) (lhsValFun (case val of Value v _ = Just v; _ = Nothing))
					= Left (ValueResult value info (doStepLayout taskId repOpts rep val) (TCStep taskId info.TaskInfo.lastEvent (Left ntreea)) )
				Just rewrite	= Right (rewrite,Just ntreea, info.TaskInfo.lastEvent)
			ExceptionResult e str = case searchContException e str conts of
				Nothing			= Left (ExceptionResult e str)
				Just rewrite	= Right (rewrite,Nothing, ts)		//TODO: Figure out how to garbage collect after exceptions
		= case mbCont of
			Left res = (res,iworld)
			Right ((sel,Task evalb,d_json_a),mbTreeA, lastEvent)
				//Cleanup state of left-hand side
				# iworld	= case mbTreeA of
					Nothing		= iworld
					Just treea	= snd (evala (toRefresh event) {repOpts & appFinalLayout = False} (TCDestroy treea) iworld) //TODO: Check for exceptions during cleanup
				# (taskIdb,iworld)	= getNextTaskId iworld
				# (resb,iworld)		= evalb (toRefresh event) {repOpts & appFinalLayout = False} (TCInit taskIdb lastEvent) iworld 
				= case resb of
					ValueResult val info rep nstateb	
						# info = {TaskInfo|info & lastEvent = max ts info.TaskInfo.lastEvent}
						= (ValueResult val info (finalizeRep repOpts rep) (TCStep taskId info.TaskInfo.lastEvent (Right (d_json_a,sel,nstateb))),iworld)
					ExceptionResult e str				= (ExceptionResult e str, iworld)
	//Eval right-hand side
	eval event repOpts (TCStep taskId ts (Right (enca,sel,treeb))) iworld=:{taskTime}
		# ts				= case event of
							(FocusEvent _ focusId)	= if (focusId == taskId) taskTime ts
							_						= ts
		= case restoreTaskB sel enca of
			Just (Task evalb)
				# (resb, iworld)	= evalb event {repOpts & appFinalLayout = False} treeb iworld 
				= case resb of
					ValueResult val info rep ntreeb
						# info = {TaskInfo|info & lastEvent = max ts info.TaskInfo.lastEvent}
						= (ValueResult val info (finalizeRep repOpts rep) (TCStep taskId info.TaskInfo.lastEvent (Right (enca,sel,ntreeb))), iworld)
					ExceptionResult e str			= (ExceptionResult e str, iworld)
			Nothing
				= (exception "Corrupt task value in step", iworld) 	
	
	//Cleanup
	eval event repOpts (TCDestroy (TCStep taskId ts (Left treea))) iworld
		= case evala event repOpts (TCDestroy treea) iworld of
			(DestroyedResult,iworld)		= (DestroyedResult,iworld)
			(ExceptionResult e str,iworld)	= (ExceptionResult e str,iworld)
			(ValueResult _ _ _ _,iworld)	= (exception "Destroy failed in step",iworld)
	
	eval event repOpts (TCDestroy (TCStep taskId ts (Right(enca,sel,treeb)))) iworld
		= case restoreTaskB sel enca of
			Just (Task evalb)	= evalb event repOpts (TCDestroy treeb) iworld
			Nothing				= (exception "Corrupt task value in step", iworld)
			
	//Incorred state
	eval event _ state iworld
		= (exception ("Corrupt task state in step:" +++ (toString (toJSON state))), iworld)

	searchContValue val mbcommit conts = search val mbcommit 0 Nothing conts
	where
		search _ _ _ mbmatch []							= mbmatch									//No matching OnValue steps were found, return the potential match
		search val mbcommit i mbmatch [OnValue f:cs]
			= case f val of
				Just cont	= Just (i, cont, DeferredJSON val)			//Don't look any further, first matching trigger wins
				Nothing		= search val mbcommit (i + 1) mbmatch cs	//Keep search
		search val (Just commit) i Nothing [OnAction action f:cs]
			| commit == actionName action
				= case f val of
					Just cont	= search val (Just commit) (i + 1) (Just (i, cont, DeferredJSON val)) cs 	//We found a potential winner (if no OnValue values are in cs)
					Nothing		= search val (Just commit) (i + 1) Nothing cs								//Keep searching
			| otherwise
								= search val (Just commit) (i + 1) Nothing cs								//Keep searching														
		search val mbcommit i mbmatch [_:cs]			= search val mbcommit (i + 1) mbmatch cs			//Keep searching
		
	searchContException dyn str conts = search dyn str 0 Nothing conts
	where
		search _ _ _ catchall []					= catchall														//Return the maybe catchall
		search dyn str i catchall [OnException f:cs] = case (match f dyn) of
			Just (taskb,enca)						= Just (i, taskb, enca)											//We have a match
			_										= search dyn str (i + 1) catchall cs							//Keep searching
		search dyn str i Nothing [OnAllExceptions f:cs]	= search dyn str (i + 1) (Just (i, f str, DeferredJSON str)) cs //Keep searching (at least we have a catchall)
		search dyn str i mbcatchall [_:cs]			= search dyn str (i + 1) mbcatchall cs							//Keep searching
				
		match :: (e -> Task b) Dynamic -> Maybe (Task b, DeferredJSON) | iTask e
		match f (e :: e^)	= Just (f e, DeferredJSON e)
		match _ _			= Nothing 
	
	restoreTaskB sel d_json_a = case conts !! sel of
		(OnValue taskbf)			= call_with_DeferredJSON_TaskValue taskbf d_json_a
		(OnAction _ taskbf)			= call_with_DeferredJSON_TaskValue taskbf d_json_a
		(OnException taskbf)		= call_with_DeferredJSON taskbf d_json_a
		(OnAllExceptions taskbf)	= call_with_DeferredJSON taskbf d_json_a
	
	doStepLayout taskId repOpts NoRep val
		= finalizeRep repOpts (TaskRep ((repLayoutRules repOpts).LayoutRules.accuStep (UIActionSet []) (stepActions taskId val)) [])
	doStepLayout taskId repOpts (TaskRep def parts) val
        # parts` = [{TaskPart|taskId=toString taskId, tag=Nothing, repKind=ActionRep (action, isJust (taskbf val))} \\ OnAction (Action action _) taskbf <- conts] ++ parts
		= finalizeRep repOpts (TaskRep ((repLayoutRules repOpts).LayoutRules.accuStep def (stepActions taskId val)) parts`)
	stepActions taskId val = [{UIAction|taskId=toString taskId,action=action,enabled=isJust (taskbf val)}\\ OnAction action taskbf <- conts]

	call_with_DeferredJSON_TaskValue :: ((TaskValue a) -> (Maybe (Task .b))) DeferredJSON -> Maybe (Task .b) | TC a & JSONDecode{|*|} a
	call_with_DeferredJSON_TaskValue f_tva_tb d_json_tva=:(DeferredJSON tva)
        = f_tva_tb (cast_to_TaskValue tva)
	
	call_with_DeferredJSON_TaskValue f_tva_tb (DeferredJSONNode json)
		= case fromJSON json of
			Just a ->  f_tva_tb a
			Nothing -> Nothing
	
	call_with_DeferredJSON :: (a -> Task .b) DeferredJSON -> Maybe (Task .b) | TC a & JSONDecode{|*|} a
    call_with_DeferredJSON f_tva_tb d_json_tva=:(DeferredJSON tva)
        = Just (f_tva_tb (cast tva))

	call_with_DeferredJSON f_tva_tb (DeferredJSONNode json)
		= case fromJSON json of
			Just a ->  Just (f_tva_tb a)
			Nothing -> Nothing

// Parallel composition
parallel :: !d ![(!ParallelTaskType,!ParallelTask a)] -> Task [(!TaskTime,!TaskValue a)] | descr d & iTask a
parallel desc initTasks = Task eval
where
	//Create initial task list
	eval event repOpts (TCInit taskId ts) iworld=:{IWorld|localLists}
		//Append the initial tasks to the list 
		# iworld	= foldl append {iworld & localLists = 'Data.Map'.put taskId [] localLists} initTasks
		//Evaluate the parallel
		= eval event repOpts (TCParallel taskId ts) iworld
	where
		append iworld t = snd (appendTaskToList taskId t iworld)

	//Evaluate the task list
	eval event repOpts (TCParallel taskId ts) iworld=:{taskTime}
		//Evaluate all parallel tasks in the list
		= case evalParTasks taskId event repOpts iworld of
			(Just res=:(ExceptionResult e str),_,iworld)	= (res,iworld)
			(Just res=:(ValueResult _ _ _ _),_,iworld)		= (exception "parallel evaluation yielded unexpected result",iworld)
			(Nothing,results,iworld=:{localLists})
                # entries = [(e,r) \\ e <- (fromMaybe [] ('Data.Map'.get taskId localLists)) & r <- results]
				//Filter out removed entries and destroy their state
				# (removed,entries)	= splitWith (\({TaskListEntry|removed},_) -> removed) entries
				= case foldl destroyParTask (Nothing,iworld) (map fst removed) of
					(Just (ExceptionResult e str),iworld)	= (ExceptionResult e str,iworld)	//An exception occurred	
					(Just result,iworld)					= (fixOverloading result initTasks (exception "Destroy failed in parallel"),iworld)
					(Nothing,iworld=:{localLists})
						//Destruction is ok, build parallel result
						# rep				= parallelRep desc taskId repOpts entries
						# values			= map (toValueAndTime o fst) entries
						# stable			= all (isStable o snd) values
						# refreshSensitive	= foldr (\(e,_) s -> s || refreshSensitive e) False entries
						# ts				= foldr max 0 [ts:map fst values]
						# ts				= case event of
							(FocusEvent _ focusId)	= if (focusId == taskId) taskTime ts
							_						= ts
						= (ValueResult (Value values stable) {TaskInfo|lastEvent=ts,refreshSensitive=refreshSensitive}
							(finalizeRep repOpts rep) (TCParallel taskId ts),{iworld & localLists = 'Data.Map'.put taskId (map fst entries) localLists})
	//Cleanup
	eval event repOpts (TCDestroy (TCParallel taskId ts)) iworld=:{localLists}
		# entries = fromMaybe [] ('Data.Map'.get taskId localLists)
		= case foldl destroyParTask (Nothing,iworld) entries of
			(Nothing,iworld=:{localLists}) //All destroyed
				= (DestroyedResult,{iworld & localLists = 'Data.Map'.del taskId localLists})
			(Just (ExceptionResult e str),iworld=:{localLists}) //An exception occurred
				= (ExceptionResult e str,{iworld & localLists = 'Data.Map'.del taskId localLists})
			(Just result,iworld)
                = (fixOverloading result initTasks (exception "Destroy failed in step"),iworld)
	//Fallback
	eval _ _ _ iworld
		= (exception "Corrupt task state in parallel", iworld)
	
	evalParTasks :: !TaskId !Event !TaskRepOpts !*IWorld -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![Maybe TaskRep],!*IWorld) | iTask a
	evalParTasks taskId event repOpts iworld=:{localLists,eventRoute}
		= evalFrom 0 [] (fromMaybe [] ('Data.Map'.get taskId localLists)) ('Data.Map'.get taskId eventRoute) repOpts iworld
	where
		evalFrom n acc list mbEventIndex repOpts iworld = case foldl (evalParTask taskId event mbEventIndex repOpts) (Nothing,acc,iworld) [(i,e) \\ e <- drop n list & i <- [n..]]  of
			(Just (ExceptionResult e str),acc,iworld)	= (Just (ExceptionResult e str),acc,iworld)
			(Nothing,acc,iworld=:{localLists})			
				# nlist = fromMaybe [] ('Data.Map'.get taskId localLists)
				# lenlist = length list
				| length nlist > lenlist	= evalFrom lenlist acc nlist Nothing repOpts iworld	//Extra branches were added -> evaluate these as well 
											= (Nothing,acc,iworld)						        //Done
			//IMPORTANT: This last rule should never match, but it helps to solve overloading 
			(Just (ValueResult val info=:{TaskInfo|lastEvent} rep tree),acc,iworld) = (Just (ValueResult (Value [(lastEvent,val)] False) info rep tree),acc,iworld)
	
	evalParTask :: !TaskId !Event !(Maybe Int) !TaskRepOpts !(!Maybe (TaskResult a),![Maybe TaskRep],!*IWorld) !(!Int,!TaskListEntry) -> (!Maybe (TaskResult a),![Maybe TaskRep],!*IWorld) | iTask a
	//Evaluate embedded tasks
	evalParTask taskId event mbEventIndex repOpts (Nothing,acc,iworld=:{localTasks}) (index,{TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult jsonval info rep tree, removed=False})
		# evalNeeded = case mbEventIndex of
			Nothing	= True//We don't know the event index, so we just have to try
			Just eventIndex
				| eventIndex == index	= True								//The event is targeted at this branch, we evaluate
										= info.TaskInfo.refreshSensitive	//Also evaluate if the branch is refresh sensitive
		| evalNeeded
			//Evaluate the branch
			= case 'Data.Map'.get entryId localTasks of
				Just (Task evala :: Task a^)
					# (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False,noUI=repOpts.noUI} tree iworld
					= case result of
						ExceptionResult _ _
							= (Just result,acc,iworld)	
						ValueResult val info rep tree
							# (entry,iworld)	= updateListEntryEmbeddedResult taskId entryId result iworld
							= (Nothing, acc++[Just rep],iworld)
				_
					= (Nothing,acc,iworld)	
		| otherwise
			# (entry,iworld)	= updateListEntryEmbeddedResult taskId entryId (ValueResult jsonval info rep tree) iworld
			= (Nothing, acc++[Just rep],iworld)
					
	//Copy the last stored result of detached tasks
	evalParTask taskId=:(TaskId curInstanceNo _) event mbEventIndex noUI (Nothing,acc,iworld) (index,{TaskListEntry|entryId,state=DetachedState instanceNo _ _,removed=False})
		# (mbMeta,iworld)	= readRegister curInstanceNo (detachedInstanceMeta instanceNo) iworld
		# (mbResult,iworld)	= readRegister curInstanceNo (taskInstanceResult instanceNo) iworld
		= case (mbMeta,mbResult) of
			(Ok meta,Ok result)
				# (entry,iworld) = updateListEntryDetachedResult taskId entryId result meta.TIMeta.progress meta.TIMeta.management iworld
				= (Nothing,acc++[Nothing],iworld)
			_	= (Nothing,acc,iworld)	//TODO: remove from parallel if it can't be loaded (now it simply keeps the last known result)

	//Do nothing if an exeption occurred or marked as removed
	evalParTask taskId event mbEventIndex noUI (result,acc,iworld) (index,entry) = (result,acc,iworld) 

	destroyParTask :: (!Maybe (TaskResult a),!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),!*IWorld) | iTask a
	//Destroy embedded tasks
	destroyParTask (_,iworld=:{localTasks}) {TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult _ _ _ tree}
		= case 'Data.Map'.get entryId localTasks of
			Just (Task evala :: Task a^)
				# (result,iworld=:{localTasks}) = evala (RefreshEvent Nothing) {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False,noUI=True} (TCDestroy tree) iworld
				# iworld = {iworld & localTasks = 'Data.Map'.del entryId localTasks}
				= case result of
					DestroyedResult		= (Nothing,iworld)
					_					= (Just result,iworld)
			_
				= (Nothing,iworld)
	
	//Destroy detached tasks (Just delete the instance)
	destroyParTask (_,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _}
		= (Nothing,deleteInstance instanceNo iworld)
		
	toValueAndTime :: !TaskListEntry -> (!TaskTime,TaskValue a) | iTask a
	toValueAndTime {TaskListEntry|lastEval=ValueResult val _ _ _,lastEvent}	= (lastEvent,deserialize val)	
	where
		deserialize (Value json stable) = case fromJSON json of
			Nothing = NoValue
			Just a	= Value a stable
		deserialize NoValue	= NoValue
	toValueAndTime {TaskListEntry|lastEvent}						= (lastEvent,NoValue)
	
	parallelRep :: !d !TaskId !TaskRepOpts ![(!TaskListEntry,!Maybe TaskRep)] -> TaskRep | descr d
	parallelRep desc taskId repOpts entries
		# layout		= repLayoutRules repOpts
		# listId		= toString taskId
		# parts = [(uiDefSetAttribute LAST_EVENT_ATTRIBUTE (toString lastEvent) (uiDefSetAttribute CREATED_AT_ATTRIBUTE (toString createdAt) (uiDefSetAttribute TASK_ATTRIBUTE (toString entryId) def)))
					 \\ ({TaskListEntry|entryId,state=EmbeddedState,lastEval=ValueResult val _ _ _,createdAt,lastEvent,removed=False},Just (TaskRep def _)) <- entries | not (isStable val)]	
		= TaskRep (layout.LayoutRules.accuParallel (toPrompt desc) parts) []

	isStable (Value _ stable) 	= stable
	isStable _					= False

	refreshSensitive {TaskListEntry|lastEval=ValueResult _ {TaskInfo|refreshSensitive} _ _} = refreshSensitive
	refreshSensitive _ = True
	
	//Helper function to help type inferencing a little
	fixOverloading :: (TaskResult a) [(!ParallelTaskType,!ParallelTask a)] !b -> b
	fixOverloading _ _ x = x
						
//SHARED HELPER FUNCTIONS
appendTaskToList :: !TaskId !(!ParallelTaskType,!ParallelTask a) !*IWorld -> (!TaskId,!*IWorld) | iTask a
appendTaskToList taskId (parType,parTask) iworld=:{taskTime,currentUser,currentAttachment,currentDateTime,localTasks}
	# (list,iworld) = loadTaskList taskId iworld
	# progress = {issuedAt=currentDateTime,issuedBy=currentUser,stable=True,firstEvent=Nothing,latestEvent=Nothing}
	# (taskIda,name,state,iworld) = case parType of
		Embedded
			# (taskIda,iworld)	= getNextTaskId iworld
			# task		= parTask (parListShare taskId taskIda)
			= (taskIda, Nothing, EmbeddedState, {iworld & localTasks = 'Data.Map'.put taskIda (dynamic task :: Task a^) localTasks})
        NamedEmbedded name
			# (taskIda,iworld)	= getNextTaskId iworld
			# task		= parTask (parListShare taskId taskIda)
			= (taskIda, Just name, EmbeddedState, {iworld & localTasks = 'Data.Map'.put taskIda (dynamic task :: Task a^) localTasks})
		Detached management evalDirect
            # (instanceNo,iworld)                   = newInstanceNo iworld
			# task									= parTask (parListShare taskId (TaskId instanceNo 0))
			# (taskIda,iworld)	                    = createDetachedTaskInstance task (Just instanceNo) Nothing management currentUser taskId (if evalDirect (Just currentAttachment) Nothing) iworld
			= (taskIda,Nothing,DetachedState instanceNo progress management, iworld)
	    NamedDetached name management evalDirect
            # (instanceNo,iworld)                   = newInstanceNo iworld
			# task									= parTask (parListShare taskId (TaskId instanceNo 0))
			# (taskIda,iworld)	                    = createDetachedTaskInstance task (Just instanceNo) (Just name) management currentUser taskId (if evalDirect (Just currentAttachment) Nothing) iworld
			= (taskIda,Just name,DetachedState instanceNo progress management, iworld)
	# lastEval	= ValueResult NoValue {TaskInfo|lastEvent=taskTime,refreshSensitive=True} NoRep (TCInit taskIda taskTime)
	# entry		= {entryId = taskIda, name = name, state = state, lastEval = lastEval, attributes = 'Data.Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False}
	# iworld	= storeTaskList taskId (list ++ [entry]) iworld
	= (taskIda, iworld)		

updateListEntryEmbeddedResult :: !TaskId !TaskId (TaskResult a) !*IWorld -> (!TaskListEntry,!*IWorld) | iTask a
updateListEntryEmbeddedResult listId entryId result iworld
	= updateListEntry listId entryId (\e=:{TaskListEntry|state,lastEvent} ->
		{TaskListEntry|e & lastEval= wrap result, attributes = newAttr result, lastEvent = maxTime lastEvent result}) iworld
where
	wrap (ValueResult val info=:{TaskInfo|refreshSensitive=True} _ tree) //When we know for certain that we'll recompute the task on the next event, 
		= ValueResult (fmap toJSON val) info NoRep tree					 //don't bother storing the task representation
	wrap (ValueResult val info rep tree)	= ValueResult (fmap toJSON val) info rep tree
	wrap (ExceptionResult e str)			= ExceptionResult e str

	newAttr (ValueResult _ _ (TaskRep def _) _)					= uiDefAttributes def
	newAttr _													= 'Data.Map'.newMap
	
	maxTime cur (ValueResult _ {TaskInfo|lastEvent} _ _)		= max cur lastEvent
	maxTime cur _												= cur

updateListEntryDetachedResult :: !TaskId !TaskId (TaskResult JSONNode) !ProgressMeta !ManagementMeta !*IWorld -> (!TaskListEntry,!*IWorld)
updateListEntryDetachedResult listId entryId lastEval progress management iworld
	= updateListEntry listId entryId update iworld
where
	update e=:{TaskListEntry|state=DetachedState no _ _}
		= {TaskListEntry| e & state = DetachedState no progress management, lastEval = lastEval}
	update e = e

markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld
markListEntryRemoved listId entryId iworld
	= snd (updateListEntry listId entryId (\e -> {TaskListEntry|e & removed = True}) iworld)

updateListEntry :: !TaskId !TaskId !(TaskListEntry -> TaskListEntry) !*IWorld -> (!TaskListEntry,!*IWorld)
updateListEntry listId entryId f iworld
	# (list,iworld) = loadTaskList listId iworld
	# list			= [if (e.TaskListEntry.entryId == entryId) (f e) e \\ e <- list]	//TODO: MERGE AND OPTIZE WITH ITEM SEARCH
	# [item:_]		= [e \\ e <- list | (e.TaskListEntry.entryId == entryId)]
	# iworld		= storeTaskList listId list iworld
	= (item,iworld)

loadTaskList :: !TaskId !*IWorld -> (![TaskListEntry],!*IWorld)	
loadTaskList taskId=:(TaskId instanceNo taskNo) iworld=:{currentInstance,localLists}
	| instanceNo == currentInstance
		= (fromMaybe [] ('Data.Map'.get taskId localLists),iworld)
	| otherwise
		= case read (taskInstanceReduct instanceNo) iworld of
			(Ok {TIReduct|lists},iworld)	= (fromMaybe [] ('Data.Map'.get taskId lists),iworld)
			(_,iworld)						= ([],iworld)

storeTaskList :: !TaskId ![TaskListEntry] !*IWorld -> *IWorld	
storeTaskList taskId=:(TaskId instanceNo taskNo) list iworld=:{currentInstance,localLists}
	| instanceNo == currentInstance
		= {iworld & localLists = 'Data.Map'.put taskId list localLists}
	| otherwise
		= case read (taskInstanceReduct instanceNo) iworld of
			(Ok reduct=:{TIReduct|lists},iworld)	
				# (_,iworld) = write {TIReduct|reduct & lists = 'Data.Map'.put taskId list lists} (taskInstanceReduct instanceNo) iworld
				= iworld
			(_,iworld)								= iworld
			
readListId :: (SharedTaskList a) *IWorld -> (MaybeErrorString (TaskListId a),*IWorld)	| iTask a
readListId slist iworld = case read slist iworld of
	(Ok l,iworld)		= (Ok l.TaskList.listId, iworld)
	(Error e, iworld)	= (Error e, iworld)

//Derived shares
taskListState :: !(SharedTaskList a) -> ReadOnlyShared [TaskValue a]
taskListState tasklist = mapRead (\{TaskList|items} -> [value \\ {TaskListItem|value} <- items]) (toReadOnly tasklist)

taskListMeta :: !(SharedTaskList a) -> ReadWriteShared [TaskListItem a] [(TaskId,ManagementMeta)]
taskListMeta tasklist = mapRead (\{TaskList|items} -> items) tasklist

taskListSelfId :: !(SharedTaskList a) -> ReadOnlyShared TaskId
taskListSelfId tasklist = mapRead (\{TaskList|selfId} -> selfId) (toReadOnly tasklist)

taskListSelfManagement :: !(SharedTaskList a) -> Shared ManagementMeta
taskListSelfManagement tasklist = mapReadWriteError (toPrj,fromPrj) tasklist
where
    toPrj {TaskList|selfId,items} = case [meta \\ {TaskListItem|taskId,managementMeta=Just meta} <- items | taskId == selfId] of
        [meta:_]    = Ok meta
        _           = Error "Self management share is only available for detached tasks"

    fromPrj meta {TaskList|selfId}
        = Ok (Just [(selfId,meta)])

appendTask :: !ParallelTaskType !(ParallelTask a) !(SharedTaskList a) -> Task TaskId | iTask a
appendTask parType parTask slist = mkInstantTask eval
where
	eval taskId iworld=:{taskTime}
		= case readListId slist iworld of
			(Ok listId,iworld)
				# (taskIda,iworld) = append listId parType parTask iworld
				= (Ok taskIda, iworld)
			(Error e,iworld)
				= (Error (dynamic e,e), iworld)
								
	append :: !(TaskListId a) !ParallelTaskType !(ParallelTask a) !*IWorld -> (!TaskId,!*IWorld) | iTask a
	append TopLevelTaskList parType parTask iworld=:{currentUser,currentAttachment}
		# (name,meta,evalDirect) = case parType of
            (Embedded)                              = (Nothing,defaultValue,False)
            (NamedEmbedded name)                    = (Just name,defaultValue,False)
            (Detached meta evalDirect)              = (Nothing,meta,evalDirect)
            (NamedDetached name meta evalDirect)    = (Just name,meta,evalDirect)
		# task						= parTask topListShare
		= createDetachedTaskInstance task Nothing name meta currentUser (TaskId 0 0) (if evalDirect (Just currentAttachment) Nothing) iworld
	append (ParallelTaskList parId) parType parTask iworld
		= appendTaskToList parId (parType,parTask) iworld

/**
* Removes (and stops) a task from a task list
*/
removeTask :: !TaskId !(SharedTaskList a) -> Task Void | iTask a
removeTask entryId slist = mkInstantTask eval
where
	eval taskId iworld=:{taskTime}
		= case readListId slist iworld of
			(Ok listId,iworld)
				# iworld = remove listId entryId iworld
				= (Ok Void, iworld)
			(Error e,iworld)
				= (Error (dynamic e,e), iworld)

	remove :: !(TaskListId a) !TaskId !*IWorld -> *IWorld
	remove TopLevelTaskList (TaskId instanceNo 0) iworld
		= deleteInstance instanceNo iworld
	remove (ParallelTaskList parId) entryId iworld
		= markListEntryRemoved parId entryId iworld
	remove _ _ iworld = iworld

workOn :: !TaskId -> Task WorkOnStatus
workOn (TaskId instanceNo taskNo) = Task eval
where
	eval event repOpts (TCInit taskId ts) iworld=:{currentInstance,currentAttachment,currentUser}
		# (meta,iworld)		= read (detachedInstanceMeta instanceNo) iworld
		= case meta of
			Ok meta
                //Just steal the instance, TODO, make stealing optional
				# (_,iworld)	= write {TIMeta|meta & instanceType=AttachedInstance [taskId:currentAttachment] currentUser} (detachedInstanceMeta instanceNo) iworld
				# iworld		= queueUrgentEvaluate instanceNo iworld
				= eval event repOpts (TCBasic taskId ts JSONNull False) iworld
			Error e
				= (ExceptionResult (dynamic e) e,iworld)
		
	eval event repOpts tree=:(TCBasic taskId ts _ _) iworld=:{currentInstance,currentUser}
		//Load instance
		# (meta,iworld)		= readRegister currentInstance (detachedInstanceMeta instanceNo) iworld
		# (result,iworld)	= readRegister currentInstance (taskInstanceResult instanceNo) iworld
		# layout			= repLayoutRules repOpts
		= case (meta,result) of
			(_,Ok (ValueResult (Value _ True) _ _ _))
				= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts NoRep) tree, iworld)
			(_,Ok (ExceptionResult _ _))
				= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts NoRep) tree, iworld)
			(Ok meta=:{TIMeta|instanceType=AttachedInstance _ worker},Ok (ValueResult _ _ (TaskRep def parts) _))
				| worker == currentUser
					# rep = finalizeRep repOpts (TaskRep (layout.LayoutRules.accuWorkOn def meta) parts)
					= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts,refreshSensitive=True} rep tree, iworld)
				| otherwise
					# rep = finalizeRep repOpts (TaskRep (layout.LayoutRules.accuWorkOn (inUseDef worker) meta) parts)
					= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts,refreshSensitive=False} rep tree, iworld)		
			_
				= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts NoRep) tree, iworld)

	eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
        # (meta,iworld) = read detachedInstances iworld
        = case meta of
            Ok instances
                # (_,iworld) = write ('Data.Map'.fromList [(n,release taskId m) \\ (n,m) <- 'Data.Map'.toList instances]) detachedInstances iworld
                = (DestroyedResult,iworld)
		    _   = (DestroyedResult,iworld)

    release taskId meta=:{TIMeta|instanceType=AttachedInstance attachment worker}
        | isMember taskId attachment    = {meta & instanceType = DetachedInstance}
                                        = meta
    release taskId meta = meta

	inUseDef worker
		= UIControlStack {UIControlStack|attributes='Data.Map'.newMap,controls=[(stringDisplay (toString worker +++ " is working on this task"),'Data.Map'.newMap)]}
/*
* 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 eval) = Task eval`
where
	eval` event repOpts state iworld=:{currentUser}
		# (result,iworld) = eval event repOpts state {iworld & currentUser = user}
		= (result,{iworld & currentUser = currentUser})

withShared :: !b !((Shared b) -> Task a) -> Task a | iTask a & iTask b
withShared initial stask = Task eval
where	
	eval event repOpts (TCInit taskId ts) iworld=:{localShares}
		# localShares				= 'Data.Map'.put taskId (toJSON initial) localShares
		# (taskIda,iworld)			= getNextTaskId iworld
		= eval event repOpts (TCShared taskId ts (TCInit taskIda ts)) {iworld & localShares = localShares}
		
	eval event repOpts (TCShared taskId ts treea) iworld=:{taskTime}
		# ts						= case event of
			(FocusEvent _ focusId)	= if (focusId == taskId) taskTime ts
			_						= ts
		# (Task evala)				= stask (localShare taskId)
		# (resa,iworld)				= evala event repOpts treea iworld
		= case resa of
			ValueResult NoValue info rep ntreea
				# info = {TaskInfo|info & lastEvent = max ts info.TaskInfo.lastEvent}
				= (ValueResult NoValue info rep (TCShared taskId info.TaskInfo.lastEvent ntreea),iworld)
			ValueResult (Value stable val) info rep ntreea
				# info = {TaskInfo|info & lastEvent = max ts info.TaskInfo.lastEvent}
				= (ValueResult (Value stable val) info rep (TCShared taskId info.TaskInfo.lastEvent ntreea),iworld)
			ExceptionResult e str								= (ExceptionResult e str,iworld)
	
	eval event repOpts (TCDestroy (TCShared taskId ts treea)) iworld //First destroy inner task, then remove shared state
		# (Task evala)					= stask (localShare taskId)
		# (resa,iworld=:{localShares})	= evala event repOpts (TCDestroy treea) iworld
		= (resa,{iworld & localShares = 'Data.Map'.del taskId localShares})
	
	eval _ _ _ iworld
		= (exception "Corrupt task state in withShared", iworld)	
/*
* Tuning of tasks
*/
class tune b :: !b !(Task a) -> Task a
class tunev b a | iTask a :: !(b a) !(Task a) -> Task a

instance tune SetLayout
where
	tune (SetLayout layout) (Task eval)	= Task eval`
	where
		eval` event repOpts=:{useLayout=Nothing,modLayout} state iworld
			= eval event {TaskRepOpts|repOpts & useLayout = Just ((fromMaybe id modLayout) layout), modLayout = Nothing} state iworld 
		eval` event repOpts=:{useLayout=Just _,modLayout} state iworld
			= eval event {TaskRepOpts|repOpts & useLayout = Just layout, modLayout = Nothing} state iworld 
	
instance tune AfterLayout
where
	tune (AfterLayout f) (Task eval) = Task eval`
	where
		eval` event repOpts state iworld = case eval event repOpts state iworld of
	        (ValueResult value info rep tree,iworld) = (ValueResult value info (updRep rep) tree, iworld)
            (res,iworld) = (res,iworld)

        updRep NoRep               = TaskRep (f (UIAttributeSet 'Data.Map'.newMap)) []
        updRep (TaskRep def parts) = TaskRep (f def) parts
		
instance tune ModifyLayout
where
	tune (ModifyLayout f) (Task eval)	= Task eval`
	where
		eval` event repOpts=:{modLayout=Nothing} state iworld
			= eval event {TaskRepOpts|repOpts & modLayout = Just f} state iworld 
		eval` event repOpts=:{modLayout=Just g} state iworld
			= eval event {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld 	

instance tunev SetValueAttribute a
where
    tunev (SetValueAttribute attr f) (Task eval) = Task eval`
    where
		eval` event repOpts state iworld
            = case (eval event repOpts state iworld) of
		    	(ValueResult value=:(Value v _) info rep tree,iworld) = (ValueResult value info (updRep v rep) tree, iworld)
		    	(res,iworld) = (res,iworld)

        updRep v NoRep	             = TaskRep (UIAttributeSet ('Data.Map'.put attr (f v) 'Data.Map'.newMap)) []
        updRep v (TaskRep def parts) = TaskRep (uiDefSetAttribute attr (f v) def) parts
	
instance tune LazyRefresh
where
	tune _ (Task eval) = Task eval`
	where
		eval` event repOpts state iworld
			= case (eval event repOpts state iworld) of
				(ValueResult value info rep tree,iworld) = (ValueResult value {TaskInfo|info&refreshSensitive=False} rep tree, iworld)
				(res,iworld) = (res,iworld)