We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit c32040f8 authored by Bas Lijnse's avatar Bas Lijnse

Combined types for parallel and global task meta data

parent b464b512
Pipeline #33032 failed with stage
in 1 minute and 52 seconds
definition module iTasks.Internal.IWorld
from System.FilePath import :: FilePath
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Data.Error import :: MaybeError(..), :: MaybeErrorString(..)
from Data.Set import :: Set
from Data.Queue import :: Queue
from Data.Either import :: Either
from StdFile import class FileSystem, class FileEnv
from System.Time import :: Timestamp, :: Timespec
from Text.GenJSON import :: JSONNode
from iTasks.Engine import :: EngineOptions
from iTasks.UI.Definition import :: UI, :: UIType
from iTasks.Internal.TaskState import :: ParallelTaskState, :: TIMeta, :: DeferredJSON
from iTasks.Internal.Task import :: ConnectionTask
from iTasks.Internal.TaskEval import :: TaskTime
from System.FilePath import :: FilePath
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Data.Error import :: MaybeError(..), :: MaybeErrorString(..)
from Data.Set import :: Set
from Data.Queue import :: Queue
from Data.Either import :: Either
from StdFile import class FileSystem, class FileEnv
from System.Time import :: Timestamp, :: Timespec
from Text.GenJSON import :: JSONNode
from iTasks.Engine import :: EngineOptions
from iTasks.UI.Definition import :: UI, :: UIType
from iTasks.Internal.TaskState import :: TaskMeta
from iTasks.Internal.Task import :: ConnectionTask
from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.Util.DeferredJSON import :: DeferredJSON
from iTasks.WF.Definition import :: TaskValue, :: Event, :: TaskId, :: InstanceNo, :: TaskNo, :: TaskException
from iTasks.WF.Combinators.Core import :: ParallelTaskType, :: TaskListItem
......
......@@ -17,7 +17,7 @@ import iTasks.Internal.SDS
from iTasks.UI.Layout import :: LUI, :: LUIMoves, :: LUIMoveID, :: LUIEffectStage, :: LUINo
from iTasks.Util.DeferredJSON import :: DeferredJSON(..)
from iTasks.Internal.TaskState import :: TIMeta(..) , :: TIType(..), :: TaskChange(..)
from iTasks.Internal.TaskState import :: TaskMeta(..) , :: TIType(..), :: TaskChange(..)
import iTasks.Internal.TaskEval
from iTasks.SDS.Combinators.Common import toDynamic
......
......@@ -21,7 +21,7 @@ import qualified iTasks.Internal.SDS as SDS
from iTasks.SDS.Combinators.Common import sdsFocus, >*|, mapReadWrite, mapReadWriteError
from StdFunc import const, o
derive gEq TIMeta, TIType, TaskChange
derive gEq TaskMeta, TIType, TaskChange
mkEvalOpts :: TaskEvalOpts
mkEvalOpts =
......
......@@ -31,8 +31,10 @@ from System.FilePath import :: FilePath
//FIXME: Extensions should not be imported in core
from iTasks.Extensions.Document import :: Document, :: DocumentId
derive JSONEncode TIMeta, TIType, TIReduct
derive JSONDecode TIMeta, TIType, TIReduct
derive JSONEncode TaskMeta, TIType, TIReduct
derive JSONDecode TaskMeta, TIType, TIReduct
derive gDefault TaskMeta
//Persistent context of active tasks
//Split up version of task instance information
......@@ -49,7 +51,7 @@ derive JSONDecode TIMeta, TIType, TIReduct
}
*/
:: TIMeta =
:: TaskMeta =
//Static information
{ taskId :: !TaskId //Unique global identification
, instanceType :: !TIType //There are 3 types of tasks: startup tasks, sessions, and persistent tasks
......@@ -70,19 +72,6 @@ derive JSONDecode TIMeta, TIType, TIReduct
, initialized :: !Bool //TODO: Get rid of in this record
}
:: ParallelTaskState =
{ taskId :: !TaskId //Identification
, detached :: !Bool
, taskAttributes :: !TaskAttributes //Attributes that reflect the latest attributes from the task UI
, managementAttributes :: !TaskAttributes //Attributes that are explicitly written to the list through the tasklist
, unsyncedAttributes :: !Set String //When the `managementAttributes` are written they need to be synced to the UI on the next evaluation
, createdAt :: !TaskTime //Time the entry was added to the set (used by layouts to highlight new items)
, lastEvent :: !TaskTime //Last modified time
, change :: !Maybe TaskChange //Changes like removing or replacing a parallel task are only done when the
//parallel is evaluated. This field is used to schedule such changes.
, initialized :: !Bool
}
:: TaskChange
= RemoveTask //Mark for removal from the set on the next evaluation
| ReplaceTask !Dynamic //Replace the task on the next evaluation
......@@ -104,7 +93,6 @@ derive JSONDecode TIMeta, TIType, TIReduct
= TIValue !(TaskValue DeferredJSON)
| TIException !Dynamic !String
derive gDefault TIMeta
:: InstanceFilter =
{ //'Vertical' filters
......@@ -143,7 +131,7 @@ newInstanceKey :: !*IWorld -> (!InstanceKey,!*IWorld)
nextInstanceNo :: SimpleSDSLens Int
//This index contains all meta-data about the task instances on this engine
taskInstanceIndex :: SimpleSDSLens [TIMeta]
taskInstanceIndex :: SimpleSDSLens [TaskMeta]
//Task instance state is accessible as shared data sources
filteredInstanceIndex :: SDSLens InstanceFilter [InstanceData] [InstanceData]
......@@ -161,7 +149,7 @@ taskInstanceReduct :: SDSLens InstanceNo (Maybe TIReduct) (Maybe TIRe
taskInstanceValue :: SDSLens InstanceNo (Maybe TIValue) (Maybe TIValue)
taskInstanceShares :: SDSLens InstanceNo (Maybe (Map TaskId DeferredJSON)) (Maybe (Map TaskId DeferredJSON))
taskInstanceParallelTaskLists :: SDSLens InstanceNo (Maybe (Map TaskId [ParallelTaskState])) (Maybe (Map TaskId [ParallelTaskState]))
taskInstanceParallelTaskLists :: SDSLens InstanceNo (Maybe (Map TaskId [TaskMeta])) (Maybe (Map TaskId [TaskMeta]))
taskInstanceParallelValues :: SDSLens InstanceNo (Maybe (Map TaskId (Map TaskId (TaskValue DeferredJSON)))) (Maybe (Map TaskId (Map TaskId (TaskValue DeferredJSON))))
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)]
......@@ -175,11 +163,11 @@ allInstanceIO :: SimpleSDSLens (Map InstanceNo (!String,Timespec))
localShare :: SDSLens TaskId a a | iTask a
//Core parallel task list state structure
taskInstanceParallelTaskList :: SDSLens (TaskId,TaskListFilter) [ParallelTaskState] [ParallelTaskState]
taskInstanceParallelTaskList :: SDSLens (TaskId,TaskListFilter) [TaskMeta] [TaskMeta]
taskInstanceParallelTaskListValues :: SDSLens (TaskId,TaskListFilter) (Map TaskId (TaskValue DeferredJSON)) (Map TaskId (TaskValue DeferredJSON))
//Private interface used during evaluation of parallel combinator
taskInstanceParallelTaskListItem :: SDSLens (TaskId,TaskId) ParallelTaskState ParallelTaskState
taskInstanceParallelTaskListItem :: SDSLens (TaskId,TaskId) TaskMeta TaskMeta
taskInstanceParallelTaskListValue :: SDSLens (TaskId,TaskId) (TaskValue DeferredJSON) (TaskValue DeferredJSON)
taskInstanceEmbeddedTask :: SDSLens TaskId (Task a) (Task a) | iTask a
......
This diff is collapsed.
......@@ -18,7 +18,6 @@ from Data.Foldable import maximum
import Text.GenJSON
from StdFunc import o, const, id, flip
from iTasks.Internal.TaskState import :: TIMeta(..), :: TIType(..) , :: TaskChange
from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.WF.Combinators.Core import :: AttachmentStatus
......
......@@ -292,23 +292,28 @@ initParallelTask ::
!(ParallelTask a)
!*IWorld
->
(!MaybeError TaskException (ParallelTaskState, Maybe (TaskId,Task a)), !*IWorld)
(!MaybeError TaskException (TaskMeta, Maybe (TaskId,Task a)), !*IWorld)
| iTask a
initParallelTask evalOpts listId parType parTask iworld=:{current={taskTime}}
initParallelTask evalOpts listId parType parTask iworld=:{clock,current={taskTime}}
# (mbTaskStuff,iworld) = case parType of
Embedded = mkEmbedded iworld
(Detached evalDirect attr) = mkDetached evalDirect attr iworld
= case mbTaskStuff of
Ok (taskId,mbTask)
# state =
{ ParallelTaskState
{ TaskMeta
| taskId = taskId
, detached = isNothing mbTask
, instanceType = TIPersistent "FIXME" (Just listId)//FIXME: Redundant information
, build = "FIXME"
, createdAt = clock
, valuestatus = Unstable
, attachedTo = []
, instanceKey = Nothing
, firstEvent = Just clock
, lastEvent = Just clock
, taskAttributes = 'DM'.newMap
, managementAttributes = 'DM'.newMap
, unsyncedAttributes = 'DS'.newSet
, createdAt = taskTime
, lastEvent = taskTime
, change = Nothing
, initialized = False
}
......@@ -333,7 +338,7 @@ where
evalParallelTasks :: !Event !TaskEvalOpts
[TaskCont [(TaskTime,TaskValue a)] (ParallelTaskType,ParallelTask a)]
[(TaskId, TaskResult a)] [ParallelTaskState] (Map TaskId (TaskValue DeferredJSON)) !*IWorld
[(TaskId, TaskResult a)] [TaskMeta] (Map TaskId (TaskValue DeferredJSON)) !*IWorld
->
(MaybeError TaskException [TaskResult a],!*IWorld) | iTask a
evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [] values iworld
......@@ -364,7 +369,7 @@ evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [
# taskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeAttributes=True,includeProgress=True}
# (mbError,iworld) = modify (\states -> states ++ [state]) (sdsFocus (listId,taskListFilter) taskInstanceParallelTaskList) EmptyContext iworld
| mbError =:(Error _) = (liftError mbError,iworld)
# taskId = state.ParallelTaskState.taskId
# taskId = state.TaskMeta.taskId
//Store the task function
# (mbError,iworld) = (write (snd (fromJust mbTask)) (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld)
| mbError =:(Error _) = (liftError mbError,iworld)
......@@ -373,10 +378,10 @@ evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [
//There is more work to do:
todo = evalParallelTasks event evalOpts conts completed todo values iworld
where
isRemoved {ParallelTaskState|change=Just RemoveTask} = True
isRemoved {TaskMeta|change=Just RemoveTask} = True
isRemoved _ = False
addManagementAttributeChanges {ParallelTaskState|managementAttributes,unsyncedAttributes} (ValueResult val evalInfor rep tree)
addManagementAttributeChanges {TaskMeta|managementAttributes,unsyncedAttributes} (ValueResult val evalInfor rep tree)
//Add the explicit attributes
# rep = case rep of
ReplaceUI (UI type attr items)
......@@ -390,10 +395,10 @@ where
= (ValueResult val evalInfor rep tree)
addManagementAttributeChanges pts c = c
clearAttributeSync pts = {ParallelTaskState| pts & unsyncedAttributes = 'DS'.newSet}
clearAttributeSync meta = {TaskMeta| meta & unsyncedAttributes = 'DS'.newSet}
//Evaluate an embedded parallel task
evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [t=:{ParallelTaskState|taskId=taskId=:(TaskId _ taskNo)}:todo] values iworld
evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [t=:{TaskMeta|taskId=taskId=:(TaskId _ taskNo)}:todo] values iworld
# lastValue = fromMaybe NoValue $ 'DM'.get taskId values
= case evalParallelTask listId event evalOpts t lastValue iworld of
(Error e, iworld) = (Error e,iworld)
......@@ -408,14 +413,16 @@ evalParallelTasks event evalOpts=:{TaskEvalOpts|taskId=listId} conts completed [
(Ok result=:DestroyedResult, iworld)
= evalParallelTasks event evalOpts conts [(taskId, result):completed] todo values iworld
where
evalParallelTask :: TaskId !Event !TaskEvalOpts ParallelTaskState (TaskValue DeferredJSON) !*IWorld
evalParallelTask :: TaskId !Event !TaskEvalOpts TaskMeta (TaskValue DeferredJSON) !*IWorld
-> *(MaybeError TaskException (TaskResult a), !*IWorld) | iTask a
evalParallelTask listId event evalOpts taskState=:{ParallelTaskState|detached} value iworld
evalParallelTask listId=:(TaskId listInstance _) event evalOpts taskState=:{TaskMeta|taskId=TaskId taskInstance _} value iworld
| detached = evalDetachedParallelTask listId event evalOpts taskState iworld
= evalEmbeddedParallelTask listId event evalOpts taskState value iworld
where
detached = taskInstance <> listInstance
evalEmbeddedParallelTask listId event evalOpts
{ParallelTaskState|taskId,createdAt,change,initialized} value iworld=:{current={taskTime}}
{TaskMeta|taskId,createdAt,change,initialized} value iworld=:{current={taskTime}}
//Lookup task evaluation function and task evaluation state
# (mbTask,iworld) = read (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld
| mbTask =:(Error _) = (Error (fromError mbTask),iworld)
......@@ -446,8 +453,8 @@ where
| mbError =:(Error _) = (Error (fromError mbError), iworld)
//Write meta data
# (mbError,iworld) = modify
(\pts -> {ParallelTaskState|pts &
taskAttributes = taskAttributeUpdate pts.ParallelTaskState.taskAttributes, initialized = True})
(\meta -> {TaskMeta|meta &
taskAttributes = taskAttributeUpdate meta.TaskMeta.taskAttributes, initialized = True})
(sdsFocus (listId,taskId) taskInstanceParallelTaskListItem)
EmptyContext iworld
| mbError =:(Error _) = (Error (fromError mbError),iworld)
......@@ -467,8 +474,8 @@ where
(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
evalDetachedParallelTask :: !TaskId !Event !TaskEvalOpts !TaskMeta !*IWorld -> *(MaybeError TaskException (TaskResult a), *IWorld) | iTask a
evalDetachedParallelTask listId event evalOpts {TaskMeta|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)
......@@ -503,10 +510,12 @@ where
minimalTaskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False
,includeValue=False,includeAttributes=False,includeProgress=False}
destroyParallelTask listId (_,exceptions,iworld) {ParallelTaskState|taskId,detached}
destroyParallelTask listId=:(TaskId listInstance _) (_,exceptions,iworld) {TaskMeta|taskId=taskId=:(TaskId taskInstance _)}
= case (if detached destroyDetachedParallelTask destroyEmbeddedParallelTask) listId taskId iworld of
(Error e, iworld) = (DestroyedResult, e ++ exceptions,iworld)
(Ok res, iworld) = (res, exceptions,iworld)
where
detached = taskInstance <> listInstance
destroyResult :: (TaskResult a) -> (TaskResult [(Int,TaskValue a)])
destroyResult DestroyedResult = DestroyedResult
......@@ -622,7 +631,7 @@ where
# (mbStateMbTask, iworld) = initParallelTask mkEvalOpts listId parType parTask iworld
= case mbStateMbTask of
Ok (state,mbTask)
# taskId = state.ParallelTaskState.taskId
# taskId = state.TaskMeta.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)
......@@ -671,8 +680,8 @@ where
//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 RemoveTask}:ss]
markAsRemoved removeId [s=:{TaskMeta|taskId}:ss]
| taskId == removeId = [{TaskMeta|s & change = Just RemoveTask}:ss]
| otherwise = [s:markAsRemoved removeId ss]
replaceTask :: !TaskId !(ParallelTask a) !(SharedTaskList a) -> Task () | iTask a
......@@ -705,8 +714,8 @@ where
= (ValueResult (Value () True) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (treturn ()), iworld)
scheduleReplacement replaceId task [] = []
scheduleReplacement replaceId task [s=:{ParallelTaskState|taskId}:ss]
| taskId == replaceId = [{ParallelTaskState|s & change = Just (ReplaceTask (dynamic task :: Task a^))}:ss]
scheduleReplacement replaceId task [s=:{TaskMeta|taskId}:ss]
| taskId == replaceId = [{TaskMeta|s & change = Just (ReplaceTask (dynamic task :: Task a^))}:ss]
| otherwise = [s:scheduleReplacement replaceId task ss]
attach :: !InstanceNo !Bool -> Task AttachmentStatus
......
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