Skip to content

GitLab

I
iTasks-SDK
Commit 06b527d1 authored by Bas Lijnse's avatar Bas Lijnse
Browse files
Options

Changed storage and evaluation of parallel tasks. Improves performance, but less than hoped for 

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2406 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent c158703f
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 179 additions and 119 deletions
Server/API/Core/CoreCombinators.dcl
View file @ 06b527d1
......@@ -130,3 +130,8 @@ class tune b :: !b !(Task a) -> Task a
instance tune SetLayout //Set layout algorithm
instance tune AfterLayout //Apply a modification after a layout has been run
instance tune ModifyLayout //Modify the existing layout
/**
* Fine tune evaluation behaviour
*/
instance tune LazyRefresh
Server/API/Core/CoreCombinators.icl
View file @ 06b527d1
This diff is collapsed.
Server/API/Core/CoreTasks.icl
View file @ 06b527d1
......@@ -55,7 +55,8 @@ where
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
# res = case val of
Ok val = ValueResult (Value val False) {TaskInfo|lastEvent=ts} (finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
Ok val = ValueResult (Value val False) {TaskInfo|lastEvent=ts,refreshSensitive=True}
(finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
Error e = exception (SharedException e)
= (res,iworld)
eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -80,7 +81,7 @@ where
# (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
//Load next r from shared value
# (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
| isError mbr = (exception (fromError mbr),iworld)//could_not_read_shared_in_interact_exception iworld
| isError mbr = (exception (fromError mbr),iworld)
# nr = fromOk mbr
//Apply refresh function if r or v changed
# changed = (nts =!= ts) || (nr =!= r)
......@@ -90,7 +91,8 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep)
(TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......
Server/API/Core/IntegrationTasks.icl
View file @ 06b527d1
......@@ -63,7 +63,7 @@ where
//Check for its result
eval event repOpts state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
| stable
= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent,refreshSensitive=False} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
| otherwise
= case fromJSON encv of
Just (Right outfile)
......@@ -78,7 +78,7 @@ where
# prompt = toPrompt desc
# editor = {UIControlSequence| attributes = 'Map'.newMap, controls = controls, direction = Vertical}
# rep = TaskRep (UIControlSequence (layout.Layout.interact prompt editor)) []
= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent} rep state,iworld)
= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent,refreshSensitive=True} rep state,iworld)
# (res, world) = 'File'.readFile outfile world
| isError res
//Failed to read file
......@@ -90,7 +90,9 @@ where
Just async
| async.AsyncResult.success
# result = CompletedProcess async.AsyncResult.exitcode
= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) []) (TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent,refreshSensitive=False}
(TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) [])
(TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
| otherwise
= (exception (CallFailed (async.AsyncResult.exitcode,"callProcess: " +++ async.AsyncResult.message)), {IWorld|iworld & world = world})
//Error during initialization
......
Server/API/Core/OptimizedCoreTasks.icl
View file @ 06b527d1
......@@ -42,7 +42,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid
......@@ -84,7 +84,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid
......@@ -123,7 +123,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=True} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun r
......@@ -151,7 +151,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok
......@@ -181,7 +181,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok
......@@ -210,7 +210,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts,refreshSensitive=False} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
matchAndApplyEvent (EditEvent taskId name value) matchId taskTime v mask ts iworld
......
Server/API/Core/SystemTypes.dcl
View file @ 06b527d1
......@@ -703,6 +703,10 @@ instance descr Attribute
instance descr Att
instance descr [d] | descr d
//Task evaluation tuning directives, for increasing performance
:: LazyRefresh = LazyRefresh //If you tune a task in a parallel set with this directive, it not be evaluated unless its focused
//****************************************************************************//
// Generic instances for common library types
//****************************************************************************//
......
Server/Framework/Engine.icl
View file @ 06b527d1
......@@ -54,6 +54,8 @@ initIWorld sdkPath world
,nextTaskNo = 0
,localShares = newMap
,localLists = newMap
,localTasks = newMap
,eventRoute = newMap
,readShares = []
,sessions = newMap
,uis = newMap
......
Server/Framework/IWorld.dcl
View file @ 06b527d1
......@@ -27,6 +27,8 @@ from HttpServer import class HttpEnv
, nextTaskNo :: !TaskNo // The next task number to assign
, localShares :: !Map TaskId JSONNode // The set of locally shared values
, localLists :: !Map TaskId [TaskListEntry] // The set of local parallel task lists
, localTasks :: !Map TaskId Dynamic // The set of local parallel tasks
, eventRoute :: !Map TaskId Int // Index of parallel branches the event is targeted at
, readShares :: ![String] // The IDs of shares from which was read
, sessions :: !Map SessionId InstanceNo // Index of sessions to instance numbers
, uis :: !Map SessionId (!Int,!UIDef) // Previous ui versions to optimize output sent to clients
......
Server/Framework/Task.dcl
View file @ 06b527d1
......@@ -7,6 +7,7 @@ definition module Task
import SystemTypes, HTTP, GenVisualize, iTaskClass, GenRecord
from TaskState import :: TaskTree
from LayoutCombinators import :: Layout
from Map import :: Map
derive JSONEncode Task
derive JSONDecode Task
......@@ -35,8 +36,8 @@ derive gPutRecordFields Task
| DestroyedResult //If a task finalizes and cleaned up it gives this result
:: TaskInfo =
{ lastEvent :: TaskTime //When was the last edit, action or focus event in this task
// , lastValueChange :: TaskTime //When was the last time this task's value changed
{ lastEvent :: !TaskTime //When was the last edit, action or focus event in this task
, refreshSensitive :: !Bool //Can refresh events change the value or ui of this task (e.g. because shared data is read)
}
:: TaskRepOpts =
......
Server/Framework/Task.icl
View file @ 06b527d1
......@@ -10,11 +10,11 @@ mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
evalOnce f _ repOpts (TCInit taskId ts) iworld = case f taskId iworld of
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
(Error (e,s), iworld) = (ExceptionResult e s, iworld)
evalOnce f _ repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
Just a = (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) state, iworld)
Just a = (ValueResult (Value a True) {lastEvent=ts,refreshSensitive=False} (finalizeRep repOpts rep) state, iworld)
Nothing = (exception "Corrupt task result", iworld)
evalOnce f _ _ (TCDestroy _) iworld = (DestroyedResult,iworld)
......
Server/Framework/TaskEval.icl
View file @ 06b527d1
......@@ -22,8 +22,7 @@ createSessionTaskInstance task event iworld=:{currentDateTime,taskTime}
# meta = createMeta instanceNo (Just sessionId) 0 (Just worker) mmeta pmeta
# (_,iworld) = 'SharedDataSource'.write meta (taskInstanceMeta instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createResult taskTime) (taskInstanceResult instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createRep) (taskInstanceRep instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
//Register the sessionId -> instanceNo relation
# iworld = registerSession sessionId instanceNo iworld
//Evaluate once
......@@ -42,8 +41,7 @@ createTopTaskInstance task mmeta issuer parent iworld=:{currentDateTime,taskTim
# meta = createMeta instanceNo Nothing parent Nothing mmeta pmeta
# (_,iworld) = 'SharedDataSource'.write meta (taskInstanceMeta instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createReduct instanceNo task taskTime) (taskInstanceReduct instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createResult taskTime) (taskInstanceResult instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createRep) (taskInstanceRep instanceNo) iworld
# (_,iworld) = 'SharedDataSource'.write (createResult instanceNo taskTime) (taskInstanceResult instanceNo) iworld
= (TaskId instanceNo 0, iworld)
createMeta :: !InstanceNo (Maybe SessionId) InstanceNo !(Maybe User) !ManagementMeta !ProgressMeta -> TIMeta
......@@ -52,7 +50,7 @@ createMeta instanceNo sessionId parent worker mmeta pmeta
createReduct :: !InstanceNo !(Task a) !TaskTime -> TIReduct | iTask a
createReduct instanceNo task taskTime
= {TIReduct|task=toJSONTask task,nextTaskNo=2,nextTaskTime=1,tree=(TCInit (TaskId instanceNo 0) 1),shares = 'Map'.newMap, lists = 'Map'.newMap}
= {TIReduct|task=toJSONTask task,nextTaskNo=2,nextTaskTime=1,shares = 'Map'.newMap, lists = 'Map'.newMap, tasks= 'Map'.newMap}
where
toJSONTask (Task eval) = Task eval`
where
......@@ -60,11 +58,8 @@ where
(ValueResult val ts rep tree,iworld) = (ValueResult (fmap toJSON val) ts rep tree, iworld)
(ExceptionResult e str,iworld) = (ExceptionResult e str,iworld)
createResult :: TaskTime -> TIResult
createResult taskTime = TIValue NoValue taskTime
createRep :: TIRep
createRep = TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[],direction = Vertical,actions = []}) []
createResult :: !InstanceNo !TaskTime -> TaskResult JSONNode
createResult instanceNo taskTime = ValueResult NoValue {TaskInfo|lastEvent=taskTime,refreshSensitive=True} (TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[],direction = Vertical,actions = []}) []) (TCInit (TaskId instanceNo 0) 1)
//Evaluate a session task instance when a new event is received from a client
evalSessionTaskInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
......@@ -128,22 +123,26 @@ evalTaskInstance event instanceNo iworld=:{currentDateTime,currentUser,currentIn
# meta=:{TIMeta|sessionId,parent,worker=Just worker,progress} = fromOk meta
# (reduct, iworld) = 'SharedDataSource'.read (taskInstanceReduct instanceNo) iworld
| isError reduct = (liftError reduct, iworld)
# reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,tree,shares,lists} = fromOk reduct
# reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,shares,lists,tasks} = fromOk reduct
# (result, iworld) = 'SharedDataSource'.read (taskInstanceResult instanceNo) iworld
| isError result = (liftError result, iworld)
= case fromOk result of
(TIException e msg) = (Ok (ExceptionResult e msg), iworld)
(TIValue val _)
(ExceptionResult e msg) = (Ok (ExceptionResult e msg), iworld)
(ValueResult val _ _ tree)
//Eval instance
# repAs = {TaskRepOpts|useLayout=Nothing,afterLayout=Nothing,modLayout=Nothing,appFinalLayout=isJust sessionId}
//Update current process id & eval stack in iworld
# taskId = TaskId instanceNo 0
# eventRoute = determineEventRoute event lists
# iworld = {iworld & currentInstance = instanceNo
, currentUser = worker
, nextTaskNo = reduct.TIReduct.nextTaskNo
, taskTime = reduct.TIReduct.nextTaskTime
, localShares = shares
, localLists = lists}
, localLists = lists
, localTasks = tasks
, eventRoute = eventRoute
}
//Clear the instance's registrations for share changes
# iworld = clearShareRegistrations instanceNo iworld
//Apply task's eval function and take updated nextTaskId from iworld
......@@ -158,18 +157,18 @@ evalTaskInstance event instanceNo iworld=:{currentDateTime,currentUser,currentIn
# (nextTaskNo,iworld) = getNextTaskNo iworld
# (shares,iworld) = getLocalShares iworld
# (lists,iworld) = getLocalLists iworld
# reduct = {TIReduct|reduct & nextTaskNo = nextTaskNo, nextTaskTime = nextTaskTime + 1, tree = tasktree result, shares = shares, lists = lists}
# (tasks,iworld) = getLocalTasks iworld
# reduct = {TIReduct|reduct & nextTaskNo = nextTaskNo, nextTaskTime = nextTaskTime + 1, shares = shares, lists = lists, tasks = tasks}
# (_,iworld) = 'SharedDataSource'.writeFilterMsg reduct ((<>) instanceNo) (taskInstanceReduct instanceNo) iworld //TODO Check error
//Store the result
# (_,iworld) = 'SharedDataSource'.writeFilterMsg (taskres result) ((<>) instanceNo) (taskInstanceResult instanceNo) iworld //TODO Check error
//Store the representation
# (_,iworld) = 'SharedDataSource'.writeFilterMsg (taskrep result) ((<>) instanceNo) (taskInstanceRep instanceNo) iworld //TODO Check error
# (_,iworld) = 'SharedDataSource'.writeFilterMsg result ((<>) instanceNo) (taskInstanceResult instanceNo) iworld //TODO Check error
//Return the result
= (Ok result, iworld)
where
getNextTaskNo iworld=:{IWorld|nextTaskNo} = (nextTaskNo,iworld)
getLocalShares iworld=:{IWorld|localShares} = (localShares,iworld)
getLocalLists iworld=:{IWorld|localLists} = (localLists,iworld)
getLocalTasks iworld=:{IWorld|localTasks} = (localTasks,iworld)
updateProgress now result progress
# progress = {progress & firstEvent = Just (fromMaybe now progress.firstEvent), latestEvent = Just now}
......@@ -179,15 +178,41 @@ where
(ValueResult _ _ (TaskRep ui _) _) = {progress & stable = False, latestAttributes = uiDefAttributes ui}
_ = {progress & stable = False}
tasktree (ValueResult _ _ _ tree) = tree
tasktree (ExceptionResult _ _) = TCNop
taskres (ValueResult val {TaskInfo|lastEvent} _ _) = TIValue val lastEvent
taskres (ExceptionResult e str) = TIException e str
taskrep (ValueResult _ _ rep _) = rep
taskrep (ExceptionResult _ str) = TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap, controls = [(stringDisplay str, 'Map'.newMap)], direction = Vertical}) []
determineEventRoute :: Event (Map TaskId [TaskListEntry]) -> Map TaskId Int
determineEventRoute RefreshEvent _ = 'Map'.newMap
determineEventRoute (EditEvent id _ _) lists = determineEventRoute` id ('Map'.toList lists)
determineEventRoute (ActionEvent id _) lists = determineEventRoute` id ('Map'.toList lists)
determineEventRoute (FocusEvent id) lists = determineEventRoute` id ('Map'.toList lists)
//TODO: Optimize this search function
determineEventRoute` :: TaskId [(TaskId,[TaskListEntry])] -> Map TaskId Int
determineEventRoute` eventId lists = 'Map'.fromList (search eventId)
where
search searchId = case searchInLists searchId lists of
Just (parId, index) = [(parId,index):search parId]
Nothing = []
searchInLists searchId [] = Nothing
searchInLists searchId [(parId,entries):xs] = case [i \\ e <- entries & i <- [0..] | inEntry searchId e] of
[index] = Just (parId,index)
_ = searchInLists searchId xs
inEntry searchId {TaskListEntry|lastEval=ValueResult _ _ _ tree} = inTree searchId tree
inEntry _ _ = False
inTree searchId (TCInit taskId _) = searchId == taskId
inTree searchId (TCBasic taskId _ _ _) = searchId == taskId
inTree searchId (TCInteract taskId _ _ _ _ _) = searchId == taskId
inTree searchId (TCInteract1 taskId _ _ _) = searchId == taskId
inTree searchId (TCInteract2 taskId _ _ _ _) = searchId == taskId
inTree searchId (TCProject taskId _ tree) = searchId == taskId || inTree searchId tree
inTree searchId (TCStep taskId _ (Left tree)) = searchId == taskId || inTree searchId tree
inTree searchId (TCStep taskId _ (Right (_,_,tree))) = searchId == taskId || inTree searchId tree
inTree searchId (TCParallel taskId _) = searchId == taskId
inTree searchId (TCShared taskId _ tree) = searchId == taskId || inTree searchId tree
inTree searchId (TCStable taskId _ _) = searchId == taskId
inTree searchId _ = False
localShare :: !TaskId -> Shared a | iTask a
localShare taskId=:(TaskId instanceNo taskNo) = createChangeOnWriteSDS "localShare" shareKey read write
where
......@@ -255,7 +280,7 @@ where
(Error _,iworld)
= (Error ("Could not load remote task list " +++ shareKey), iworld)
toItem {TaskListEntry|entryId,state,result=TIValue val ts,attributes}
toItem {TaskListEntry|entryId,state,lastEval=ValueResult val _ _ _,attributes}
= {taskId = entryId
,value = deserialize val
,managementMeta = management
......
Server/Framework/TaskState.dcl
View file @ 06b527d1
......@@ -4,12 +4,11 @@ import SystemTypes
from Task import :: TaskTime, :: TaskResult, :: TaskRep
derive JSONEncode TIMeta, TIReduct, TIResult, TaskTree
derive JSONDecode TIMeta, TIReduct, TIResult, TaskTree
derive JSONEncode TIMeta, TIReduct, TaskTree
derive JSONDecode TIMeta, TIReduct, TaskTree
//Persistent context of active tasks
//Split up version of task instance information
:: TaskInstance :== (!TIMeta,!TIReduct,!TIResult,!TIRep)
:: TIMeta =
{ instanceNo :: !InstanceNo //Unique global identification
......@@ -26,17 +25,11 @@ derive JSONDecode TIMeta, TIReduct, TIResult, TaskTree
{ task :: !Task JSONNode
, nextTaskNo :: !TaskNo
, nextTaskTime :: !TaskTime
, tree :: !TaskTree //Internal task tree state
, shares :: !Map TaskId JSONNode //Locally shared data
, lists :: !Map TaskId [TaskListEntry] //Parallel task lists
, tasks :: !Map TaskId Dynamic //Task functions of embedded parallel tasks
}
:: TIResult
= TIValue !(TaskValue JSONNode) !TaskTime
| TIException !Dynamic !String
:: TIRep :== TaskRep
:: TaskTree
= TCInit !TaskId !TaskTime //Initial state for all tasks
| TCBasic !TaskId !TaskTime !JSONNode !Bool //Encoded value and stable indicator
......@@ -61,13 +54,13 @@ derive JSONDecode DeferredJSON
:: TaskListEntry =
{ entryId :: !TaskId //Identification of entries in the list (for easy updating)
, state :: !TaskListEntryState //Tree if embedded, or instance no if detached
, result :: !TIResult //Stored result of last evaluation (for detached tasks this is a cached copy)
, lastEval :: !TaskResult JSONNode //Result of last evaluation
, attributes :: !Map String String //Stored attributes of last evaluation
, createdAt :: !TaskTime //Time the entry was added to the set (used by layouts to highlight new items)
, lastEvent :: !TaskTime //Last modified time
, removed :: !Bool //Flag for marking this entry as 'removed', actual removal is done by the controlling parallel combinator
}
} //If it is false we have determined that this is not necessary during the last computation
:: TaskListEntryState
= EmbeddedState !Dynamic !TaskTree //The task definition, task tree and last computed attributes
= EmbeddedState //An embedded task
| DetachedState !InstanceNo !ProgressMeta !ManagementMeta //A reference to the detached task (management and progress meta are cached copies)
Server/Framework/TaskState.icl
View file @ 06b527d1
......@@ -5,8 +5,8 @@ from iTasks import JSONEncode, JSONDecode
from Task import :: Event, :: TaskTime, :: TaskResult(..), :: TaskInfo(..), :: TaskRep(..), :: TaskServiceRep, :: TaskPart, :: TaskCompositionType
import JSON
derive JSONEncode TIMeta, TIReduct, TIResult, TaskTree, TaskListEntry, TaskListEntryState
derive JSONDecode TIMeta, TIReduct, TIResult, TaskTree, TaskListEntry, TaskListEntryState
derive JSONEncode TIMeta, TIReduct, TaskTree, TaskListEntry, TaskListEntryState, TaskResult, TaskRep, TaskInfo
derive JSONDecode TIMeta, TIReduct, TaskTree, TaskListEntry, TaskListEntryState, TaskResult, TaskRep, TaskInfo
//IS ALSO DERIVED IN TASK STORE: SEEMS REDUNDANT
derive JSONEncode UIDef, UIAction, UIViewport, UIWindow, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
......@@ -15,7 +15,7 @@ derive JSONEncode UIProgressOpts, UISliderOpts, UIGoogleMapOpts, UIGoogleMapMark
derive JSONEncode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts, UIViewportOpts
derive JSONEncode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
derive JSONDecode TaskRep, TaskCompositionType
derive JSONDecode TaskCompositionType
derive JSONDecode UIDef, UIAction, UIViewport, UIWindow, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
derive JSONDecode UIControlSequence, UIActionSet, UIControlGroup, UIAbstractContainer
derive JSONDecode UIProgressOpts, UISliderOpts, UIGoogleMapOpts, UIGoogleMapMarker, UIGoogleMapOptions, UICodeOpts, UIGridOpts, UIIconOpts, UILabelOpts, UITabOpts, UITaskletOpts, UITaskletPHOpts, UITreeNode
......
Server/Framework/TaskStore.dcl
View file @ 06b527d1
......@@ -23,8 +23,7 @@ taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWor
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
taskInstanceResult :: !InstanceNo -> RWShared (TaskResult JSONNode) (TaskResult JSONNode) IWorld
//Documents
createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError Document, !*IWorld)
......
Server/Framework/TaskStore.icl
View file @ 06b527d1
......@@ -6,15 +6,15 @@ import IWorld, TaskState, Task, Store, Util, Text, Time, Random, JSON, UIDefinit
import SharedDataSource
import SerializationGraphCopy //TODO: Make switchable from within iTasks module
//Derives required for storage of TUI definitions
derive JSONEncode TaskRep, TaskCompositionType
//Derives required for storage of UI definitions
derive JSONEncode TaskResult, TaskInfo, TaskRep, TaskCompositionType
derive JSONEncode UIDef, UIAction, UIViewport, UIWindow, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
derive JSONEncode UIProgressOpts, UISliderOpts, UIGoogleMapOpts, UIGoogleMapMarker, UIGoogleMapOptions, UICodeOpts, UIGridOpts, UIIconOpts, UILabelOpts, UITabOpts, UITaskletOpts, UITaskletPHOpts, UITreeNode
derive JSONEncode UIControlSequence, UIActionSet, UIControlGroup, UIAbstractContainer
derive JSONEncode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts, UIViewportOpts
derive JSONEncode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
derive JSONDecode TaskRep, TaskCompositionType
derive JSONDecode TaskResult, TaskInfo, TaskRep, TaskCompositionType
derive JSONDecode UIDef, UIAction, UIViewport, UIWindow, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UIItemsOpts
derive JSONDecode UIProgressOpts, UISliderOpts, UIGoogleMapOpts, UIGoogleMapMarker, UIGoogleMapOptions, UICodeOpts, UIGridOpts, UIIconOpts, UILabelOpts, UITabOpts, UITaskletOpts, UITaskletPHOpts, UITreeNode
derive JSONDecode UIControlSequence, UIActionSet, UIControlGroup, UIAbstractContainer
......@@ -80,12 +80,9 @@ where
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceReduct instanceNo = storeAccess NS_TASK_INSTANCES (reduct_store instanceNo) Nothing
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceResult :: !InstanceNo -> RWShared (TaskResult JSONNode) (TaskResult JSONNode) IWorld
taskInstanceResult instanceNo = storeAccess NS_TASK_INSTANCES (result_store instanceNo) Nothing
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
taskInstanceRep instanceNo = storeAccess NS_TASK_INSTANCES (rep_store instanceNo) Nothing
createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError Document, !*IWorld)
createDocument name mime content iworld
# (documentId, iworld) = newDocumentId 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