Skip to content

GitLab

I
iTasks-SDK
Commit 112d4089 authored by Bas Lijnse's avatar Bas Lijnse
Browse files
Options

Simplified events 

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/itwc-experiments@2159 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent bd55b755
Hide whitespace changes
Inline Side-by-side
Showing with 208 additions and 245 deletions
Client/app/controller/Controller.js
View file @ 112d4089
...@@ -82,12 +82,14 @@ Ext.define('itwc.controller.Controller',{ ...@@ -82,12 +82,14 @@ Ext.define('itwc.controller.Controller',{
onAction: function(taskId, actionId) { onAction: function(taskId, actionId) {
console.log("Action event", taskId, actionId); console.log("Action event", taskId, actionId);
var me = this, var me = this,
params = {commitEvent: Ext.encode([taskId,actionId])}; params = {actionEvent: Ext.encode([taskId,actionId])};
me.sendMessage(params); //TEMPORARILY DUMB WITHOUT QUEUE AND TRACKING me.sendMessage(params); //TEMPORARILY DUMB WITHOUT QUEUE AND TRACKING
}, },
//iTasks focus events //iTasks focus events
onFocus: function(taskId) { onFocus: function(taskId) {
console.log("Focus event", taskId); var me = this,
params = {focusEvent: Ext.encode(taskId)};
me.sendMessage(params);
}, },
//Send a message to the server //Send a message to the server
sendMessage: function(msg) { sendMessage: function(msg) {
......
Server/API/Core/CoreCombinators.icl
View file @ 112d4089
...@@ -23,7 +23,7 @@ getNextTaskId iworld=:{currentInstance,nextTaskNo} = (TaskId currentInstance nex ...@@ -23,7 +23,7 @@ getNextTaskId iworld=:{currentInstance,nextTaskNo} = (TaskId currentInstance nex
transform :: ((TaskValue a) -> TaskValue b) !(Task a) -> Task b | iTask a & iTask b transform :: ((TaskValue a) -> TaskValue b) !(Task a) -> Task b | iTask a & iTask b
transform f (Task evala) = Task eval transform f (Task evala) = Task eval
where where
eval eEvent cEvent refresh repOpts tree iworld = case evala eEvent cEvent refresh repOpts tree iworld of eval event repOpts tree iworld = case evala event repOpts tree iworld of
(ValueResult val lastEvent rep tree,iworld) = (ValueResult (f val) lastEvent rep tree, iworld) //TODO: guarantee stability (ValueResult val lastEvent rep tree,iworld) = (ValueResult (f val) lastEvent rep tree, iworld) //TODO: guarantee stability
(ExceptionResult e str, iworld) = (ExceptionResult e str, iworld) (ExceptionResult e str, iworld) = (ExceptionResult e str, iworld)
(DestroyedResult, iworld) = (DestroyedResult, iworld) (DestroyedResult, iworld) = (DestroyedResult, iworld)
...@@ -31,15 +31,15 @@ where ...@@ -31,15 +31,15 @@ where
project :: ((TaskValue a) r -> Maybe w) (ReadWriteShared r w) !(Task a) -> Task a | iTask a project :: ((TaskValue a) r -> Maybe w) (ReadWriteShared r w) !(Task a) -> Task a | iTask a
project projection share (Task evala) = Task eval project projection share (Task evala) = Task eval
where where
eval eEvent cEvent refresh repOpts (TCDestroy (TCProject taskId encprev treea)) iworld //Cleanup duty simply passed to inner task eval event repOpts (TCDestroy (TCProject taskId encprev treea)) iworld //Cleanup duty simply passed to inner task
= evala eEvent cEvent refresh repOpts (TCDestroy treea) iworld = evala event repOpts (TCDestroy treea) iworld
eval eEvent cEvent refresh repOpts state iworld eval event repOpts state iworld
# (taskId,prev,statea) = case state of # (taskId,prev,statea) = case state of
(TCInit taskId _) = (taskId,NoValue,state) (TCInit taskId _) = (taskId,NoValue,state)
(TCProject taskId encprev statea) = (taskId,fromJust (fromJSON encprev),statea) (TCProject taskId encprev statea) = (taskId,fromJust (fromJSON encprev),statea)
# (resa, iworld) = evala eEvent cEvent refresh repOpts statea iworld # (resa, iworld) = evala event repOpts statea iworld
= case resa of = case resa of
ValueResult val ts rep ncxta ValueResult val ts rep ncxta
# result = ValueResult val ts rep (TCProject taskId (toJSON val) ncxta) # result = ValueResult val ts rep (TCProject taskId (toJSON val) ncxta)
...@@ -65,17 +65,17 @@ where ...@@ -65,17 +65,17 @@ where
step :: !(Task a) [TaskStep a b] -> Task b | iTask a & iTask b step :: !(Task a) [TaskStep a b] -> Task b | iTask a & iTask b
step (Task evala) conts = Task eval step (Task evala) conts = Task eval
where where
eval eEvent cEvent refresh repOpts (TCInit taskId ts) iworld eval event repOpts (TCInit taskId ts) iworld
# (taskIda,iworld) = getNextTaskId iworld # (taskIda,iworld) = getNextTaskId iworld
= eval eEvent cEvent refresh repOpts (TCStep taskId (Left (TCInit taskIda ts))) iworld = eval event repOpts (TCStep taskId (Left (TCInit taskIda ts))) iworld
//Eval left-hand side //Eval left-hand side
eval eEvent cEvent refresh repOpts (TCStep taskId (Left treea)) iworld=:{taskTime} eval event repOpts (TCStep taskId (Left treea)) iworld=:{taskTime}
# (resa, iworld) = evala eEvent cEvent refresh {repOpts & appFinalLayout = False} treea iworld # (resa, iworld) = evala event {repOpts & appFinalLayout = False} treea iworld
# mbcommit = case cEvent of # mbcommit = case event of
(Just (TaskEvent t action)) (ActionEvent t action)
| t == taskId && not refresh = Just action | t == taskId = Just action
_ = Nothing _ = Nothing
# mbCont = case resa of # mbCont = case resa of
ValueResult val lastEvent rep ntreea = case searchContValue val mbcommit conts of ValueResult val lastEvent rep ntreea = case searchContValue val mbcommit conts of
Nothing = Left (ValueResult NoValue lastEvent (doStepLayout taskId repOpts rep (Just val)) (TCStep taskId (Left ntreea)) ) Nothing = Left (ValueResult NoValue lastEvent (doStepLayout taskId repOpts rep (Just val)) (TCStep taskId (Left ntreea)) )
...@@ -89,17 +89,17 @@ where ...@@ -89,17 +89,17 @@ where
//Cleanup state of left-hand side //Cleanup state of left-hand side
# iworld = case mbTreeA of # iworld = case mbTreeA of
Nothing = iworld Nothing = iworld
Just treea = snd (evala Nothing Nothing refresh {repOpts & appFinalLayout = False} (TCDestroy treea) iworld) //TODO: Check for exceptions during cleanup Just treea = snd (evala RefreshEvent {repOpts & appFinalLayout = False} (TCDestroy treea) iworld) //TODO: Check for exceptions during cleanup
# (taskIdb,iworld) = getNextTaskId iworld # (taskIdb,iworld) = getNextTaskId iworld
# (resb,iworld) = evalb Nothing Nothing refresh {repOpts & appFinalLayout = False} (TCInit taskIdb taskTime) iworld # (resb,iworld) = evalb RefreshEvent {repOpts & appFinalLayout = False} (TCInit taskIdb taskTime) iworld
= case resb of = case resb of
ValueResult val lastEvent rep nstateb = (ValueResult val lastEvent (doStepLayout taskId repOpts rep Nothing) (TCStep taskId (Right (d_json_a,sel,nstateb))),iworld) ValueResult val lastEvent rep nstateb = (ValueResult val lastEvent (doStepLayout taskId repOpts rep Nothing) (TCStep taskId (Right (d_json_a,sel,nstateb))),iworld)
ExceptionResult e str = (ExceptionResult e str, iworld) ExceptionResult e str = (ExceptionResult e str, iworld)
//Eval right-hand side //Eval right-hand side
eval eEvent cEvent refresh repOpts (TCStep taskId (Right (enca,sel,treeb))) iworld eval event repOpts (TCStep taskId (Right (enca,sel,treeb))) iworld
= case restoreTaskB sel enca of = case restoreTaskB sel enca of
Just (Task evalb) Just (Task evalb)
# (resb, iworld) = evalb eEvent cEvent refresh {repOpts & appFinalLayout = False} treeb iworld # (resb, iworld) = evalb event {repOpts & appFinalLayout = False} treeb iworld
= case resb of = case resb of
ValueResult val lastEvent rep ntreeb = (ValueResult val lastEvent (doStepLayout taskId repOpts rep Nothing) (TCStep taskId (Right (enca,sel,ntreeb))), iworld) ValueResult val lastEvent rep ntreeb = (ValueResult val lastEvent (doStepLayout taskId repOpts rep Nothing) (TCStep taskId (Right (enca,sel,ntreeb))), iworld)
ExceptionResult e str = (ExceptionResult e str, iworld) ExceptionResult e str = (ExceptionResult e str, iworld)
...@@ -107,19 +107,19 @@ where ...@@ -107,19 +107,19 @@ where
= (exception "Corrupt task value in step", iworld) = (exception "Corrupt task value in step", iworld)
//Cleanup //Cleanup
eval eEvent cEvent refresh repOpts (TCDestroy (TCStep taskId (Left treea))) iworld eval event repOpts (TCDestroy (TCStep taskId (Left treea))) iworld
= case evala eEvent cEvent refresh repOpts (TCDestroy treea) iworld of = case evala event repOpts (TCDestroy treea) iworld of
(DestroyedResult,iworld) = (DestroyedResult,iworld) (DestroyedResult,iworld) = (DestroyedResult,iworld)
(ExceptionResult e str,iworld) = (ExceptionResult e str,iworld) (ExceptionResult e str,iworld) = (ExceptionResult e str,iworld)
(ValueResult _ _ _ _,iworld) = (exception "Destroy failed in step",iworld) (ValueResult _ _ _ _,iworld) = (exception "Destroy failed in step",iworld)
eval eEvent cEvent refresh repOpts (TCDestroy (TCStep taskId (Right(enca,sel,treeb)))) iworld eval event repOpts (TCDestroy (TCStep taskId (Right(enca,sel,treeb)))) iworld
= case restoreTaskB sel enca of = case restoreTaskB sel enca of
Just (Task evalb) = evalb eEvent cEvent refresh repOpts (TCDestroy treeb) iworld Just (Task evalb) = evalb event repOpts (TCDestroy treeb) iworld
Nothing = (exception "Corrupt task value in step", iworld) Nothing = (exception "Corrupt task value in step", iworld)
//Incorred state //Incorred state
eval eEvent cEvent refresh _ state iworld eval event _ state iworld
= (exception ("Corrupt task state in step:" +++ (toString (toJSON state))), iworld) = (exception ("Corrupt task state in step:" +++ (toString (toJSON state))), iworld)
searchContValue val mbcommit conts = search val mbcommit 0 Nothing conts searchContValue val mbcommit conts = search val mbcommit 0 Nothing conts
...@@ -180,25 +180,18 @@ parallel :: !d ![(!ParallelTaskType,!ParallelTask a)] -> Task [(!TaskTime,!TaskV ...@@ -180,25 +180,18 @@ parallel :: !d ![(!ParallelTaskType,!ParallelTask a)] -> Task [(!TaskTime,!TaskV
parallel desc initTasks = Task eval parallel desc initTasks = Task eval
where where
//Create initial task list //Create initial task list
eval eEvent cEvent refresh repOpts (TCInit taskId ts) iworld=:{IWorld|localLists} eval event repOpts (TCInit taskId ts) iworld=:{IWorld|localLists}
//Append the initial tasks to the list //Append the initial tasks to the list
# iworld = foldl append {iworld & localLists = 'Map'.put taskId [] localLists} initTasks # iworld = foldl append {iworld & localLists = 'Map'.put taskId [] localLists} initTasks
//Evaluate the parallel //Evaluate the parallel
= eval eEvent cEvent refresh repOpts (TCParallel taskId) iworld = eval event repOpts (TCParallel taskId) iworld
where where
append iworld t = snd (appendTaskToList taskId t iworld) append iworld t = snd (appendTaskToList taskId t iworld)
//Evaluate the task list //Evaluate the task list
eval eEvent cEvent refresh repOpts (TCParallel taskId) iworld=:{taskTime} eval event repOpts (TCParallel taskId) iworld=:{taskTime}
//Update the tasktime if an explicit reorder event of tabs/windows is targeted at the parallel
# iworld = case eEvent of
Just (TaskEvent t ("top",JSONString top))
| t == taskId && not refresh = updateListEntryTime taskId (fromString top) taskTime iworld
= iworld
_ = iworld
//Evaluate all parallel tasks in the list //Evaluate all parallel tasks in the list
= case evalParTasks taskId eEvent cEvent refresh iworld of = case evalParTasks taskId event iworld of
(Just res=:(ExceptionResult e str),_,iworld) = (res,iworld) (Just res=:(ExceptionResult e str),_,iworld) = (res,iworld)
(Just res=:(ValueResult _ _ _ _),_,iworld) = (exception "parallel evaluation yielded unexpected result",iworld) (Just res=:(ValueResult _ _ _ _),_,iworld) = (exception "parallel evaluation yielded unexpected result",iworld)
(Nothing,entries,iworld) (Nothing,entries,iworld)
...@@ -215,21 +208,21 @@ where ...@@ -215,21 +208,21 @@ where
# ts = foldr max 0 (map fst values) # ts = foldr max 0 (map fst values)
= (ValueResult (Value values stable) ts (finalizeRep repOpts rep) (TCParallel taskId),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists}) = (ValueResult (Value values stable) ts (finalizeRep repOpts rep) (TCParallel taskId),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists})
//Cleanup //Cleanup
eval eEvent cEvent refresh repOpts (TCDestroy (TCParallel taskId)) iworld=:{localLists} eval event repOpts (TCDestroy (TCParallel taskId)) iworld=:{localLists}
# entries = fromMaybe [] ('Map'.get taskId localLists) # entries = fromMaybe [] ('Map'.get taskId localLists)
= case foldl destroyParTask (Nothing,iworld) entries of = case foldl destroyParTask (Nothing,iworld) entries of
(Nothing,iworld) = (DestroyedResult,{iworld & localLists = 'Map'.del taskId localLists}) //All destroyed (Nothing,iworld) = (DestroyedResult,{iworld & localLists = 'Map'.del taskId localLists}) //All destroyed
(Just (ExceptionResult e str),iworld) = (ExceptionResult e str,{iworld & localLists = 'Map'.del taskId localLists}) //An exception occurred (Just (ExceptionResult e str),iworld) = (ExceptionResult e str,{iworld & localLists = 'Map'.del taskId localLists}) //An exception occurred
(Just result,iworld) = (fixOverloading result initTasks (exception "Destroy failed in step"),iworld) (Just result,iworld) = (fixOverloading result initTasks (exception "Destroy failed in step"),iworld)
//Fallback //Fallback
eval _ _ _ _ _ iworld eval _ _ _ iworld
= (exception "Corrupt task state in parallel", iworld) = (exception "Corrupt task state in parallel", iworld)
evalParTasks :: !TaskId !(Maybe EditEvent) !(Maybe CommitEvent) !RefreshFlag !*IWorld -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a evalParTasks :: !TaskId !Event !*IWorld -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
evalParTasks taskId eEvent cEvent refresh iworld=:{localLists} evalParTasks taskId event iworld=:{localLists}
= evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) iworld = evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) iworld
where where
evalFrom n acc list iworld = case foldl (evalParTask taskId eEvent cEvent refresh) (Nothing,acc,iworld) (drop n list) of evalFrom n acc list iworld = case foldl (evalParTask taskId event) (Nothing,acc,iworld) (drop n list) of
(Just (ExceptionResult e str),acc,iworld) = (Just (ExceptionResult e str),acc,iworld) (Just (ExceptionResult e str),acc,iworld) = (Just (ExceptionResult e str),acc,iworld)
(Nothing,acc,iworld=:{localLists}) (Nothing,acc,iworld=:{localLists})
# nlist = fromMaybe [] ('Map'.get taskId localLists) # nlist = fromMaybe [] ('Map'.get taskId localLists)
...@@ -238,10 +231,10 @@ where ...@@ -238,10 +231,10 @@ where
//IMPORTANT: This last rule should never match, but it helps to solve overloading solves overloading //IMPORTANT: This last rule should never match, but it helps to solve overloading solves overloading
(Just (ValueResult val ts rep tree),acc,iworld) = (Just (ValueResult (Value [(ts,val)] Unstable) ts rep tree),acc,iworld) (Just (ValueResult val ts rep tree),acc,iworld) = (Just (ValueResult (Value [(ts,val)] Unstable) ts rep tree),acc,iworld)
evalParTask :: !TaskId !(Maybe EditEvent) !(Maybe CommitEvent) !RefreshFlag !(!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a evalParTask :: !TaskId !Event !(!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
//Evaluate embedded tasks //Evaluate embedded tasks
evalParTask taskId eEvent cEvent refresh (Nothing,acc,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree, removed=False} evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree, removed=False}
# (result,iworld) = evala eEvent cEvent refresh {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld # (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld
= case result of = case result of
ExceptionResult _ _ ExceptionResult _ _
= (Just result,acc,iworld) = (Just result,acc,iworld)
...@@ -250,7 +243,7 @@ where ...@@ -250,7 +243,7 @@ where
= (Nothing, acc++[(entry,Just rep)],iworld) = (Nothing, acc++[(entry,Just rep)],iworld)
//Copy the last stored result of detached tasks //Copy the last stored result of detached tasks
evalParTask taskId eEvent cEvent refresh (Nothing,acc,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _,removed=False} evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=DetachedState instanceNo _ _,removed=False}
= case loadTaskInstance instanceNo iworld of = case loadTaskInstance instanceNo iworld of
(Error _, iworld) = (Nothing,acc,iworld) //TODO: remove from parallel if it can't be loaded (now it simply keeps the last known result) (Error _, iworld) = (Nothing,acc,iworld) //TODO: remove from parallel if it can't be loaded (now it simply keeps the last known result)
(Ok (meta,_,res), iworld) (Ok (meta,_,res), iworld)
...@@ -259,12 +252,12 @@ where ...@@ -259,12 +252,12 @@ where
= (Nothing,acc++[(entry,Nothing)],iworld) = (Nothing,acc++[(entry,Nothing)],iworld)
//Do nothing if an exeption occurred or marked as removed //Do nothing if an exeption occurred or marked as removed
evalParTask taskId eEvent cEvent refresh (result,acc,iworld) entry = (result,acc,iworld) evalParTask taskId event (result,acc,iworld) entry = (result,acc,iworld)
destroyParTask :: (!Maybe (TaskResult a),!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),!*IWorld) | iTask a destroyParTask :: (!Maybe (TaskResult a),!*IWorld) !TaskListEntry -> (!Maybe (TaskResult a),!*IWorld) | iTask a
//Destroy embedded tasks //Destroy embedded tasks
destroyParTask (_,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree} destroyParTask (_,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree}
# (result,iworld) = evala Nothing Nothing False {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld # (result,iworld) = evala RefreshEvent {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False} (TCDestroy tree) iworld
= case result of = case result of
DestroyedResult = (Nothing,iworld) DestroyedResult = (Nothing,iworld)
_ = (Just result,iworld) _ = (Just result,iworld)
...@@ -341,10 +334,6 @@ where ...@@ -341,10 +334,6 @@ where
= {TaskListEntry| e & state = DetachedState no progress management,result = result, attributes = 'Map'.fromList attributes} = {TaskListEntry| e & state = DetachedState no progress management,result = result, attributes = 'Map'.fromList attributes}
update e = e update e = e
updateListEntryTime :: !TaskId !TaskId !TaskTime !*IWorld -> *IWorld
updateListEntryTime listId entryId ts iworld
= snd (updateListEntry listId entryId (\e -> {TaskListEntry|e & time = ts}) iworld)
markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld markListEntryRemoved :: !TaskId !TaskId !*IWorld -> *IWorld
markListEntryRemoved listId entryId iworld markListEntryRemoved listId entryId iworld
= snd (updateListEntry listId entryId (\e -> {TaskListEntry|e & removed = True}) iworld) = snd (updateListEntry listId entryId (\e -> {TaskListEntry|e & removed = True}) iworld)
...@@ -430,12 +419,12 @@ where ...@@ -430,12 +419,12 @@ where
workOn :: !TaskId -> Task WorkOnStatus workOn :: !TaskId -> Task WorkOnStatus
workOn (TaskId instanceNo taskNo) = Task eval workOn (TaskId instanceNo taskNo) = Task eval
where where
eval eEvent cEvent refresh repOpts (TCInit taskId ts) iworld=:{currentInstance,currentUser} eval event repOpts (TCInit taskId ts) iworld=:{currentInstance,currentUser}
# iworld = setTaskWorker currentUser instanceNo iworld # iworld = setTaskWorker currentUser instanceNo iworld
# iworld = addTaskInstanceObserver currentInstance instanceNo iworld # iworld = addTaskInstanceObserver currentInstance instanceNo iworld
= eval eEvent cEvent refresh repOpts (TCBasic taskId ts JSONNull False) iworld = eval event repOpts (TCBasic taskId ts JSONNull False) iworld
eval eEvent cEvent refresh repOpts tree=:(TCBasic taskId ts _ _) iworld=:{currentUser} eval event repOpts tree=:(TCBasic taskId ts _ _) iworld=:{currentUser}
//Load instance //Load instance
# (meta,iworld) = loadTaskMeta instanceNo iworld # (meta,iworld) = loadTaskMeta instanceNo iworld
# (result,iworld) = loadTaskResult instanceNo iworld # (result,iworld) = loadTaskResult instanceNo iworld
...@@ -453,11 +442,10 @@ where ...@@ -453,11 +442,10 @@ where
_ _
= (ValueResult (Value WODeleted Stable) ts (finalizeRep repOpts noRep) tree, iworld) = (ValueResult (Value WODeleted Stable) ts (finalizeRep repOpts noRep) tree, iworld)
eval eEvent cEvent refresh repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld
//TODO: Remove this workon from the observers //TODO: Remove this workon from the observers
= (DestroyedResult,iworld) = (DestroyedResult,iworld)
inUseRep worker inUseRep worker
= TaskRep {UIDef|controls=[(stringDisplay (toString worker +++ " is working on this task"),'Map'.newMap)],actions=[],attributes='Map'.newMap} [] = TaskRep {UIDef|controls=[(stringDisplay (toString worker +++ " is working on this task"),'Map'.newMap)],actions=[],attributes='Map'.newMap} []
/* /*
...@@ -468,32 +456,32 @@ where ...@@ -468,32 +456,32 @@ where
workAs :: !User !(Task a) -> Task a | iTask a workAs :: !User !(Task a) -> Task a | iTask a
workAs user (Task eval) = Task eval` workAs user (Task eval) = Task eval`
where where
eval` eEvent cEvent refresh repOpts state iworld=:{currentUser} eval` event repOpts state iworld=:{currentUser}
# (result,iworld) = eval eEvent cEvent refresh repOpts state {iworld & currentUser = user} # (result,iworld) = eval event repOpts state {iworld & currentUser = user}
= (result,{iworld & currentUser = currentUser}) = (result,{iworld & currentUser = currentUser})
withShared :: !b !((Shared b) -> Task a) -> Task a | iTask a & iTask b withShared :: !b !((Shared b) -> Task a) -> Task a | iTask a & iTask b
withShared initial stask = Task eval withShared initial stask = Task eval
where where
eval eEvent cEvent refresh repOpts (TCInit taskId ts) iworld=:{localShares} eval event repOpts (TCInit taskId ts) iworld=:{localShares}
# localShares = 'Map'.put taskId (toJSON initial) localShares # localShares = 'Map'.put taskId (toJSON initial) localShares
# (taskIda,iworld) = getNextTaskId iworld # (taskIda,iworld) = getNextTaskId iworld
= eval eEvent cEvent refresh repOpts (TCShared taskId (TCInit taskIda ts)) {iworld & localShares = localShares} = eval event repOpts (TCShared taskId (TCInit taskIda ts)) {iworld & localShares = localShares}
eval eEvent cEvent refresh repOpts (TCShared taskId treea) iworld eval event repOpts (TCShared taskId treea) iworld
# (Task evala) = stask (localShare taskId) # (Task evala) = stask (localShare taskId)
# (resa,iworld) = evala eEvent cEvent refresh repOpts treea iworld # (resa,iworld) = evala event repOpts treea iworld
= case resa of = case resa of
ValueResult NoValue lastEvent rep ntreea = (ValueResult NoValue lastEvent rep (TCShared taskId ntreea),iworld) ValueResult NoValue lastEvent rep ntreea = (ValueResult NoValue lastEvent rep (TCShared taskId ntreea),iworld)
ValueResult (Value stable val) lastEvent rep ntreea = (ValueResult (Value stable val) lastEvent rep (TCShared taskId ntreea),iworld) ValueResult (Value stable val) lastEvent rep ntreea = (ValueResult (Value stable val) lastEvent rep (TCShared taskId ntreea),iworld)
ExceptionResult e str = (ExceptionResult e str,iworld) ExceptionResult e str = (ExceptionResult e str,iworld)
eval eEvent cEvent refresh repOpts (TCDestroy (TCShared taskId treea)) iworld //First destroy inner task, then remove shared state eval event repOpts (TCDestroy (TCShared taskId treea)) iworld //First destroy inner task, then remove shared state
# (Task evala) = stask (localShare taskId) # (Task evala) = stask (localShare taskId)
# (resa,iworld=:{localShares}) = evala eEvent cEvent refresh repOpts (TCDestroy treea) iworld # (resa,iworld=:{localShares}) = evala event repOpts (TCDestroy treea) iworld
= (resa,{iworld & localShares = 'Map'.del taskId localShares}) = (resa,{iworld & localShares = 'Map'.del taskId localShares})
eval _ _ _ _ _ iworld eval _ _ _ iworld
= (exception "Corrupt task state in withShared", iworld) = (exception "Corrupt task state in withShared", iworld)
/* /*
* Tuning of tasks * Tuning of tasks
...@@ -504,17 +492,17 @@ instance tune SetLayout ...@@ -504,17 +492,17 @@ instance tune SetLayout
where where
tune (SetLayout layout) (Task eval) = Task eval` tune (SetLayout layout) (Task eval) = Task eval`
where where
eval` eEvent cEvent refresh repOpts=:{useLayout=Nothing,modLayout} state iworld eval` event repOpts=:{useLayout=Nothing,modLayout} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & useLayout = Just ((fromMaybe id modLayout) layout), modLayout = Nothing} state iworld = eval event {TaskRepOpts|repOpts & useLayout = Just ((fromMaybe id modLayout) layout), modLayout = Nothing} state iworld
eval` eEvent cEvent refresh repOpts=:{useLayout=Just _,modLayout} state iworld eval` event repOpts=:{useLayout=Just _,modLayout} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & useLayout = Just layout, modLayout = Nothing} state iworld = eval event {TaskRepOpts|repOpts & useLayout = Just layout, modLayout = Nothing} state iworld
instance tune ModifyLayout instance tune ModifyLayout
where where
tune (ModifyLayout f) (Task eval) = Task eval` tune (ModifyLayout f) (Task eval) = Task eval`
where where
eval` eEvent cEvent refresh repOpts=:{modLayout=Nothing} state iworld eval` event repOpts=:{modLayout=Nothing} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & modLayout = Just f} state iworld = eval event {TaskRepOpts|repOpts & modLayout = Just f} state iworld
eval` eEvent cEvent refresh repOpts=:{modLayout=Just g} state iworld eval` event repOpts=:{modLayout=Just g} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld = eval event {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld
\ No newline at end of file
Server/API/Core/CoreTasks.icl
View file @ 112d4089
...@@ -53,36 +53,33 @@ where ...@@ -53,36 +53,33 @@ where
watch :: !(ReadWriteShared r w) -> Task r | iTask r watch :: !(ReadWriteShared r w) -> Task r | iTask r
watch shared = Task eval watch shared = Task eval
where where
eval eEvent cEvent refresh repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld # (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
# res = case val of # res = case val of
Ok val = ValueResult (Value val Unstable) ts (finalizeRep repOpts NoRep) (TCInit taskId ts) Ok val = ValueResult (Value val Unstable) ts (finalizeRep repOpts NoRep) (TCInit taskId ts)
Error e = exception (SharedException e) Error e = exception (SharedException e)
= (res,iworld) = (res,iworld)
eval eEvent cEvent refresh repAs (TCDestroy _) iworld = (DestroyedResult,iworld) eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld)
interactSharedChoice :: !d !(ReadOnlyShared r) (Maybe l) (r (Maybe l) -> t v l) interactSharedChoice :: !d !(ReadOnlyShared r) (Maybe l) (r (Maybe l) -> t v l)
-> Task (Maybe l) | descr d & Choice t & iTask r & iTask l & iTask (t v l) -> Task (Maybe l) | descr d & Choice t & iTask r & iTask l & iTask (t v l)
interactSharedChoice desc shared initial_mask toView = Task eval interactSharedChoice desc shared initial_mask toView = Task eval
where where
eval eEvent cEvent refresh repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld # (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
= case mbr of = case mbr of
Error _ = could_not_read_shared_in_interact_exception iworld Error _ = could_not_read_shared_in_interact_exception iworld
Ok r Ok r
# v = toView r initial_mask # v = toView r initial_mask
# (l,v,mask) = (initial_mask,v,defaultMask v) # (l,v,mask) = (initial_mask,v,defaultMask v)
= eval eEvent cEvent refresh repOpts (TCInteract2 taskId ts (toJSON l) (toJSON r) mask) iworld = eval event repOpts (TCInteract2 taskId ts (toJSON l) (toJSON r) mask) iworld
eval eEvent cEvent refresh repOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr mask) iworld=:{taskTime} eval event repOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr mask) iworld=:{taskTime}
//Decode stored values //Decode stored values
# l = fromJust (fromJSON encl) # l = fromJust (fromJSON encl)
r = fromJust (fromJSON encr) r = fromJust (fromJSON encr)
v = toView r l v = toView r l
//Determine next v by applying edit event if applicable //Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld) # (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
= if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
//Load next r from shared value //Load next r from shared value
# (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld # (mbr,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
| isError mbr = could_not_read_shared_in_interact_exception iworld | isError mbr = could_not_read_shared_in_interact_exception iworld
...@@ -96,9 +93,9 @@ where ...@@ -96,9 +93,9 @@ where
//Make visualization //Make visualization
# validity = verifyForm nv nmask # validity = verifyForm nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld # (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidValue validity) (Value nl (if (isLucky eEvent) Stable Unstable)) NoValue # value = if (isValidValue validity) (Value nl Unstable) NoValue
= (ValueResult value nts (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld) = (ValueResult value nts (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval eEvent cEvent refresh repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)