Commit 112d4089 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Simplified events

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/itwc-experiments@2159 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent bd55b755
......@@ -82,12 +82,14 @@ Ext.define('itwc.controller.Controller',{
onAction: function(taskId, actionId) {
console.log("Action event", taskId, actionId);
var me = this,
params = {commitEvent: Ext.encode([taskId,actionId])};
params = {actionEvent: Ext.encode([taskId,actionId])};
me.sendMessage(params); //TEMPORARILY DUMB WITHOUT QUEUE AND TRACKING
},
//iTasks focus events
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
sendMessage: function(msg) {
......
......@@ -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 f (Task evala) = Task eval
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
(ExceptionResult e str, iworld) = (ExceptionResult e str, iworld)
(DestroyedResult, iworld) = (DestroyedResult, iworld)
......@@ -31,15 +31,15 @@ where
project :: ((TaskValue a) r -> Maybe w) (ReadWriteShared r w) !(Task a) -> Task a | iTask a
project projection share (Task evala) = Task eval
where
eval eEvent cEvent refresh repOpts (TCDestroy (TCProject taskId encprev treea)) iworld //Cleanup duty simply passed to inner task
= evala eEvent cEvent refresh repOpts (TCDestroy treea) iworld
eval event repOpts (TCDestroy (TCProject taskId encprev treea)) iworld //Cleanup duty simply passed to inner task
= evala event repOpts (TCDestroy treea) iworld
eval eEvent cEvent refresh repOpts state iworld
eval event repOpts state iworld
# (taskId,prev,statea) = case state of
(TCInit taskId _) = (taskId,NoValue,state)
(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
ValueResult val ts rep ncxta
# result = ValueResult val ts rep (TCProject taskId (toJSON val) ncxta)
......@@ -65,17 +65,17 @@ where
step :: !(Task a) [TaskStep a b] -> Task b | iTask a & iTask b
step (Task evala) conts = Task eval
where
eval eEvent cEvent refresh repOpts (TCInit taskId ts) iworld
eval event repOpts (TCInit taskId ts) 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 eEvent cEvent refresh repOpts (TCStep taskId (Left treea)) iworld=:{taskTime}
# (resa, iworld) = evala eEvent cEvent refresh {repOpts & appFinalLayout = False} treea iworld
# mbcommit = case cEvent of
(Just (TaskEvent t action))
| t == taskId && not refresh = Just action
_ = Nothing
eval event repOpts (TCStep taskId (Left treea)) iworld=:{taskTime}
# (resa, iworld) = evala event {repOpts & appFinalLayout = False} treea iworld
# mbcommit = case event of
(ActionEvent t action)
| t == taskId = Just action
_ = Nothing
# mbCont = case resa 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)) )
......@@ -89,17 +89,17 @@ where
//Cleanup state of left-hand side
# iworld = case mbTreeA of
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
# (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
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)
//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
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
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)
......@@ -107,19 +107,19 @@ where
= (exception "Corrupt task value in step", iworld)
//Cleanup
eval eEvent cEvent refresh repOpts (TCDestroy (TCStep taskId (Left treea))) iworld
= case evala eEvent cEvent refresh repOpts (TCDestroy treea) iworld of
eval event repOpts (TCDestroy (TCStep taskId (Left treea))) iworld
= case evala event repOpts (TCDestroy treea) iworld of
(DestroyedResult,iworld) = (DestroyedResult,iworld)
(ExceptionResult e str,iworld) = (ExceptionResult e str,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
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)
//Incorred state
eval eEvent cEvent refresh _ state iworld
eval event _ state iworld
= (exception ("Corrupt task state in step:" +++ (toString (toJSON state))), iworld)
searchContValue val mbcommit conts = search val mbcommit 0 Nothing conts
......@@ -180,25 +180,18 @@ parallel :: !d ![(!ParallelTaskType,!ParallelTask a)] -> Task [(!TaskTime,!TaskV
parallel desc initTasks = Task eval
where
//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
# iworld = foldl append {iworld & localLists = 'Map'.put taskId [] localLists} initTasks
//Evaluate the parallel
= eval eEvent cEvent refresh repOpts (TCParallel taskId) iworld
= eval event repOpts (TCParallel taskId) iworld
where
append iworld t = snd (appendTaskToList taskId t iworld)
//Evaluate the task list
eval eEvent cEvent refresh 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
eval event repOpts (TCParallel taskId) iworld=:{taskTime}
//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=:(ValueResult _ _ _ _),_,iworld) = (exception "parallel evaluation yielded unexpected result",iworld)
(Nothing,entries,iworld)
......@@ -215,21 +208,21 @@ where
# 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})
//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)
= case foldl destroyParTask (Nothing,iworld) entries of
(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 result,iworld) = (fixOverloading result initTasks (exception "Destroy failed in step"),iworld)
//Fallback
eval _ _ _ _ _ iworld
eval _ _ _ 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 eEvent cEvent refresh iworld=:{localLists}
evalParTasks :: !TaskId !Event !*IWorld -> (!Maybe (TaskResult [(TaskTime,TaskValue a)]),![(!TaskListEntry,!Maybe TaskRep)],!*IWorld) | iTask a
evalParTasks taskId event iworld=:{localLists}
= evalFrom 0 [] (fromMaybe [] ('Map'.get taskId localLists)) iworld
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)
(Nothing,acc,iworld=:{localLists})
# nlist = fromMaybe [] ('Map'.get taskId localLists)
......@@ -238,10 +231,10 @@ where
//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)
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
evalParTask taskId eEvent cEvent refresh (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
evalParTask taskId event (Nothing,acc,iworld) {TaskListEntry|entryId,state=EmbeddedState (Task evala :: Task a^) tree, removed=False}
# (result,iworld) = evala event {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=False} tree iworld
= case result of
ExceptionResult _ _
= (Just result,acc,iworld)
......@@ -250,7 +243,7 @@ where
= (Nothing, acc++[(entry,Just rep)],iworld)
//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
(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)
......@@ -259,12 +252,12 @@ where
= (Nothing,acc++[(entry,Nothing)],iworld)
//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
//Destroy embedded tasks
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
DestroyedResult = (Nothing,iworld)
_ = (Just result,iworld)
......@@ -341,10 +334,6 @@ where
= {TaskListEntry| e & state = DetachedState no progress management,result = result, attributes = 'Map'.fromList attributes}
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 listId entryId iworld
= snd (updateListEntry listId entryId (\e -> {TaskListEntry|e & removed = True}) iworld)
......@@ -430,12 +419,12 @@ where
workOn :: !TaskId -> Task WorkOnStatus
workOn (TaskId instanceNo taskNo) = Task eval
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 = 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
# (meta,iworld) = loadTaskMeta instanceNo iworld
# (result,iworld) = loadTaskResult instanceNo iworld
......@@ -453,11 +442,10 @@ where
_
= (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
= (DestroyedResult,iworld)
inUseRep worker
= TaskRep {UIDef|controls=[(stringDisplay (toString worker +++ " is working on this task"),'Map'.newMap)],actions=[],attributes='Map'.newMap} []
/*
......@@ -468,32 +456,32 @@ where
workAs :: !User !(Task a) -> Task a | iTask a
workAs user (Task eval) = Task eval`
where
eval` eEvent cEvent refresh repOpts state iworld=:{currentUser}
# (result,iworld) = eval eEvent cEvent refresh repOpts state {iworld & currentUser = user}
eval` event repOpts state iworld=:{currentUser}
# (result,iworld) = eval event repOpts state {iworld & currentUser = user}
= (result,{iworld & currentUser = currentUser})
withShared :: !b !((Shared b) -> Task a) -> Task a | iTask a & iTask b
withShared initial stask = Task eval
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
# (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)
# (resa,iworld) = evala eEvent cEvent refresh repOpts treea iworld
# (resa,iworld) = evala event repOpts treea iworld
= case resa of
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)
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)
# (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})
eval _ _ _ _ _ iworld
eval _ _ _ iworld
= (exception "Corrupt task state in withShared", iworld)
/*
* Tuning of tasks
......@@ -504,17 +492,17 @@ instance tune SetLayout
where
tune (SetLayout layout) (Task eval) = Task eval`
where
eval` eEvent cEvent refresh repOpts=:{useLayout=Nothing,modLayout} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & useLayout = Just ((fromMaybe id modLayout) layout), modLayout = Nothing} state iworld
eval` eEvent cEvent refresh repOpts=:{useLayout=Just _,modLayout} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & useLayout = Just layout, modLayout = Nothing} state iworld
eval` event repOpts=:{useLayout=Nothing,modLayout} state iworld
= eval event {TaskRepOpts|repOpts & useLayout = Just ((fromMaybe id modLayout) layout), modLayout = Nothing} state iworld
eval` event repOpts=:{useLayout=Just _,modLayout} state iworld
= eval event {TaskRepOpts|repOpts & useLayout = Just layout, modLayout = Nothing} state iworld
instance tune ModifyLayout
where
tune (ModifyLayout f) (Task eval) = Task eval`
where
eval` eEvent cEvent refresh repOpts=:{modLayout=Nothing} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & modLayout = Just f} state iworld
eval` eEvent cEvent refresh repOpts=:{modLayout=Just g} state iworld
= eval eEvent cEvent refresh {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld
eval` event repOpts=:{modLayout=Nothing} state iworld
= eval event {TaskRepOpts|repOpts & modLayout = Just f} state iworld
eval` event repOpts=:{modLayout=Just g} state iworld
= eval event {TaskRepOpts|repOpts & modLayout = Just (g o f)} state iworld
\ No newline at end of file
......@@ -53,36 +53,33 @@ where
watch :: !(ReadWriteShared r w) -> Task r | iTask r
watch shared = Task eval
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
# res = case val of
Ok val = ValueResult (Value val Unstable) ts (finalizeRep repOpts NoRep) (TCInit taskId ts)
Error e = exception (SharedException e)
= (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)
-> Task (Maybe l) | descr d & Choice t & iTask r & iTask l & iTask (t v l)
interactSharedChoice desc shared initial_mask toView = Task eval
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
= case mbr of
Error _ = could_not_read_shared_in_interact_exception iworld
Ok r
# v = toView r initial_mask
# (l,v,mask) = (initial_mask,v,defaultMask v)
= eval eEvent cEvent refresh 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 ts (toJSON l) (toJSON r) mask) iworld
eval event repOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr mask) iworld=:{taskTime}
//Decode stored values
# l = fromJust (fromJSON encl)
r = fromJust (fromJSON encr)
v = toView r l
//Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld)
= if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
# (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 = could_not_read_shared_in_interact_exception iworld
......@@ -96,9 +93,9 @@ where
//Make visualization
# validity = verifyForm nv nmask
# (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)
eval eEvent cEvent refresh repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv valid
# nl = if valid (getMbSelection nv) l
......@@ -109,24 +106,21 @@ interactSharedChoiceNoView :: !d !(ReadOnlyShared r) (Maybe l) (r (Maybe l) -> t
-> Task (Maybe l) | descr d & ChoiceNoView t & iTask r & iTask l & iTask (t l)
interactSharedChoiceNoView desc shared initial_mask toViewId = Task eval
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
= case mbr of
Error _ = could_not_read_shared_in_interact_exception iworld
Ok r
# v = toViewId r initial_mask
# (l,v,mask) = (initial_mask,v,defaultMask v)
= eval eEvent cEvent refresh 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 ts (toJSON l) (toJSON r) mask) iworld
eval event repOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr mask) iworld=:{taskTime}
//Decode stored values
# l = fromJust( fromJSON encl)
r = fromJust (fromJSON encr)
v = toViewId r l
//Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld)
= if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
# (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 = could_not_read_shared_in_interact_exception iworld
......@@ -140,9 +134,9 @@ where
//Make visualization
# validity = verifyForm nv nmask
# (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)
eval eEvent cEvent refresh repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv valid
# nl = if valid (getMbSelectionNoView nv) l
......@@ -152,23 +146,21 @@ where
interactSharedInformation :: !d !(ReadOnlyShared r) (r -> v) -> Task r | descr d & iTask r & iTask v
interactSharedInformation desc shared toView = Task eval
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
= case mbr of
Error _ = could_not_read_shared_in_interact_exception iworld
Ok r
# v = toView r
# (l,v,mask) = (r,v,defaultMask v)
= eval eEvent cEvent refresh 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 ts (toJSON l) (toJSON r) mask) iworld
eval event repOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr mask) iworld=:{taskTime}
//Decode stored values
# l = fromJust (fromJSON encl)
r = fromJust (fromJSON encr)
v = toView r
//Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld) = if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
# (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 = could_not_read_shared_in_interact_exception iworld
......@@ -180,9 +172,9 @@ where
//Make visualization
# validity = verifyForm nv nmask
# (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)
eval eEvent cEvent refresh repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun r
# v = toView r
......@@ -191,18 +183,16 @@ where
interactNullEnter :: !d !v (v->l) -> Task l | descr d & iTask v
interactNullEnter desc initFun fromf = Task eval
where
eval eEvent cEvent refresh repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# v = initFun
# mask = Untouched
= eval eEvent cEvent refresh repOpts (TCInteract1 taskId ts (toJSON v) mask) iworld
eval eEvent cEvent refresh repOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encv mask) iworld=:{taskTime}
= eval event repOpts (TCInteract1 taskId ts (toJSON v) mask) iworld
eval event repOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encv mask) iworld=:{taskTime}
//Decode stored value
# v = fromJust (fromJSON encv)
l = fromf v
//Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld) = if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
# (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
//Apply refresh function if v changed
# changed = nts =!= ts
# valid = isValidValue (verifyForm nv nmask)
......@@ -210,9 +200,9 @@ where
//Make visualization
# validity = verifyForm nv nmask
# (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) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
eval eEvent cEvent refresh repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok
| ok
......@@ -222,19 +212,17 @@ where
interactNullUpdate :: !d !(l -> v) (l v -> l) l -> Task l | descr d & iTask l & iTask v
interactNullUpdate desc tof fromf m = Task eval
where
eval eEvent cEvent refresh repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# v = tof m
l = m
mask = defaultMask v
= eval eEvent cEvent refresh repOpts (TCInteract1 taskId ts (toJSON l) mask) iworld
eval eEvent cEvent refresh repOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encl mask) iworld=:{taskTime}
= eval event repOpts (TCInteract1 taskId ts (toJSON l) mask) iworld
eval event repOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encl mask) iworld=:{taskTime}
//Decode stored values
# l = fromJust (fromJSON encl)
v = tof l
//Determine next v by applying edit event if applicable
# (nv,nmask,nts,iworld) = if refresh
(v,mask,ts,iworld)
(matchAndApplyEvent eEvent taskId taskTime v mask ts iworld)
# (nv,nmask,nts,iworld) = matchAndApplyEvent event taskId taskTime v mask ts iworld
<