Commit 02915797 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'destroyInstances' into 'master'

properly destroy task instances when they are deleted

See merge request !227
parents 85584848 3bcc8086
Pipeline #19305 passed with stage
in 4 minutes and 46 seconds
......@@ -73,6 +73,17 @@ processEvents :: !Int *IWorld -> *(!MaybeError TaskException (), !*IWorld)
*/
evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
/**
* Destroys a task instance.
*
* @param The instance id
* @param The IWorld state
*
* @return The result of the targeted main task or an error
* @return The IWorld state
*/
destroyTaskInstance :: !InstanceNo !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
//Update the I/O information for task instances
updateInstanceLastIO :: ![InstanceNo] !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateInstanceConnect :: !String ![InstanceNo] !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
......
......@@ -67,9 +67,15 @@ processEvents max iworld
(Error msg,iworld=:{IWorld|world})
= (Ok (),{IWorld|iworld & world = world})
//Evaluate a single task instance
evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
evalTaskInstance instanceNo event iworld
evalTaskInstance instanceNo event iworld = evalTaskInstance` instanceNo event False iworld
destroyTaskInstance :: !InstanceNo !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
destroyTaskInstance instanceNo iworld = evalTaskInstance` instanceNo ResetEvent True iworld
//Evaluate a single task instance
evalTaskInstance` :: !InstanceNo !Event !Bool !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
evalTaskInstance` instanceNo event destroy iworld
# iworld = mbResetUIState instanceNo event iworld
# (res,iworld) = evalTaskInstance` instanceNo event iworld
= (res,iworld)
......@@ -103,7 +109,7 @@ where
, nextTaskNo = oldReduct.TIReduct.nextTaskNo
}}
//Apply task's eval function and take updated nextTaskId from iworld
# (newResult,iworld=:{current}) = eval event {mkEvalOpts & tonicOpts = tonicRedOpts} tree iworld
# (newResult,iworld=:{current}) = eval event {mkEvalOpts & tonicOpts = tonicRedOpts} (if destroy (TCDestroy tree) tree) iworld
# tree = case newResult of
(ValueResult _ _ _ newTree) = newTree
_ = tree
......@@ -127,14 +133,15 @@ where
//FIXME: Don't write the full reduct (all parallel shares are triggered then!)
//Store update value
# newValue = case newResult of
(ValueResult val _ _ _) = TIValue val
(ExceptionResult (e,str)) = TIException e str
ValueResult val _ _ _ = TIValue val
ExceptionResult (e,str) = TIException e str
DestroyedResult = TIValue NoValue
# (mbErr,iworld) = if deleted (Ok WritingDone,iworld) ((write newValue (sdsFocus instanceNo taskInstanceValue) EmptyContext iworld))
= case mbErr of
Error (e,description) = exitWithException instanceNo description iworld
Ok _
= case newResult of
(ValueResult value _ change _)
ValueResult value _ change _
| deleted
= (Ok value,iworld)
//Only queue UI changes if something interesting is changed
......@@ -143,8 +150,10 @@ where
change
# iworld = queueUIChange instanceNo change iworld
= (Ok value, iworld)
(ExceptionResult (e,description))
ExceptionResult (e,description)
= exitWithException instanceNo description iworld
DestroyedResult
= (Ok NoValue, iworld)
exitWithException instanceNo description iworld
# iworld = queueException instanceNo description iworld
......
......@@ -196,8 +196,9 @@ where
toJSONTask (Task eval) = Task eval`
where
eval` event repOpts tree iworld = case eval event repOpts tree iworld of
(ValueResult val ts rep tree,iworld) = (ValueResult (fmap DeferredJSON val) ts rep tree, iworld)
(ExceptionResult e,iworld) = (ExceptionResult e,iworld)
(ValueResult val ts rep tree,iworld) = (ValueResult (fmap DeferredJSON val) ts rep tree, iworld)
(ExceptionResult e,iworld) = (ExceptionResult e,iworld)
(DestroyedResult,iworld) = (DestroyedResult,iworld)
replaceTaskInstance :: !InstanceNo !(Task a) *IWorld -> (!MaybeError TaskException (), !*IWorld) | iTask a
replaceTaskInstance instanceNo task iworld=:{options={appVersion},current={taskTime}}
......@@ -211,6 +212,8 @@ replaceTaskInstance instanceNo task iworld=:{options={appVersion},current={taskT
deleteTaskInstance :: !InstanceNo !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
deleteTaskInstance instanceNo iworld=:{IWorld|options={EngineOptions|persistTasks}}
# (mbe, iworld) = destroyTaskInstance instanceNo iworld
| isError mbe = (Error $ exception $ fromError mbe, iworld)
//Delete in administration
# (mbe,iworld) = 'SDS'.modify (\is -> [i \\ i=:(no,_,_,_) <- is | no <> instanceNo]) (sdsFocus defaultValue filteredInstanceIndex) 'SDS'.EmptyContext iworld
| mbe =: (Error _) = (toME mbe,iworld)
......
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