Merge branch '435-make-Task-abstract' into 'master'

Make the Task type abstract

Closes #435

See merge request !532

Libraries/iTasks/Internal/EngineTasks.icl

@@ -114,9 +114,9 @@ asyncTaskListener
 		] [] @! ()
 where
 	wrapTask :: !(SharedTaskList ()) !TaskId !(Task a) !Event !TaskEvalOpts !*IWorld -> *(TaskResult (), *IWorld) | iTask a
-	wrapTask stl ctaskId (Task teval) event opts=:{lastEval,taskId} iworld
+	wrapTask stl ctaskId teval event opts=:{lastEval,taskId} iworld
 		#! resultShare = sdsFocus ctaskId asyncITasksResults
-		= case teval event {TaskEvalOpts|opts & taskId=ctaskId} iworld of
+		= case apTask teval event {TaskEvalOpts|opts & taskId=ctaskId} iworld of
 			(DestroyedResult, iworld) = (DestroyedResult, iworld)
 			(tresult, iworld)
 				# (ar, cont) = case tresult of

Libraries/iTasks/Internal/Task.dcl

@@ -53,10 +53,4 @@ wrapTaskContinuation tf val :== case val of
 	(ValueResult val tei ui newtask) = ValueResult val tei ui (Task (tf newtask))
 	a = a
 
-/**
- * Unwrap the task to reveal the evaluation function
- * @type (Task a) -> (Event TaskEvalOpts !*IWorld -> *(TaskResult a, !*IWorld))
- */
-unTask (Task t) :== t
-
 nopTask :: Task a | iTask a

Libraries/iTasks/Internal/TaskEval.icl

@@ -59,7 +59,7 @@ where
 	// Read the task reduct. If it does not exist, the task has been deleted.
 	# (curReduct, iworld)		= 'SDS'.read (sdsFocus instanceNo taskInstanceTask) EmptyContext iworld
 	| isError curReduct			= exitWithException instanceNo ((\(Error (e,msg)) -> msg) curReduct) iworld
-	# curReduct=:(Task eval)    = directResult (fromOk curReduct)
+	# curReduct                 = directResult (fromOk curReduct)
 	// Determine the task type (startup,session,local) 
 	# (type,iworld)             = determineInstanceType instanceNo iworld
 	// Determine the progress of the instance
@@ -84,10 +84,10 @@ where
 	//Apply task's eval function and take updated nextTaskId from iworld
 	//the 'nextTaskNo' is possibly incremented during evaluation and we need to store it
 	# (newResult,iworld=:{current=current=:{TaskEvalState|nextTaskNo}})
-		= eval event {mkEvalOpts & lastEval=nextTaskTime, taskId=taskId} iworld
+		= apTask curReduct event {mkEvalOpts & lastEval=nextTaskTime, taskId=taskId} iworld
 	# newTask = case newResult of
 		(ValueResult _ _ _ newTask) = newTask
-		_                           = Task eval
+		_                           = curReduct
 	# newValue = case newResult of
 		ValueResult val _ _ _   = val
 		ExceptionResult (e,str) = NoValue

Libraries/iTasks/UI/Layout/Common.icl

@@ -353,7 +353,7 @@ instance tune NoUserInterface (Task a)
 where
     tune NoUserInterface task = Task (eval task)
     where
-	    eval (Task task) event repOpts iworld = case task event repOpts iworld of
+	    eval task event repOpts iworld = case apTask task event repOpts iworld of
 			(ValueResult taskvalue evalinfo _ newtask, iworld)
 				# change = case event of 
 					ResetEvent = ReplaceUI (ui UIEmpty)

Libraries/iTasks/UI/Tune.icl

@@ -44,8 +44,8 @@ instance tune UIAttributes (Task a)
 where
 	tune attrs task = Task (eval task)
 	where
-		eval (Task inner) event evalOpts iworld
-			# (result,iworld) = inner event evalOpts iworld
+		eval inner event evalOpts iworld
+			# (result,iworld) = apTask inner event evalOpts iworld
 			= (wrapTaskContinuation eval (withExtraAttributes attrs result), iworld) 
 	
 		withExtraAttributes extra (ValueResult value info (ReplaceUI (UI type attr items)) task)
@@ -92,18 +92,18 @@ where
 	evalinit event = eval (initLUI (ui UIEmpty), initLUIMoves) task ResetEvent
 
 	//Cleanup duty simply passed to inner task
-	eval _ (Task inner) event evalOpts iworld
-		| isDestroyOrInterrupt event = inner event evalOpts iworld
+	eval _ inner event evalOpts iworld
+		| isDestroyOrInterrupt event = apTask inner event evalOpts iworld
 	//On Reset events, we (re-)apply the layout
-	eval state (Task inner) ResetEvent evalOpts iworld
-		= case inner ResetEvent evalOpts iworld of
+	eval state inner ResetEvent evalOpts iworld
+		= case apTask inner ResetEvent evalOpts iworld of
 			(ValueResult value info (ReplaceUI ui) task,iworld)
 				# (change,state) = extractResetChange (rule ruleNo (initLUI ui, initLUIMoves))
 				= (wrapTaskContinuation (eval state) (ValueResult value info change task), iworld)
 			(val, iworld) = (wrapTaskContinuation (eval state) val, iworld)
 
-	eval state (Task inner) event evalOpts iworld
-		= case inner event evalOpts iworld of
+	eval state inner event evalOpts iworld
+		= case apTask inner event evalOpts iworld of
 			(ValueResult value info change task,iworld)
 				# state = applyUpstreamChange change state
 				# state = rule ruleNo state

Libraries/iTasks/WF/Combinators/Core.icl

@@ -61,7 +61,7 @@ derive class iTask AttachException
 transformError :: ((TaskValue a) -> MaybeError TaskException (TaskValue b)) !(Task a) -> Task b
 transformError f task = Task (eval task)
 where
-	eval (Task task) event evalOpts iworld = case task event evalOpts iworld of
+	eval task event evalOpts iworld = case apTask task event evalOpts iworld of
 		(ValueResult val lastEvent rep task, iworld) = case f val of
 			Error e = (ExceptionResult e, iworld)
 			Ok v = (ValueResult v lastEvent rep (Task (eval task)), iworld)
@@ -94,16 +94,16 @@ where
 	//Evaluating the lhs
 	//Destroyed when executing the lhs
 	//evalleft :: (Task a) [String] TaskId Event TaskEvalOpts !*IWorld -> *(TaskResult a, IWorld)
-	evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts iworld
+	evalleft lhs prevEnabledActions leftTaskId event evalOpts iworld
 		| isDestroyOrInterrupt event
-			= case lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld of
+			= case apTask lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld of
 				(DestroyedResult, iworld)    = (DestroyedResult, iworld)
 				(ExceptionResult e, iworld)  = (ExceptionResult e, iworld)
 				(ValueResult _ _ _ _,iworld) = (ExceptionResult (exception "Failed destroying lhs in step"), iworld)
 	//Execute lhs
-	evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts=:{lastEval,taskId} iworld
+	evalleft lhs prevEnabledActions leftTaskId event evalOpts=:{lastEval,taskId} iworld
 		# mbAction = matchAction taskId event
-		# (res, iworld) = lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
+		# (res, iworld) = apTask lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
 		// Right  is a step
 		# (mbCont, iworld) = case res of
 			ValueResult val info rep lhs
@@ -125,7 +125,7 @@ where
 					//A match
 					?Just rewrite
 						//Send a destroyevent to the lhs
-						# (_, iworld) = (unTask lhs) DestroyEvent {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
+						# (_, iworld) = apTask lhs DestroyEvent {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
 						= (Right (rewrite, info.TaskEvalInfo.lastEvent, info.TaskEvalInfo.removedTasks), iworld)
 			ExceptionResult e
 				= case searchContException e conts of
@@ -137,18 +137,18 @@ where
 			//No match, just pass through
 			Left res = (res, iworld)
 			//A match, continue with the matched rhs
-			Right ((_, (Task rhs), _), lastEvent, removedTasks)
+			Right ((_, rhs, _), lastEvent, removedTasks)
 				//Execute the rhs with a reset event
-				# (resb, iworld)        = rhs ResetEvent evalOpts iworld
+				# (resb, iworld)        = apTask rhs ResetEvent evalOpts iworld
 				= case resb of
-					ValueResult val info change=:(ReplaceUI _) (Task rhs)
+					ValueResult val info change=:(ReplaceUI _) 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)
+							rhs
 						,iworld)
 					ValueResult _ _ change _
 						= (ExceptionResult (exception ("Reset event of task in step failed to produce replacement UI: ("+++ toString (toJSON change)+++")")), iworld)
@@ -433,9 +433,9 @@ where
 		# thisTask = sdsFocus (listId,taskId) taskInstanceParallelTaskListTask
 		# (mbTask,iworld) = read thisTask EmptyContext iworld
 		| mbTask =:(Error _) = (Error (fromError mbTask),iworld)
-		# (Task evala) = directResult (fromOk mbTask)
+		# evala = directResult (fromOk mbTask)
 		//Evaluate new branches with a reset event, other with the event
-		= case evala (if initialized event ResetEvent) {TaskEvalOpts|evalOpts&taskId=taskId} iworld of
+		= case apTask evala (if initialized event ResetEvent) {TaskEvalOpts|evalOpts&taskId=taskId} iworld of
 			(DestroyedResult, iworld)
 				= (Ok DestroyedResult, iworld)
 			//If an exception occured, check if we can handle it at this level
@@ -535,8 +535,8 @@ destroyEmbeddedParallelTask :: TaskId TaskId *IWorld -> *(MaybeError [TaskExcept
 destroyEmbeddedParallelTask listId=:(TaskId instanceNo _) taskId iworld=:{current={taskTime}}
 	# (errs,destroyResult,iworld) = case read (sdsFocus (listId,taskId) taskInstanceParallelTaskListTask) EmptyContext iworld of
 		(Error e,iworld) = ([e], DestroyedResult,iworld)
-		(Ok (ReadingDone (Task eval)),iworld)
-			= case eval DestroyEvent {mkEvalOpts & noUI = True, taskId=taskId} iworld of
+		(Ok (ReadingDone eval),iworld)
+			= case apTask eval DestroyEvent {mkEvalOpts & noUI = True, taskId=taskId} iworld of
 				(DestroyedResult,   iworld) = ([],  DestroyedResult, iworld)
 				(ExceptionResult e, iworld) = ([e], DestroyedResult, iworld)
 				(_,                 iworld) =
@@ -744,7 +744,6 @@ where
 		= eval (ASAttached (status =: (Right True))) build (?Just newKey) event evalOpts iworld
 
 	eval _ _ _ DestroyEvent evalOpts=:{TaskEvalOpts|taskId} iworld
-		# iworld     = clearTaskSDSRegistrations ('DS'.singleton taskId) (clearEventsFor taskId iworld)
 		# (_,iworld) = modify release (sdsFocus (instanceNo,False,True) taskInstance) EmptyContext iworld
         = (DestroyedResult, iworld)
 	where
@@ -790,11 +789,11 @@ withCleanupHook patch orig
 	= appendTopLevelTask ('DM'.singleton "hidden" (JSONBool True)) False patch
 	>>- \x->Task (eval x orig)
 where
-	eval tosignal (Task orig) DestroyEvent opts iw
-		# (tr, iw) = orig DestroyEvent opts iw
+	eval tosignal orig DestroyEvent opts iw
+		# (tr, iw) = apTask orig DestroyEvent opts iw
 		= (tr, queueRefresh tosignal iw)
-	eval tosignal (Task orig) ev opts iw
-		# (val, iw) = orig ev opts iw
+	eval tosignal orig ev opts iw
+		# (val, iw) = apTask orig ev opts iw
 		= (wrapTaskContinuation (eval tosignal) val, iw)
 
 asyncTask :: !String !Int !(Task a) -> Task a | iTask a

Libraries/iTasks/WF/Combinators/SDS.icl

@@ -44,30 +44,30 @@ where
 
 	//Running
 	eval :: !TaskId !(SDSLens () b (?b)) !(Task a) !Event !TaskEvalOpts !*IWorld -> (!TaskResult a, !*IWorld) | TC b
-	eval innerTaskId localSds (Task inner) ServerInterruptedEvent opts iworld
-		= inner ServerInterruptedEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld
-	eval innerTaskId localSds (Task inner) DestroyEvent opts iworld
+	eval innerTaskId localSds inner ServerInterruptedEvent opts iworld
+		= apTask inner ServerInterruptedEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld
+	eval innerTaskId localSds inner DestroyEvent opts iworld
 		// free memory of share
 		# (e, iworld) = write ?None localSds EmptyContext iworld
 		| isError e
 			= (ExceptionResult (fromError e),iworld)
-		= case inner DestroyEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld of
+		= case apTask inner DestroyEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld of
 			(ValueResult _ _ _ _, iworld)
 				= (ExceptionResult (exception "Failed to destroy withShared child"), iworld)
 			e = e
 
-	eval innerTaskId localSds (Task inner) event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
-		= case inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld of
+	eval innerTaskId localSds inner event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
+		= case apTask inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld of
 			(ValueResult val info rep newinner, iworld)
 				# info & TaskEvalInfo.lastEvent = max lastEval info.TaskEvalInfo.lastEvent
 				= (ValueResult val info rep (Task (eval innerTaskId localSds newinner)), iworld)
 			e = e
 
 withTaskId :: (Task a) -> Task (a, TaskId)
-withTaskId (Task task) = Task eval
+withTaskId task = Task eval
 where
 	eval event evalOpts=:{TaskEvalOpts|taskId} iworld
-		= case task event evalOpts iworld of
+		= case apTask task event evalOpts iworld of
 			(ValueResult (Value x st) info rep newtask, iworld)
 				= (ValueResult (Value (x, taskId) st) info rep (withTaskId newtask), iworld)
 			(ExceptionResult te, iworld) = (ExceptionResult te, iworld)
@@ -89,10 +89,10 @@ where
 			Error e = (ExceptionResult (exception ("Could not create temporary directory: " +++ tmpDir +++ " (" +++ toString e +++ ")")) , iworld)
 	//Actual task execution
 	//First destroy the inner task, then delete the tmp dir
-	eval tmpDir innerTaskId (Task inner) ServerInterruptedEvent evalOpts iworld
-		= inner ServerInterruptedEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
-	eval tmpDir innerTaskId (Task inner) DestroyEvent evalOpts iworld
-		# (resa,iworld)  = inner DestroyEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
+	eval tmpDir innerTaskId inner ServerInterruptedEvent evalOpts iworld
+		= apTask inner ServerInterruptedEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
+	eval tmpDir innerTaskId inner DestroyEvent evalOpts iworld
+		# (resa,iworld)  = apTask inner DestroyEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
 		# (merr, world)  = recursiveDelete tmpDir iworld.world
 		# iworld & world = world
 		| isError merr = (ExceptionResult (exception (fromError merr)), iworld)
@@ -101,13 +101,13 @@ where
 			e = (e, iworld)
 
 	//During execution, set the cwd to the tmp dir
-	eval tmpDir innerTaskId (Task inner) event evalOpts=:{TaskEvalOpts|lastEval} iworld
+	eval tmpDir innerTaskId inner event evalOpts=:{TaskEvalOpts|lastEval} iworld
 		# (oldcurdir, iworld)= liftIWorld getCurrentDirectory iworld
 		| isError oldcurdir  = (ExceptionResult (exception (fromError oldcurdir)), iworld)
 		# (Ok oldcurdir)     = oldcurdir
 		# (mbErr, iworld)    = liftIWorld (setCurrentDirectory tmpDir) iworld
 		| isError mbErr      = (ExceptionResult (exception (fromError mbErr)), iworld)
-		# (resa, iworld)     = inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
+		# (resa, iworld)     = apTask inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
 		# (mbErr,iworld)     = setCurrentDirectory oldcurdir iworld
 		| isError mbErr      = (ExceptionResult (exception (fromError mbErr)), iworld)
 		= case resa of

Libraries/iTasks/WF/Definition.dcl

@@ -21,8 +21,14 @@ from StdString import class toString, class fromString
 from StdClass import class <
 from StdOverloaded import class ==
 
-// Task definition:
-:: Task a =: Task (Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld))
+//* Definition of a task.
+:: Task a (=: Task` (Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)))
+
+//* Create a new task.
+Task :: !(Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) -> Task a
+
+//* Apply a task to an event.
+apTask :: !(Task a) !Event TaskEvalOpts !*IWorld -> *(TaskResult a, *IWorld)
 
 :: Event
 	= EditEvent    !TaskId !String !JSONNode //* Update something in an interaction: Task id, edit name, value

Libraries/iTasks/WF/Definition.icl

 implementation module iTasks.WF.Definition
 
-from iTasks.Internal.IWorld import :: IWorld
-from System.Time import :: Timestamp, :: Timespec
-import iTasks.WF.Derives
-import iTasks.UI.Definition
-import iTasks.UI.Editor
-import iTasks.UI.Editor.Generic
+import StdEnv
 
-from Text.GenJSON import :: JSONNode
 from Data.Map import :: Map(..)
 from Data.Set import :: Set
+import qualified Data.Set as Set
 import Data.Functor
+from System.Time import :: Timestamp, :: Timespec
 import Text, Text.GenJSON
 
-import StdEnv
+import iTasks
+import iTasks.Internal.TaskEval
+import iTasks.Internal.TaskIO
+
+:: Task a =: Task` (Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld))
+
+Task :: !(Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) -> Task a
+Task f = Task` f
 
+apTask :: !(Task a) !Event TaskEvalOpts !*IWorld -> *(TaskResult a, *IWorld)
+apTask (Task` f) event opts=:{TaskEvalOpts|taskId} iworld
+	# (res,iworld) = f event opts iworld
+	| event=:DestroyEvent || event=:ServerInterruptedEvent
+		# iworld = clearEventsFor taskId iworld
+		# iworld = clearTaskSDSRegistrations ('Set'.singleton taskId) iworld
+		= (res, iworld)
+	| otherwise
+		= (res, iworld)
 
 exception :: !e -> TaskException | TC, toString e
 exception e = (dynamic e, toString e)

Libraries/iTasks/WF/Tasks/Core.icl

@@ -108,7 +108,7 @@ evalInteract ::
 evalInteract _ _ _ _ _ _ _ _ ServerInterruptedEvent _ iworld
 	= (DestroyedResult, iworld)
 evalInteract _ _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
-	= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) (clearEventsFor taskId iworld))
+	= (DestroyedResult, iworld)
 evalInteract _ mbr ?None _ sds editor modefun writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
 	= (ExceptionResult (exception "corrupt editor state"), iworld)
 evalInteract prevChange mbr (?Just st) editorId sds editor modefun writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld | eTaskId == taskId

Libraries/iTasks/WF/Tasks/SDS.icl

@@ -12,13 +12,13 @@ import iTasks.Internal.TaskEval
 import iTasks.Internal.Util
 
 get :: !(sds () a w) -> Task a | TC a & Readable sds & TC w
-get sds = Task (readCompletely sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Read)) (unTask o return))
+get sds = Task (readCompletely sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Read)) (apTask o return))
 
 set :: !a !(sds () r a)  -> Task a | TC a & TC r & Writeable sds
-set val sds = Task (writeCompletely val sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Write)) (unTask (return val)))
+set val sds = Task (writeCompletely val sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Write)) (apTask (return val)))
 
 upd :: !(r -> w) !(sds () r w) -> Task w | TC r & TC w & RWShared sds
-upd fun sds = Task (modifyCompletely fun sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Modify)) (unTask o return))
+upd fun sds = Task (modifyCompletely fun sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Modify)) (apTask o return))
 
 watch :: !(sds () r w) -> Task r | TC r & TC w & Readable, Registrable sds
 watch sds = Task (readRegisterCompletely sds NoValue mkEmptyUI cont)