Verified Commit 683dadcc authored by Steffen Michels's avatar Steffen Michels Committed by Camil Staps

remove value & reduct when cleaning up a task

parent 8dae8e0b
implementation module iTasks.Internal.TaskEval
import StdList, StdBool, StdTuple, StdMisc, StdString
import Data.Error, Data.Func, Data.Tuple, Data.Either, Data.Functor, Data.List, Text, Text.GenJSON
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.SDS, iTasks.Internal.AsyncSDS
......@@ -136,14 +135,20 @@ where
# (mbErr,iworld) = modify (updateProgress clock newResult nextTaskNo nextTaskTime) (sdsFocus (instanceNo,False,True) taskInstance) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
//Store reduct
# (mbErr,iworld) = write newTask (sdsFocus instanceNo taskInstanceTask) EmptyContext iworld
# (mbErr,iworld) = write (?Just newTask) (sdsFocus instanceNo taskInstanceTask) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
//Store value
# (mbErr,iworld) = write newValue (sdsFocus instanceNo taskInstanceValue) EmptyContext iworld
# (mbErr,iworld) = write (?Just newValue) (sdsFocus instanceNo taskInstanceValue) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
= (Ok (),iworld)
cleanupTaskState instanceNo iworld
//Remove value
# (mbErr,iworld) = write ?None (sdsFocus instanceNo taskInstanceValue) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
//Remove reduct
# (mbErr,iworld) = write ?None (sdsFocus instanceNo taskInstanceTask) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
//Remove local shares
# (mbErr,iworld) = write ?None (sdsFocus instanceNo taskInstanceShares) EmptyContext iworld
| mbErr =: (Error _) = (liftError mbErr, iworld)
......
......@@ -119,7 +119,6 @@ newInstanceKey :: !*IWorld -> (!InstanceKey,!*IWorld)
nextInstanceNo :: SimpleSDSLens Int
//All Task state is accessible as shared data sources
//taskListData :: SDSLens (!TaskId,!TaskId,!TaskListFilter,!ExtendedTaskListFilter) (!TaskId, [TaskMeta], Map TaskId (TaskValue a), Task a) | iTask a
taskListMetaData :: SDSLens (!TaskId,!TaskId,!TaskListFilter,!ExtendedTaskListFilter) (!TaskId,![TaskMeta]) [TaskMeta]
taskListDynamicValueData :: SDSLens (!TaskId,!TaskId,!TaskListFilter,!ExtendedTaskListFilter) (Map TaskId (TaskValue DeferredJSON)) (Map TaskId (TaskValue DeferredJSON))
......@@ -142,8 +141,8 @@ taskInstanceParallelTaskListTask :: SDSLens (TaskId,TaskId) (Task DeferredJSO
//Interface used during the evalation of toplevel tasks
//Filtered views on the instance index
taskInstance :: SDSLens (InstanceNo,Bool,Bool) TaskMeta TaskMeta
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (TaskValue DeferredJSON)
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (Task DeferredJSON)
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (?(TaskValue DeferredJSON))
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (?(Task DeferredJSON))
//Locally shared data
taskInstanceShares :: SDSLens InstanceNo (?(Map TaskId DeferredJSON)) (?(Map TaskId DeferredJSON))
......
......@@ -154,8 +154,8 @@ createClientTaskInstance task sessionId instanceNo iworld=:{options={appVersion}
//Create the initial instance data in the store
# meta = {defaultValue & taskId= TaskId instanceNo 0, instanceType=SessionInstance,build=appVersion,createdAt=clock}
= 'SDS'.write meta (sdsFocus (instanceNo,False,False) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write NoValue (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just $ task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> (Ok (TaskId instanceNo 0), iworld)
createSessionTaskInstance :: !(Task a) !Cookies !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
......@@ -166,8 +166,8 @@ createSessionTaskInstance task cookies iworld=:{options={appVersion,autoLayout},
# meta = {defaultValue & taskId= TaskId instanceNo 0,instanceType=SessionInstance
,instanceKey = ?Just instanceKey,build=appVersion,createdAt=clock, cookies = cookies}
= 'SDS'.write meta (sdsFocus (instanceNo,False,False) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write NoValue (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just $ task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> (Ok (instanceNo,instanceKey), iworld)
createStartupTaskInstance :: !(Task a) !TaskAttributes !*IWorld -> (!MaybeError TaskException InstanceNo, !*IWorld) | iTask a
......@@ -175,8 +175,8 @@ createStartupTaskInstance task attributes iworld=:{options={appVersion,autoLayou
# (Ok instanceNo,iworld) = newInstanceNo iworld
# meta = {defaultValue & taskId= TaskId instanceNo 0,instanceType=StartupInstance,build=appVersion,createdAt=clock,taskAttributes=attributes}
= 'SDS'.write meta (sdsFocus (instanceNo,False,False) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write NoValue (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just $ task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> (Ok instanceNo, queueEvent instanceNo ResetEvent iworld)
createDetachedTaskInstance :: !(Task a) !TaskEvalOpts !InstanceNo !TaskAttributes !TaskId !Bool !*IWorld -> (!MaybeError TaskException TaskMeta, !*IWorld) | iTask a
......@@ -187,8 +187,8 @@ createDetachedTaskInstance task evalOpts instanceNo attributes listId refreshImm
# meta = {defaultValue & taskId = TaskId instanceNo 0, instanceType=PersistentInstance,build=appVersion
,createdAt=clock,managementAttributes=attributes, instanceKey= ?Just instanceKey}
= 'SDS'.write meta (sdsFocus (instanceNo,False,False) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write NoValue (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just $ task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> ( Ok meta, if refreshImmediate (queueEvent instanceNo ResetEvent iworld) iworld)
replaceTaskInstance :: !InstanceNo !(Task a) *IWorld -> (!MaybeError TaskException (), !*IWorld) | iTask a
......@@ -196,8 +196,8 @@ replaceTaskInstance instanceNo task iworld=:{options={appVersion},current={taskT
# (meta, iworld) = 'SDS'.read (sdsFocus (instanceNo,False,False) taskInstance) 'SDS'.EmptyContext iworld
| isError meta = (liftError meta, iworld)
# meta ='SDS'.directResult (fromOk meta)
= 'SDS'.write NoValue (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
= 'SDS'.write (?Just NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (?Just $ task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
`b` \iworld -> let in 'SDS'.write {TaskMeta|meta & build=appVersion} (sdsFocus (instanceNo,True,True) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> (Ok (), iworld)
......@@ -380,22 +380,35 @@ where
notify _ _ _ _ = True
//Last computed value for task instance
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (TaskValue DeferredJSON)
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (?(TaskValue DeferredJSON))
taskInstanceValue =: sdsLens "taskInstanceValue" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) ?None taskListDynamicValueData
where
param no = (TaskId 0 0, TaskId no 0, {TaskListFilter|defaultValue & onlyTaskId = ?Just [TaskId no 0]}, defaultValue)
read no values = maybe (Error $ exception ("Could not find value for task instance "<+++ no)) Ok ('DM'.get (TaskId no 0) values)
write no values value = Ok $ ?Just $ 'DM'.put (TaskId no 0) value values
read no values =
maybe (Error $ exception ("Could not find value for task instance "<+++ no)) Ok ('DM'.get (TaskId no 0) values)
write ::
!Int !(Map TaskId (TaskValue DeferredJSON)) !(?(TaskValue DeferredJSON))
-> MaybeError TaskException (?(Map TaskId (TaskValue DeferredJSON)))
write no values ?None = Ok $ ?Just $ 'DM'.del (TaskId no 0) values
write no values (?Just value) = Ok $ ?Just $ 'DM'.put (TaskId no 0) value values
notify _ _ _ _ = True
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (Task DeferredJSON)
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (?(Task DeferredJSON))
taskInstanceTask =: sdsLens "taskInstanceTask" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) ?None taskListDynamicTaskData
where
param no = (TaskId 0 0, TaskId no 0, {TaskListFilter|defaultValue & onlyTaskId = ?Just [TaskId no 0]}, defaultValue)
read no tasks = maybe (Error $ exception ("Could not find task for task instance "<+++ no)) Ok ('DM'.get (TaskId no 0) tasks)
write no tasks task = Ok $ ?Just $ 'DM'.put (TaskId no 0) task tasks
write ::
!Int !(Map TaskId (Task DeferredJSON)) !(?(Task DeferredJSON))
-> MaybeError TaskException (?(Map TaskId (Task DeferredJSON)))
write no tasks ?None = Ok $ ?Just $ 'DM'.del (TaskId no 0) tasks
write no tasks (?Just task) = Ok $ ?Just $ 'DM'.put (TaskId no 0) task tasks
notify _ _ _ _ = True
parallelTaskList :: SDSLens (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
......
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