Verified Commit e3ba19a5 authored by Camil Staps's avatar Camil Staps 🚀

Make the Task type abstract

This allows us to centralize teardown.
parent 8d07cd0c
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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) =
......@@ -790,11 +790,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
......
......@@ -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
......
......@@ -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
......
......@@ -15,6 +15,13 @@ import Text, Text.GenJSON
import StdEnv
:: 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 iworld = f event opts iworld
exception :: !e -> TaskException | TC, toString e
exception e = (dynamic e, toString e)
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment