Core.icl 42.1 KB
Newer Older
1 2
implementation module iTasks.WF.Combinators.Core

Mart Lubbers's avatar
Mart Lubbers committed
3
import iTasks.WF.Tasks.Core
Mart Lubbers's avatar
Mart Lubbers committed
4 5 6
import StdEnv

import iTasks.WF.Derives
7 8 9 10
import iTasks.WF.Definition
import iTasks.UI.Definition
import iTasks.SDS.Definition

11
import iTasks.Engine
12
import iTasks.Internal.EngineTasks
13
import iTasks.Internal.DynamicUtil
14 15 16 17 18
import iTasks.Internal.Task
import iTasks.Internal.TaskState
import iTasks.Internal.TaskStore
import iTasks.Internal.TaskEval
import iTasks.Internal.IWorld
19
import iTasks.Internal.Util
20
import iTasks.Internal.AsyncSDS
21

22
from iTasks.SDS.Combinators.Common import sdsFocus, sdsSplit, sdsTranslate, toReadOnly, mapRead, mapReadWriteError, mapSingle, removeMaybe
Mart Lubbers's avatar
Mart Lubbers committed
23
import iTasks.WF.Combinators.Common
24
from iTasks.Internal.SDS import write, read, readRegister, modify
25

26
import iTasks.WF.Tasks.System
27 28

import qualified Data.Map as DM
29
import qualified Data.Set as DS
30 31
import qualified Data.Queue as DQ

32
import Data.Maybe, Data.Either, Data.Error, Data.Func
33
import Text.GenJSON
34
from Data.Functor import <$>, class Functor(fmap)
35
from Data.Map import qualified instance Functor (Map k)
36

37
derive gEq ParallelTaskChange
38 39 40

:: Action	= Action !String //Locally unique identifier for actions

Haye Böhm's avatar
Haye Böhm committed
41
:: ParallelTaskType
42 43 44 45 46 47 48
	= Embedded                                    //Simplest embedded
	| Detached !TaskAttributes !Bool              //Management meta and flag whether the task should be started at once

:: ParallelTask a	:== (SharedTaskList a) -> Task a

// Data available to parallel sibling tasks
:: TaskList a :== (!TaskId,![TaskListItem a])
49
:: SharedTaskList a :== SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)]
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

:: TaskListItem a =
	{ taskId			:: !TaskId
    , listId            :: !TaskId
    , detached          :: !Bool
    , self              :: !Bool
	, value				:: !TaskValue a
	, attributes        :: !TaskAttributes
	, progress		    :: !Maybe InstanceProgress //Only possible for detached tasks
	}

:: TaskListFilter =
    //Which rows to filter
    { onlyIndex         :: !Maybe [Int]
    , onlyTaskId        :: !Maybe [TaskId]
    , onlySelf          :: !Bool
    //What to include
    , includeValue      :: !Bool
    , includeAttributes :: !Bool
    , includeProgress   :: !Bool
    }
71
derive gDefault TaskListFilter, TaskId
72

73 74 75 76 77 78
instance toString AttachException
where
	toString InstanceNotFound	= "Cannot find task instance to attach"
	toString InstanceEvalError	= "Error in attached task instance "

derive class iTask AttachException
79

80
transformError :: ((TaskValue a) -> MaybeError TaskException (TaskValue b)) !(Task a) -> Task b
Mart Lubbers's avatar
Mart Lubbers committed
81
transformError f task = Task (eval task)
82
where
Mart Lubbers's avatar
Mart Lubbers committed
83
	eval (Task task) event evalOpts iworld = case task event evalOpts iworld of
Mart Lubbers's avatar
cleanup  
Mart Lubbers committed
84
		(ValueResult val lastEvent rep task, iworld) = case f val of
85
			Error e = (ExceptionResult e, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
86
			Ok v = (ValueResult v lastEvent rep (Task (eval task)), iworld)
Mart Lubbers's avatar
cleanup  
Mart Lubbers committed
87 88
		(ExceptionResult e, iworld)                  = (ExceptionResult e, iworld)
		(DestroyedResult, iworld)                    = (DestroyedResult, iworld)
89

90 91 92 93
removeDupBy :: (a a -> Bool) [a] -> [a]
removeDupBy eq [x:xs] = [x:removeDupBy eq (filter (not o eq x) xs)]
removeDupBy _ [] = []

94
step :: !(Task a) ((Maybe a) -> (Maybe b)) [TaskCont a (Task b)] -> Task b | TC, JSONEncode{|*|} a
Mart Lubbers's avatar
Mart Lubbers committed
95
step lhs lhsValFun conts = Task evalinit
96
where
Mart Lubbers's avatar
Mart Lubbers committed
97 98 99 100 101 102 103
	//Initial setup:
	//Destroyed before first evaluation
	//evalinit :: !Event !TaskEvalOpts !*IWorld -> *(TaskResult a, !*IWorld)
	evalinit DestroyEvent evalOpts iworld
		= (DestroyedResult,iworld)
	//Check for duplicates
	evalinit event evalOpts iworld
Mart Lubbers's avatar
Mart Lubbers committed
104
		# iworld = if (length (removeDupBy actionEq conts) == length conts)
105 106
			iworld
			(printStdErr "Duplicate actions in step" iworld)
Mart Lubbers's avatar
Mart Lubbers committed
107 108
		# (taskIda, iworld) = getNextTaskId iworld
		= evalleft lhs [] taskIda event evalOpts iworld
109 110 111
	where
		actionEq (OnAction (Action a) _) (OnAction (Action b) _) = a == b
		actionEq _ _ = False
112

Mart Lubbers's avatar
Mart Lubbers committed
113 114 115 116
	//Evaluating the lhs
	//Destroyed when executing the lhs
	//evalleft :: (Task a) [String] TaskId Event TaskEvalOpts !*IWorld -> *(TaskResult a, IWorld)
	evalleft (Task lhs) prevEnabledActions leftTaskId DestroyEvent evalOpts iworld
Mart Lubbers's avatar
Mart Lubbers committed
117
		= case lhs DestroyEvent {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld of
118 119 120
			(DestroyedResult, iworld)    = (DestroyedResult, iworld)
			(ExceptionResult e, iworld)  = (ExceptionResult e, iworld)
			(ValueResult _ _ _ _,iworld) = (ExceptionResult (exception "Failed destroying lhs in step"), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
121
	//Execute lhs
Mart Lubbers's avatar
Mart Lubbers committed
122 123 124 125 126 127
	evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts=:{lastEval,taskId} iworld
		# mbAction = matchAction taskId event
		# (res, iworld) = lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
		// Right  is a step
		# (mbCont, iworld) = case res of
			ValueResult val info rep lhs
Mart Lubbers's avatar
Mart Lubbers committed
128 129 130
				= case searchContValue val mbAction conts of
					//No match
					Nothing
Mart Lubbers's avatar
Mart Lubbers committed
131
						# info = {TaskEvalInfo|info & lastEvent = max lastEval info.TaskEvalInfo.lastEvent}
Mart Lubbers's avatar
Mart Lubbers committed
132 133 134
						# value = maybe NoValue (\v -> Value v False) (lhsValFun (case val of Value v _ = Just v; _ = Nothing))
						# actions = contActions taskId val conts
						# curEnabledActions = [actionId action \\ action <- actions | isEnabled action]
135
						# sl = wrapStepUI taskId evalOpts event actions prevEnabledActions val rep
Mart Lubbers's avatar
Mart Lubbers committed
136 137 138 139 140 141 142
						= (Left (ValueResult
							value
							info
							sl
							(Task (evalleft lhs curEnabledActions leftTaskId))
							)
						, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
143
					//A match
Mart Lubbers's avatar
Mart Lubbers committed
144
					Just rewrite
Mart Lubbers's avatar
Mart Lubbers committed
145 146
						//Send a destroyevent to the lhs
						# (_, iworld) = (unTask lhs) DestroyEvent {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
147 148
						= (Right (rewrite, info.TaskEvalInfo.lastEvent, info.TaskEvalInfo.removedTasks), iworld)
			ExceptionResult e
Mart Lubbers's avatar
Mart Lubbers committed
149
				= case searchContException e conts of
Mart Lubbers's avatar
Mart Lubbers committed
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
					//No match
					Nothing      = (Left (ExceptionResult e), iworld)
					//A match
					Just rewrite = (Right (rewrite, lastEval, []), iworld)
		= case mbCont of
			//No match, just pass through
			Left res = (res, iworld)
			//A match, continue with the matched rhs
			Right ((_, (Task rhs), _), lastEvent, removedTasks)
				//Execute the rhs with a reset event
				# (resb, iworld)        = rhs ResetEvent evalOpts iworld
				= case resb of
					ValueResult val info change=:(ReplaceUI _) (Task rhs)
						# info = {TaskEvalInfo|info & lastEvent = max lastEvent info.TaskEvalInfo.lastEvent, removedTasks = removedTasks ++ info.TaskEvalInfo.removedTasks}
						= (ValueResult
							val
							info
							change
							//Actually rewrite to the rhs
							(Task rhs)
						,iworld)
					ValueResult _ _ change _
						= (ExceptionResult (exception ("Reset event of task in step failed to produce replacement UI: ("+++ toString (toJSON change)+++")")), iworld)
					ExceptionResult e = (ExceptionResult e, iworld)
174

175
	wrapStepUI taskId evalOpts event actions prevEnabled val change
176 177 178 179 180 181
		| actionUIs =: []
			= case (event,change) of
				(ResetEvent,ReplaceUI (UI type attributes items)) //Mark the ui as a step
					= ReplaceUI (UI type (addClassAttr "step" attributes) items)
				_
					= change
Mart Lubbers's avatar
Mart Lubbers committed
182
		| otherwise	//Wrap in a container
183 184 185 186 187
			= case (event,change) of
				(ResetEvent,ReplaceUI ui) //On reset generate a new step UI
					= ReplaceUI (uiac UIContainer (classAttr ["step-actions"]) [ui:actionUIs])
				_  //Otherwise create a compound change definition
					= ChangeUI [] [(0,ChangeChild change):actionChanges]
188
	where
189
		actionUIs = contActions taskId val conts
190 191 192 193 194 195 196
		actionChanges = [(i,ChangeChild (switch (isEnabled ui) (actionId ui))) \\ ui <- actions & i <- [1..]]
		where
			switch True name = if (isMember name prevEnabled) NoChange (ChangeUI [SetAttribute "enabled" (JSONBool True)] [])
			switch False name = if (isMember name prevEnabled) (ChangeUI [SetAttribute "enabled" (JSONBool False)] []) NoChange

matchAction :: TaskId Event -> Maybe String
matchAction taskId (ActionEvent matchId action)
197 198
	| matchId == taskId = Just action
matchAction taskId _ = Nothing
199 200 201 202 203 204 205 206 207 208 209

isEnabled (UI _ attr _) = maybe False (\(JSONBool b) -> b) ('DM'.get "enabled" attr)
actionId (UI _ attr _) = maybe "" (\(JSONString s) -> s) ('DM'.get "actionId" attr)

contActions :: TaskId (TaskValue a) [TaskCont a b]-> [UI]
contActions taskId val conts = [actionUI (isJust (taskbf val)) action\\ OnAction action taskbf <- conts]
where
	actionUI enabled action=:(Action actionId)
		= uia UIAction ('DM'.unions [enabledAttr enabled, taskIdAttr (toString taskId), actionIdAttr actionId])

searchContValue :: (TaskValue a) (Maybe String) [TaskCont a b] -> Maybe (!Int, !b, !DeferredJSON) | TC a & JSONEncode{|*|} a
Mart Lubbers's avatar
Mart Lubbers committed
210 211
searchContValue val mbAction conts
	= search val mbAction 0 Nothing conts
212
where
Mart Lubbers's avatar
Mart Lubbers committed
213
	search _ _ _ mbMatch []							= mbMatch		//No matching OnValue steps were found, return the potential match
214
	search val mbAction i mbMatch [OnValue f:cs]
215
		= case f val of
216 217
			Just cont	= Just (i, cont, DeferredJSON val)			//Don't look any further, first matching trigger wins
			Nothing		= search val mbAction (i + 1) mbMatch cs	//Keep search
Mart Lubbers's avatar
Mart Lubbers committed
218 219 220 221 222 223 224
	search val mbAction=:(Just actionEvent) i Nothing [OnAction (Action actionName) f:cs]
		| actionEvent == actionName
			= case f val of
				Just cont = search val mbAction (i + 1) (Just (i, cont, DeferredJSON val)) cs 	//We found a potential winner (if no OnValue values are in cs)
				Nothing = search val mbAction (i + 1) Nothing cs								//Keep searching
		= search val mbAction (i + 1) Nothing cs								//Keep searching
	search val mbAction i mbMatch [_:cs]			= search val mbAction (i + 1) mbMatch cs		//Keep searching
225 226 227 228

searchContException :: (Dynamic,String) [TaskCont a b] -> Maybe (Int, !b, !DeferredJSON)
searchContException (dyn,str) conts = search dyn str 0 Nothing conts
where
Mart Lubbers's avatar
Mart Lubbers committed
229 230 231 232 233 234
	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
Haye Böhm's avatar
Haye Böhm committed
235

Mart Lubbers's avatar
Mart Lubbers committed
236 237 238
	match :: (e -> b) Dynamic -> Maybe (b, DeferredJSON) | iTask e
	match f (e :: e^)    = Just (f e, DeferredJSON e)
	match _ _            = Nothing
239 240

// Parallel composition
241
parallel :: ![(ParallelTaskType,ParallelTask a)] [TaskCont [(Int,TaskValue a)] (ParallelTaskType,ParallelTask a)] -> Task [(Int,TaskValue a)] | iTask a
Mart Lubbers's avatar
Mart Lubbers committed
242
parallel initTasks conts = Task evalinit
243
where
Mart Lubbers's avatar
Mart Lubbers committed
244 245
	//Destroyed before initial execution
	evalinit DestroyEvent _ iworld
Mart Lubbers's avatar
Mart Lubbers committed
246
		= (DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
247 248 249
	//Initialize the task list
	evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
	//Create the states for the initial tasks
Mart Lubbers's avatar
Mart Lubbers committed
250 251 252 253
		= case initParallelTasks evalOpts taskId 0 initTasks iworld of
			(Ok (taskList,embeddedTasks),iworld)
				//Write the local task list
				# taskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
Mart Lubbers's avatar
Mart Lubbers committed
254
				# (e,iworld) = (write taskList (sdsFocus (taskId, taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld)
Mart Lubbers's avatar
Mart Lubbers committed
255 256 257 258 259
				| isError e = (ExceptionResult (fromError e),iworld)
				//Write the local embedded tasks
				# (e,iworld) = writeAll embeddedTasks taskInstanceEmbeddedTask iworld
				| isError e = (ExceptionResult (fromError e),iworld)
				//Evaluate the parallel
Mart Lubbers's avatar
Mart Lubbers committed
260
				= eval (length embeddedTasks) [] event evalOpts iworld
Mart Lubbers's avatar
Mart Lubbers committed
261 262 263 264 265 266 267 268
			(Error err,iworld)
				= (ExceptionResult err, iworld)
	where
		writeAll [] sds iworld = (Ok WritingDone,iworld)
		writeAll [(f,w):ws] sds iworld
			= case (write w (sdsFocus f sds) EmptyContext iworld) of
				(Ok WritingDone, iworld) = writeAll ws sds iworld
				(Ok _, iworld) = (Error (exception "Asynchronous tasklist share???"), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
269 270
				err = err

Mart Lubbers's avatar
Mart Lubbers committed
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
		initParallelTasks _ _ _ [] iworld = (Ok ([],[]),iworld)
		initParallelTasks evalOpts listId index [(parType,parTask):parTasks] iworld
			# (mbStateMbTask, iworld) = initParallelTask evalOpts listId index parType parTask iworld
			= case mbStateMbTask of
					Ok (state,mbTask)
						# (mbStateTasks, iworld) = initParallelTasks evalOpts listId (index + 1) parTasks iworld
						= case mbStateTasks of
								Ok (states,tasks)
									= (Ok ([state:states], maybe tasks (\task -> [task:tasks]) mbTask), iworld)
								err = (err, iworld)
					err = (liftError err, iworld)

	eval _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
		= destroyParallelTasks taskId iworld

Mart Lubbers's avatar
Mart Lubbers committed
286
	//Evaluate the task list
Mart Lubbers's avatar
Mart Lubbers committed
287
	eval prevNumBranches prevEnabledActions event evalOpts=:{TaskEvalOpts|taskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
288
		//Evaluate all branches of the parallel set
Mart Lubbers's avatar
Mart Lubbers committed
289 290
		= case evalParallelTasks event evalOpts conts [] [] iworld of
			(Ok results, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
291
				//Construct the result
Mart Lubbers's avatar
Mart Lubbers committed
292 293 294 295 296
				# results   = reverse results //(the results are returned in reverse order)
				# value     = genParallelValue results
				# evalInfo  = genParallelEvalInfo results
				# actions   = contActions taskId value conts
				# rep       = genParallelRep evalOpts event actions prevEnabledActions results prevNumBranches
Mart Lubbers's avatar
Mart Lubbers committed
297
				# curEnabledActions = [actionId action \\ action <- actions | isEnabled action]
298 299
				# curNumBranches = length [()\\(ValueResult _ _ _ _)<-results]
				= (ValueResult value evalInfo rep (Task (eval curNumBranches curEnabledActions)), iworld)
300
			//Stopped because of an unhandled exception
Mart Lubbers's avatar
Mart Lubbers committed
301
			(Error e, iworld)
302
				//Clean up before returning the exception
Mart Lubbers's avatar
Mart Lubbers committed
303
				# (res,iworld) = destroyParallelTasks taskId iworld
304
				= (exceptionResult res e,iworld)
305
	where
306
		exceptionResult :: (TaskResult [(Int,TaskValue a)]) TaskException -> (TaskResult [(Int,TaskValue a)])
307 308
		exceptionResult DestroyedResult e = ExceptionResult e
		exceptionResult (ExceptionResult _) e = ExceptionResult e
309

Mart Lubbers's avatar
Mart Lubbers committed
310
		genParallelEvalInfo :: [TaskResult a] -> TaskEvalInfo
311
		genParallelEvalInfo results = foldr addResult {TaskEvalInfo|lastEvent=0,removedTasks=[]} results
Mart Lubbers's avatar
Mart Lubbers committed
312 313 314 315
		where
			addResult (ValueResult _ i1 _ _) i2
				# lastEvent = max i1.TaskEvalInfo.lastEvent i2.TaskEvalInfo.lastEvent
				# removedTasks = i1.TaskEvalInfo.removedTasks ++ i2.TaskEvalInfo.removedTasks
316
				= {TaskEvalInfo|lastEvent=lastEvent,removedTasks=removedTasks}
Mart Lubbers's avatar
Mart Lubbers committed
317
			addResult _ i = i
318 319 320 321 322 323 324 325 326 327


initParallelTask ::
	!TaskEvalOpts
	!TaskId
	!Int
	!ParallelTaskType
	!(ParallelTask a)
	!*IWorld
	->
Mart Lubbers's avatar
Mart Lubbers committed
328
	(!MaybeError TaskException (ParallelTaskState, Maybe (TaskId,Task a)), !*IWorld)
329
	| iTask a
Mart Lubbers's avatar
Mart Lubbers committed
330
initParallelTask evalOpts listId index parType parTask iworld=:{current={taskTime}}
Mart Lubbers's avatar
Mart Lubbers committed
331
	# (mbTaskStuff,iworld) = case parType of
Mart Lubbers's avatar
Mart Lubbers committed
332
		Embedded                                 = mkEmbedded 'DM'.newMap iworld
Mart Lubbers's avatar
Mart Lubbers committed
333 334 335 336 337
		Detached           attributes evalDirect = mkDetached attributes evalDirect iworld
	= case mbTaskStuff of
		Ok (taskId,attributes,mbTask)
			# state =
				{ ParallelTaskState
Mart Lubbers's avatar
Mart Lubbers committed
338 339 340
				| taskId      = taskId
				, index       = index
				, detached    = isNothing mbTask
Bas Lijnse's avatar
Bas Lijnse committed
341 342
				, implicitAttributes = 'DM'.newMap
				, explicitAttributes = fmap (\x -> (x,True)) attributes
Mart Lubbers's avatar
Mart Lubbers committed
343 344 345 346 347
				, value       = NoValue
				, createdAt   = taskTime
				, lastEvent   = taskTime
				, change      = Nothing
				, initialized = False
Mart Lubbers's avatar
Mart Lubbers committed
348 349 350
				}
			= (Ok (state,mbTask),iworld)
		err = (liftError err, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
351
where
Mart Lubbers's avatar
Mart Lubbers committed
352 353 354 355 356 357 358 359 360 361 362 363
	mkEmbedded attributes iworld
		# (taskId,iworld) = getNextTaskId iworld
		# task            = parTask (sdsTranslate "setTaskAndList" (\listFilter -> (listId,taskId,listFilter)) parallelTaskList)
		= (Ok (taskId, attributes, Just (taskId,task)), iworld)
	mkDetached attributes evalDirect iworld
		# (mbInstanceNo,iworld) = newInstanceNo iworld
		= case mbInstanceNo of
			Ok instanceNo
				# isTopLevel        = listId == TaskId 0 0
				# listShare         = if isTopLevel topLevelTaskList (sdsTranslate "setTaskAndList" (\listFilter -> (listId,TaskId instanceNo 0,listFilter)) parallelTaskList)
				# (mbTaskId,iworld) = createDetachedTaskInstance (parTask listShare) isTopLevel evalOpts instanceNo attributes listId evalDirect iworld
				= case mbTaskId of
Mart Lubbers's avatar
Mart Lubbers committed
364
					Ok taskId = (Ok (taskId, attributes, Nothing), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
365 366
					err       = (liftError err, iworld)
			err = (liftError err, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
367

Mart Lubbers's avatar
Mart Lubbers committed
368
evalParallelTasks :: !Event !TaskEvalOpts
369
	[TaskCont [(TaskTime,TaskValue a)] (ParallelTaskType,ParallelTask a)]
Mart Lubbers's avatar
Mart Lubbers committed
370
	[(TaskId, TaskResult a)] [ParallelTaskState] !*IWorld
371
	->
372
	(MaybeError TaskException [TaskResult a],!*IWorld) | iTask a
Mart Lubbers's avatar
Mart Lubbers committed
373
evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [] iworld
Mart Lubbers's avatar
Mart Lubbers committed
374 375 376 377 378 379 380 381 382
	//(re-)read the tasklist to check if it contains items we have not yet evaluated
	# taskListFilter        = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
	# (mbList,iworld)       = read (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
	| mbList =:(Error _)    = (Error (fromError mbList),iworld)
	= case drop (length completed) (directResult (fromOk mbList)) of
		//We are done, unless we have continuations that extend the set
		[]  = case searchContValue (genParallelValue (reverse (map snd completed))) (matchAction listId event) conts of
			Nothing //We have evaluated all branches and nothing is added
				//Remove all entries that are marked as removed from the list, they have been cleaned up by now
Bas Lijnse's avatar
Bas Lijnse committed
383 384
				# taskListFilter      = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeAttributes=True,includeProgress=False}

385
                # (mbError,iworld)      = modify (\l -> [clearExplicitAttributeChange x \\ x <- l | not (isRemoved x)])
386
											(sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
Mart Lubbers's avatar
Mart Lubbers committed
387
				| mbError =:(Error _) = (Error (fromError mbError),iworld)
388
				//Bit of a hack... find updated attributes
Bas Lijnse's avatar
Bas Lijnse committed
389 390
				# completed = reverse [(t,addAttributeChanges explicitAttributes c) \\ (t,c) <- reverse completed & {ParallelTaskState|explicitAttributes} <- directResult (fromOk mbList) ]
                = (Ok (map snd completed),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
391 392 393

			Just (_,(type,task),_) //Add extension
				# (mbStateMbTask, iworld) = initParallelTask evalOpts listId 0 type task iworld
Mart Lubbers's avatar
Mart Lubbers committed
394 395
				= case mbStateMbTask of
					Ok (state,mbTask)
Mart Lubbers's avatar
Mart Lubbers committed
396 397 398 399 400 401 402 403 404
					  //Update the task list (TODO, be specific about what we are writing here)
					  # taskListFilter            = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
					  # (mbError,iworld)          = modify (\states -> states ++ [{ParallelTaskState|state & index = length states}]) (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
					  | mbError =:(Error _)       = (liftError mbError,iworld)
					  # taskId                    = state.ParallelTaskState.taskId
					  //Store the task function
					  # (mbError,iworld)          = (write (snd (fromJust mbTask)) (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld)
					  | mbError =:(Error _)       = (liftError mbError,iworld)
					  = evalParallelTasks ResetEvent evalOpts conts completed [state] iworld //Continue
Mart Lubbers's avatar
Mart Lubbers committed
405
					err = (liftError err, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
406 407
		//There is more work to do:
		todo    = evalParallelTasks event evalOpts conts completed todo iworld
408 409 410 411
where
	isRemoved {ParallelTaskState|change=Just RemoveParallelTask} = True
	isRemoved _ = False

412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428
	addAttributeChanges explicitAttributes (ValueResult val evalInfor rep tree)
		//Add the explicit attributes
		# rep = case rep of
			ReplaceUI (UI type attr items)
				# expAtt = 'DM'.fromList [(k,v) \\ (k,(v,True)) <- 'DM'.toList explicitAttributes]
				= (ReplaceUI (UI type ('DM'.union expAtt attr) items))
			ChangeUI attrChanges itemChanges
				# expChanges = [SetAttribute k v \\ (k,(v,True)) <- 'DM'.toList explicitAttributes]
				= (ChangeUI (attrChanges ++ expChanges) itemChanges)
			NoChange = case [SetAttribute k v \\ (k,(v,True)) <- 'DM'.toList explicitAttributes] of
				[] = NoChange
				attrChanges = (ChangeUI attrChanges [])
		= (ValueResult val evalInfor rep tree)
	addAttributeChanges explicitAttributes c = c

	clearExplicitAttributeChange pts=:{ParallelTaskState|explicitAttributes} = {pts & explicitAttributes = fmap (\(v,_) -> (v,False)) explicitAttributes}

429
//Evaluate an embedded parallel task
Mart Lubbers's avatar
Mart Lubbers committed
430 431
evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [t=:{ParallelTaskState|taskId=taskId=:(TaskId _ taskNo)}:todo] iworld
	= case evalParallelTask listId event evalOpts t iworld of
432
		(Error e, iworld) = (Error e,iworld)
433
		(Ok (ExceptionResult e), iworld) = (Error e,iworld) //Stop on exceptions
434
		(Ok result=:(ValueResult val {TaskEvalInfo|lastEvent,removedTasks} rep task), iworld)
435
			//Add the current result before checking for removals
Mart Lubbers's avatar
Mart Lubbers committed
436
			# completed = [(taskId, result):completed]
437 438 439
			//Check if in the branch tasks from this list were removed but that were already evaluated
			# removed = [t \\ (l,t=:(TaskId _ n)) <- removedTasks | l == listId && n <= taskNo]
			# (completed,iworld) = destroyRemoved listId removed completed iworld
Mart Lubbers's avatar
Mart Lubbers committed
440
			= evalParallelTasks event evalOpts conts completed todo iworld
441
		(Ok result=:DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
442 443 444 445 446 447 448 449 450
			= evalParallelTasks event evalOpts conts [(taskId, result):completed] todo iworld
where
	evalParallelTask :: TaskId !Event !TaskEvalOpts ParallelTaskState !*IWorld
		-> *(MaybeError TaskException (TaskResult a), !*IWorld) | iTask a
	evalParallelTask listId event evalOpts taskState=:{ParallelTaskState|detached} iworld
		| detached  = evalDetachedParallelTask listId event evalOpts taskState iworld
		            = evalEmbeddedParallelTask listId event evalOpts taskState iworld

	evalEmbeddedParallelTask listId event evalOpts
Bas Lijnse's avatar
Bas Lijnse committed
451
		{ParallelTaskState|taskId,createdAt,value,change,initialized} iworld=:{current={taskTime}}
Mart Lubbers's avatar
Mart Lubbers committed
452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
		//Lookup task evaluation function and task evaluation state
		# (mbTask,iworld) = read (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld
		| mbTask =:(Error _) = (Error (fromError mbTask),iworld)
		# (Task evala) = directResult (fromOk mbTask)
		//Evaluate or destroy branch
		| change === Just RemoveParallelTask
			# (result, iworld) = destroyEmbeddedParallelTask listId taskId iworld
			= case result of
				(Ok res) = (Ok res,iworld)
				(Error e) = (Error (exception (ExceptionList e)), iworld)
		//Evaluate new branches with a reset event, other with the event
		= case evala (if initialized event ResetEvent) {TaskEvalOpts|evalOpts&taskId=taskId} iworld of
			//If an exception occured, check if we can handle it at this level
			(ExceptionResult e, iworld)
				//TODO Check exception
				//If the exception can not be handled, don't continue evaluating just stop
				= (Ok (ExceptionResult e),iworld)
469
			(ValueResult val evalInfo=:{TaskEvalInfo|lastEvent,removedTasks} rep task, iworld)
Bas Lijnse's avatar
Bas Lijnse committed
470
				# result = ValueResult val evalInfo rep task
471
				# implicitAttributeUpdate = case rep of
472 473 474
					ReplaceUI (UI _ attributes _) = const attributes
					ChangeUI changes _ = \a -> foldl (flip applyUIAttributeChange) a changes
					_ = id
Mart Lubbers's avatar
Mart Lubbers committed
475 476 477 478 479
				//Check if the value changed
				# valueChanged = val =!= decode value
				//Write the new reduct
				# (mbError, iworld) = write task (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld
				| mbError =:(Error _) = (Error (fromError mbError), iworld)
480
                //Write updated value
481
                # (mbError,iworld) = if valueChanged
482
                    (modify
483
						(\pts -> {ParallelTaskState|pts & value = encode val,
Bas Lijnse's avatar
Bas Lijnse committed
484
							implicitAttributes = implicitAttributeUpdate pts.ParallelTaskState.implicitAttributes,initialized = True})
485
                        (sdsFocus (listId,taskId,True) taskInstanceParallelTaskListItem)
486
						EmptyContext iworld)
487
                    (modify
488
						(\pts -> {ParallelTaskState|pts &
Bas Lijnse's avatar
Bas Lijnse committed
489
							implicitAttributes = implicitAttributeUpdate pts.ParallelTaskState.implicitAttributes, initialized = True})
490
                        (sdsFocus (listId,taskId,False) taskInstanceParallelTaskListItem)
491
						EmptyContext iworld)
Mart Lubbers's avatar
Mart Lubbers committed
492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
				| mbError =:(Error _) = (Error (fromError mbError),iworld)
					= (Ok result,iworld)
	where
		encode NoValue      = NoValue
		encode (Value v s)  = Value (DeferredJSON v) s
	
		decode NoValue     = NoValue
		decode (Value v s) = Value (fromMaybe (abort "invalid parallel task state\n") $ fromDeferredJSON v) s
	
		(TaskId instanceNo taskNo)   = taskId
	
	//Retrieve result of detached parallel task
	evalDetachedParallelTask :: !TaskId !Event !TaskEvalOpts !ParallelTaskState !*IWorld -> *(MaybeError TaskException (TaskResult a), *IWorld) | iTask a
	evalDetachedParallelTask listId event evalOpts {ParallelTaskState|taskId=taskId=:(TaskId instanceNo _)} iworld
		= case readRegister listId (sdsFocus instanceNo (removeMaybe Nothing taskInstanceValue)) iworld of
			(Error e,iworld) = (Error e,iworld)
			(Ok (ReadingDone (TIException dyn msg)),iworld) = (Ok (ExceptionResult (dyn,msg)),iworld)
			(Ok (ReadingDone (TIValue encValue)),iworld)
				//Decode value value
				# mbValue = case encValue of
					NoValue           = Just NoValue
					Value json stable = (\dec -> Value dec stable) <$> fromDeferredJSON json
				//TODO: use global tasktime to be able to compare event times between instances
515
				# evalInfo = {TaskEvalInfo|lastEvent=0,removedTasks=[]}
Mart Lubbers's avatar
Mart Lubbers committed
516 517 518 519 520 521 522
				# result = maybe (ExceptionResult (exception "Could not decode task value of detached task"))
					(\val -> ValueResult val evalInfo NoChange nopTask) mbValue
				= (Ok result,iworld)

destroyParallelTasks :: !TaskId !*IWorld -> *(TaskResult [(Int,TaskValue a)], *IWorld) | iTask a
destroyParallelTasks listId=:(TaskId instanceNo _) iworld
	// Unlink registrations for all detached tasks
523
	# iworld = clearTaskSDSRegistrations ('DS'.singleton listId) iworld
Mart Lubbers's avatar
Mart Lubbers committed
524
	= case read (sdsFocus (listId, minimalTaskListFilter) taskInstanceParallelTaskList) EmptyContext iworld of
Mart Lubbers's avatar
Mart Lubbers committed
525
		(Error e,iworld) = (ExceptionResult e, iworld)
Haye Böhm's avatar
Haye Böhm committed
526
		(Ok (ReadingDone taskStates),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
527 528 529
			// Destroy all child tasks (`result` is always `DestroyedResult` but passed to solve overloading
			# (result,exceptions,iworld) = foldl (destroyParallelTask listId) (DestroyedResult, [], iworld) taskStates
			// Remove the (shared) tasklist
Mart Lubbers's avatar
Mart Lubbers committed
530
			# (exceptions,iworld) = case modify (fmap (\m -> 'DM'.del listId m)) (sdsFocus instanceNo taskInstanceParallelTaskLists) EmptyContext iworld of
Haye Böhm's avatar
Haye Böhm committed
531
				(Ok (ModifyingDone _),iworld) = (exceptions,iworld)
532 533
				(Error e,iworld) = ([e:exceptions],iworld)
			| exceptions =: []
534
				= (destroyResult result, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
535
			= (ExceptionResult (exception (ExceptionList exceptions)), iworld)
536 537 538 539
where
	minimalTaskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False
	                        ,includeValue=False,includeAttributes=False,includeProgress=False}

Mart Lubbers's avatar
Mart Lubbers committed
540 541 542 543
	destroyParallelTask listId (_,exceptions,iworld) {ParallelTaskState|taskId,detached}
		= case (if detached destroyDetachedParallelTask destroyEmbeddedParallelTask) listId taskId iworld of
			(Error e, iworld) = (DestroyedResult, e ++ exceptions,iworld)
			(Ok res, iworld) = (res, exceptions,iworld)
544

545
	destroyResult :: (TaskResult a) -> (TaskResult [(Int,TaskValue a)])
546 547
	destroyResult DestroyedResult = DestroyedResult
	destroyResult (ExceptionResult e) = ExceptionResult e
Mart Lubbers's avatar
Mart Lubbers committed
548
	destroyResult (ValueResult _ _ _ _) = ExceptionResult (exception "Valueresult in a destroy?")
549

Mart Lubbers's avatar
Mart Lubbers committed
550 551
destroyEmbeddedParallelTask :: TaskId TaskId *IWorld -> *(MaybeError [TaskException] (TaskResult a), *IWorld) | iTask a
destroyEmbeddedParallelTask listId=:(TaskId instanceNo _) taskId iworld=:{current={taskTime}}
552
	# (errs,destroyResult,iworld) = case read (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld of
Mart Lubbers's avatar
Mart Lubbers committed
553
		(Error e,iworld) = ([e], DestroyedResult,iworld)
Haye Böhm's avatar
Haye Böhm committed
554
		(Ok (ReadingDone (Task eval)),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
555
			= case eval DestroyEvent {mkEvalOpts & noUI = True, taskId=taskId} iworld of
556 557 558
				(res=:(DestroyedResult),iworld) = ([],res,iworld)
				(res=:(ExceptionResult e),iworld) = ([e],DestroyedResult,iworld)
				(res,iworld) = ([exception "destroyEmbeddedParallelTask: unexpected result"],DestroyedResult,iworld)
Mart Lubbers's avatar
Mart Lubbers committed
559
	// 2. Remove the task evaluation function
560
	# (errs,iworld) = case modify (fmap (\(r=:{TIReduct|tasks}) -> {TIReduct|r & tasks = 'DM'.del taskId tasks}))
561
	                              (sdsFocus instanceNo taskInstanceReduct) EmptyContext iworld of
562
		(Error e,iworld) = ([e:errs],iworld)
Haye Böhm's avatar
Haye Böhm committed
563
		(Ok (ModifyingDone _),iworld) = (errs,iworld)
Mart Lubbers's avatar
Mart Lubbers committed
564
	= (Ok destroyResult, iworld)
565

Mart Lubbers's avatar
Mart Lubbers committed
566 567
destroyDetachedParallelTask :: TaskId TaskId *IWorld -> *(MaybeError [TaskException] (TaskResult a), *IWorld) | iTask a
destroyDetachedParallelTask listId=:(TaskId instanceNo _) taskId iworld
568 569
	//TODO: Detached parallel tasks should be marked that their parent no longer needs their result
	//      That way attach combinators can be programmed to notify the user or simply stop the task
Mart Lubbers's avatar
Mart Lubbers committed
570
	= (Ok DestroyedResult, iworld)
571

Mart Lubbers's avatar
Mart Lubbers committed
572
destroyRemoved :: TaskId [TaskId] [(TaskId, TaskResult a)] *IWorld -> ([(TaskId, TaskResult a)], *IWorld) | iTask a
573
destroyRemoved listId removed [] iworld = ([],iworld)
Mart Lubbers's avatar
Mart Lubbers committed
574 575 576 577 578
destroyRemoved listId removed [r=:(taskId, _):rs] iworld
	| isMember taskId removed
		= case destroyEmbeddedParallelTask listId taskId iworld of
			(Error e, iworld) = ([(taskId, ExceptionResult (exception (ExceptionList e))):rs], iworld)
			(Ok tr, iworld)
579
				# (rs,iworld) = destroyRemoved listId removed rs iworld
Mart Lubbers's avatar
Mart Lubbers committed
580
				= ([(taskId, tr):rs],iworld)
581 582 583
	# (rs,iworld) = destroyRemoved listId removed rs iworld
	= ([r:rs],iworld)

584
genParallelValue :: [TaskResult a] -> TaskValue [(TaskTime,TaskValue a)]
585 586 587 588 589 590
genParallelValue results = Value [(lastEvent,val) \\ ValueResult val {TaskEvalInfo|lastEvent} _ _ <- results] False

genParallelRep :: !TaskEvalOpts !Event [UI] [String] [TaskResult a] Int -> UIChange
genParallelRep evalOpts event actions prevEnabledActions results prevNumBranches
	= case event of
		ResetEvent
591
			= ReplaceUI (uiac UIContainer (classAttr [className]) ([def \\ ValueResult _ _ (ReplaceUI def) _ <- results] ++ actions))
Haye Böhm's avatar
Haye Böhm committed
592
		_
593 594 595 596
			# (idx,iChanges) = itemChanges 0 prevNumBranches results
			# aChanges       = actionChanges idx
			= ChangeUI [] (iChanges ++ aChanges)
where
597 598
	className = if (actions =: []) "parallel" "parallel-actions"

599 600 601 602 603 604 605 606 607 608 609
	itemChanges i numExisting [] = (i,[])
	itemChanges i numExisting [ValueResult _ _ change _:rs]
		| i < numExisting
			# (i`,changes) = itemChanges (i + 1) numExisting rs
			= (i`,[(i,ChangeChild change):changes]) 	//Update an existing branch
		| otherwise			= case change of
			(ReplaceUI def)
				# (i`,changes) = itemChanges (i + 1) (numExisting + 1) rs
				= (i`,[(i,InsertChild def):changes]) 	//Add a new branch
			_
				= itemChanges (i + 1) (numExisting + 1) rs //Skip if we don't get a blank UI
Haye Böhm's avatar
Haye Böhm committed
610

611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630
	itemChanges i numExisting [DestroyedResult:rs]
		| i < numExisting
			# (i`,changes) = itemChanges i (numExisting - 1) rs
			= (i`,[(i,RemoveChild):changes])
		| otherwise
			= itemChanges i numExisting rs //No need to destroy a branch that was not yet in the UI

	itemChanges i numExisting [ExceptionResult e:rs]
		| i < numExisting
			# (i`,changes) = itemChanges i (numExisting - 1) rs
			= (i`,[(i,RemoveChild):changes])
		| otherwise
			= itemChanges i numExisting rs

	actionChanges startIdx = [(i,ChangeChild (switch (isEnabled ui) (actionId ui))) \\ ui <- actions & i <- [startIdx..]]
	where
		switch True name = if (isMember name prevEnabledActions) NoChange (ChangeUI [SetAttribute "enabled" (JSONBool True)] [])
		switch False name = if (isMember name prevEnabledActions) (ChangeUI [SetAttribute "enabled" (JSONBool False)] []) NoChange

genParallelEvalInfo :: [TaskResult a] -> TaskEvalInfo
631
genParallelEvalInfo results = foldr addResult {TaskEvalInfo|lastEvent=0,removedTasks=[]} results
632 633 634 635
where
    addResult (ValueResult _ i1 _ _) i2
        # lastEvent = max i1.TaskEvalInfo.lastEvent i2.TaskEvalInfo.lastEvent
        # removedTasks = i1.TaskEvalInfo.removedTasks ++ i2.TaskEvalInfo.removedTasks
636
        = {TaskEvalInfo|lastEvent=lastEvent,removedTasks=removedTasks}
637 638
    addResult _ i = i

Bas Lijnse's avatar
Bas Lijnse committed
639
readListId :: (SharedTaskList a) *IWorld -> (MaybeError TaskException TaskId,*IWorld) | TC a
640 641
readListId slist iworld = case read (sdsFocus taskListFilter slist) EmptyContext iworld of
	(Ok e,iworld)	= (Ok (fst (directResult e)), iworld)
642 643 644 645 646 647 648 649
	(Error e, iworld)	    = (Error e, iworld)
where
    taskListFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeAttributes=False,includeProgress=False}

appendTask :: !ParallelTaskType !(ParallelTask a) !(SharedTaskList a) -> Task TaskId | iTask a
appendTask parType parTask slist = mkInstantTask eval
where
	eval _ iworld=:{current={taskTime}}
Mart Lubbers's avatar
Mart Lubbers committed
650 651 652 653
		# (mbListId,iworld) = readListId slist iworld
		| mbListId =:(Error _) = (mbListId,iworld)
		# listId = fromOk mbListId
		//Check if someone is trying to add an embedded task to the topLevel list
Bas Lijnse's avatar
Bas Lijnse committed
654
		| listId == TaskId 0 0 && parType =:(Embedded)
Mart Lubbers's avatar
Mart Lubbers committed
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675
			= (Error (exception "Embedded tasks can not be added to the top-level task list"),iworld)
		# (mbStateMbTask, iworld) = initParallelTask mkEvalOpts listId 0 parType parTask iworld
		= case mbStateMbTask of
			Ok (state,mbTask)
				# taskId = state.ParallelTaskState.taskId
				| listId == TaskId 0 0 //For the top-level list, we don't need to do anything else
					//TODO: Make sure we don't lose the attributes!
					= (Ok taskId, iworld)
			  	//Update the task list
				# taskListFilter      = {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
				# (mbError,iworld)    =  modify (\states -> states ++ [{ParallelTaskState|state & index = nextIndex states}]) (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
				| mbError =:(Error _) = (liftError mbError,iworld)
				//If the task is an embedded one, we also need to store the task function
				| mbTask =:(Just _)
					# (mbError,iworld) = (write (snd (fromJust mbTask)) (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld)
					| mbError =:(Error _) = (liftError mbError,iworld)
					= (Ok taskId, iworld)
				= (Ok taskId, iworld)
			err = (liftError err, iworld)
	where
		//To determine the next index we need to disregard states that are marked as removed
Mart Lubbers's avatar
Mart Lubbers committed
676
		nextIndex states = length [p\\p=:{ParallelTaskState|change} <- states | not (change =: (Just RemoveParallelTask))]
677 678 679 680

/**
* Removes (and stops) a task from a task list
*/
Bas Lijnse's avatar
Bas Lijnse committed
681
removeTask :: !TaskId !(SharedTaskList a) -> Task () | TC a
682 683
removeTask removeId=:(TaskId instanceNo taskNo) slist = Task eval
where
Mart Lubbers's avatar
Mart Lubbers committed
684
	eval DestroyEvent _ iworld = (DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
685
	eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
686 687 688 689 690 691
		# (mbListId,iworld) = readListId slist iworld
		| mbListId =:(Error _) = (ExceptionResult (fromError mbListId),iworld)
		# listId = fromOk mbListId
		//If we are removing from the top-level task list, just remove the instance
		| listId == TaskId 0 0
			# (mbe,iworld) = deleteTaskInstance instanceNo iworld
692
			| mbe =: (Error _) = (ExceptionResult (fromError mbe),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
693 694
			= (ValueResult
				(Value () True)
Mart Lubbers's avatar
Mart Lubbers committed
695
				(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
696
				(mkUIIfReset event (ui UIEmpty))
Mart Lubbers's avatar
Mart Lubbers committed
697 698 699 700 701 702 703 704
				(treturn ()), iworld)
		//Mark the task as removed, and update the indices of the tasks afterwards
		# taskListFilter        = {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
		# (mbError,iworld)      = modify (markAsRemoved removeId) (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
		| mbError =:(Error _)   = (ExceptionResult (fromError mbError),iworld)
		//If it is a detached task, remove the detached instance, if it is embedded, pass notify the currently evaluating parallel
		| taskNo == 0 //(if the taskNo equals zero the instance is embedded)
			# (mbe,iworld) = deleteTaskInstance instanceNo iworld
705
			| mbe =: (Error _) = (ExceptionResult (fromError mbe),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
706
			= (ValueResult (Value () True) {lastEvent=lastEval,removedTasks=[]} (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
707
		//Pass removal information up
Mart Lubbers's avatar
Mart Lubbers committed
708
		= (ValueResult (Value () True) {lastEvent=lastEval,removedTasks=[(listId,removeId)]} (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
709 710 711 712 713

	//When a task is marked as removed, the index of the tasks after that are decreased
	markAsRemoved removeId [] = []
	markAsRemoved removeId [s=:{ParallelTaskState|taskId}:ss]
		| taskId == removeId = [{ParallelTaskState|s & change = Just RemoveParallelTask}
714
		                       :[{ParallelTaskState|s` & index = index - 1} \\ s`=:{ParallelTaskState|index} <- ss]]
Mart Lubbers's avatar
Mart Lubbers committed
715
		| otherwise          = [s:markAsRemoved removeId ss]
716 717 718 719

replaceTask :: !TaskId !(ParallelTask a) !(SharedTaskList a) -> Task () | iTask a
replaceTask replaceId=:(TaskId instanceNo taskNo) parTask slist = Task eval
where
Mart Lubbers's avatar
Mart Lubbers committed
720
	eval DestroyEvent _ iworld = (DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
721
	eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
722 723 724 725 726 727 728
		# (mbListId,iworld) = readListId slist iworld
		| mbListId =:(Error _) = (ExceptionResult (fromError mbListId),iworld)
		# listId = fromOk mbListId
		//Replace the full instance task
		| listId == TaskId 0 0
			= case replaceTaskInstance instanceNo (parTask topLevelTaskList) iworld of
				(Ok (), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
729
					= (ValueResult (Value () True) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
730 731 732 733 734 735
				(Error e, iworld)
					= (ExceptionResult e,iworld)
		//If it is a detached task, replacee the detached instance, if it is embedded schedule the change in the parallel task state
		| taskNo == 0 //(if the taskNo equals zero the instance is embedded)
			= case replaceTaskInstance instanceNo (parTask topLevelTaskList) iworld of
				(Ok (), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
736
					= (ValueResult (Value () True) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
737 738 739 740 741 742 743
				(Error e, iworld)
					= (ExceptionResult e,iworld)
		//Schedule the change in the parallel task state
		# task                  = parTask (sdsTranslate "setTaskAndList" (\listFilter -> (listId,taskId,listFilter)) parallelTaskList)
		# taskListFilter        = {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=True,includeAttributes=True,includeProgress=True}
		# (mbError,iworld)      = modify (scheduleReplacement replaceId task) (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
		| mbError =:(Error _)   = (ExceptionResult (fromError mbError),iworld)
Mart Lubbers's avatar
Mart Lubbers committed
744
		= (ValueResult (Value () True) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
745

Mart Lubbers's avatar
Mart Lubbers committed
746 747 748 749
	scheduleReplacement replaceId task [] = []
	scheduleReplacement replaceId task [s=:{ParallelTaskState|taskId}:ss]
		| taskId == replaceId   = [{ParallelTaskState|s & change = Just (ReplaceParallelTask (dynamic task :: Task a^))}:ss]
		| otherwise             = [s:scheduleReplacement replaceId task ss]
750 751

attach :: !InstanceNo !Bool -> Task AttachmentStatus
Mart Lubbers's avatar
Mart Lubbers committed
752
attach instanceNo steal = Task evalinit
753
where
Mart Lubbers's avatar
Mart Lubbers committed
754 755
	evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
	evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld=:{current={attachmentChain}}
756
		# (mbConstants,iworld)		= read (sdsFocus instanceNo taskInstanceConstants) EmptyContext iworld
Haye Böhm's avatar
Haye Böhm committed
757
		| mbConstants =: (Error _)  = (ExceptionResult (fromError mbConstants),iworld)
758
		# (mbProgress,iworld)		= read (sdsFocus instanceNo taskInstanceProgress) EmptyContext iworld
759
		| mbProgress =: (Error _)   = (ExceptionResult (fromError mbProgress),iworld)