Commit 914a7535 authored by Bas Lijnse's avatar Bas Lijnse

Changed all internal access of task instance state to shared data sources

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2376 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 44a292c8
......@@ -11,9 +11,7 @@ from IWorld import :: IWorld(..)
from iTasks import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDecode
from TaskEval import localShare, parListShare, topListShare
from CoreTasks import return
from SharedDataSource import write, writeFilterMsg, read
WORKON_EXPIRY :== 5000 //NO REAL SOLUTION...
from SharedDataSource import write, writeFilterMsg, read, readRegister
derive class iTask ParallelTaskType, WorkOnStatus
......@@ -57,7 +55,6 @@ where
= case er of
Ok r = case projection val r of
Just w
//# (ew, iworld) = writeFilterMsg w ((<>) currentInstance) share iworld
# (ew, iworld) = write w share iworld
= case ew of
Ok _ = (result, iworld)
......@@ -268,12 +265,14 @@ where
//Copy the last stored result of detached tasks
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)
# (mbMeta,iworld) = read (taskInstanceMeta instanceNo) iworld
# (mbResult,iworld) = read (taskInstanceResult instanceNo) iworld
= case (mbMeta,mbResult) of
(Ok meta,Ok res)
# fixme = [] //TODO: Get the attributes from detached tasks
# (entry,iworld) = updateListEntryDetachedResult taskId entryId res meta.TIMeta.progress meta.TIMeta.management fixme iworld
= (Nothing,acc++[(entry,Nothing)],iworld)
_ = (Nothing,acc,iworld) //TODO: remove from parallel if it can't be loaded (now it simply keeps the last known result)
//Do nothing if an exeption occurred or marked as removed
evalParTask taskId event (result,acc,iworld) entry = (result,acc,iworld)
......@@ -334,8 +333,8 @@ appendTaskToList taskId=:(TaskId parent _) (parType,parTask) iworld=:{taskTime,c
= (taskIda, EmbeddedState (dynamic task :: Task a^) (TCInit taskIda taskTime),iworld)
Detached management
# task = parTask (parListShare taskId)
# progress = {issuedAt=currentDateTime,issuedBy=currentUser,status=True,firstEvent=Nothing,latestEvent=Nothing}
# (taskIda=:TaskId instanceNo _,iworld) = createPersistentInstance task management currentUser parent iworld
# progress = {issuedAt=currentDateTime,issuedBy=currentUser,stable=True,firstEvent=Nothing,latestEvent=Nothing}
# (taskIda=:TaskId instanceNo _,iworld) = createTopTaskInstance task management currentUser parent iworld
= (taskIda,DetachedState instanceNo progress management, iworld)
# result = TIValue NoValue taskTime
# entry = {entryId = taskIda, state = state, result = result, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, expiresIn = Nothing, removed = False}
......@@ -387,7 +386,7 @@ loadTaskList taskId=:(TaskId instanceNo taskNo) iworld=:{currentInstance,localLi
| instanceNo == currentInstance
= (fromMaybe [] ('Map'.get taskId localLists),iworld)
| otherwise
= case loadTaskReduct instanceNo iworld of
= case read (taskInstanceReduct instanceNo) iworld of
(Ok {TIReduct|lists},iworld) = (fromMaybe [] ('Map'.get taskId lists),iworld)
(_,iworld) = ([],iworld)
......@@ -396,8 +395,10 @@ storeTaskList taskId=:(TaskId instanceNo taskNo) list iworld=:{currentInstance,l
| instanceNo == currentInstance
= {iworld & localLists = 'Map'.put taskId list localLists}
| otherwise
= case loadTaskReduct instanceNo iworld of
(Ok reduct=:{TIReduct|lists},iworld) = storeTaskReduct instanceNo {TIReduct|reduct & lists = 'Map'.put taskId list lists} iworld
= case read (taskInstanceReduct instanceNo) iworld of
(Ok reduct=:{TIReduct|lists},iworld)
# (_,iworld) = write {TIReduct|reduct & lists = 'Map'.put taskId list lists} (taskInstanceReduct instanceNo) iworld
= iworld
(_,iworld) = iworld
readListId :: (SharedTaskList a) *IWorld -> (MaybeErrorString (TaskListId a),*IWorld) | iTask a
......@@ -427,7 +428,7 @@ where
append TopLevelTaskList parType parTask iworld=:{currentUser}
# meta = case parType of Embedded = defaultValue; Detached meta = meta;
# task = parTask topListShare
= createPersistentInstance task meta currentUser 0 iworld
= createTopTaskInstance task meta currentUser 0 iworld
append (ParallelTaskList parId) parType parTask iworld
= appendTaskToList parId (parType,parTask) iworld
......@@ -456,33 +457,37 @@ workOn :: !TaskId -> Task WorkOnStatus
workOn (TaskId instanceNo taskNo) = Task eval
where
eval event repOpts (TCInit taskId ts) iworld=:{currentInstance,currentUser}
# iworld = setTaskWorker currentUser instanceNo iworld
# iworld = addTaskInstanceObserver currentInstance instanceNo iworld
= eval event repOpts (TCBasic taskId ts JSONNull False) iworld
# (meta,iworld) = read (taskInstanceMeta instanceNo) iworld
= case meta of
Ok meta
# (_,iworld) = write {TIMeta|meta & worker=Just currentUser} (taskInstanceMeta instanceNo) iworld
# iworld = queueUrgentEvaluate instanceNo iworld
= eval event repOpts (TCBasic taskId ts JSONNull False) iworld
Error e
= (ExceptionResult (dynamic e) e,iworld)
eval event repOpts tree=:(TCBasic taskId ts _ _) iworld=:{currentUser}
eval event repOpts tree=:(TCBasic taskId ts _ _) iworld=:{currentInstance,currentUser}
//Load instance
# (meta,iworld) = loadTaskMeta instanceNo iworld
# (result,iworld) = loadTaskResult instanceNo iworld
# (rep,iworld) = loadTaskRep instanceNo iworld
# (meta,iworld) = readRegister currentInstance (taskInstanceMeta instanceNo) iworld
# (result,iworld) = readRegister currentInstance (taskInstanceResult instanceNo) iworld
# (rep,iworld) = readRegister currentInstance (taskInstanceRep instanceNo) iworld
# layout = repLayout repOpts
= case (meta,result,rep) of
(_,Ok (TIValue (Value _ True) _),_)
= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,expiresIn=Just WORKON_EXPIRY} (finalizeRep repOpts noRep) tree, iworld)
= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
(_,Ok (TIException _ _),_)
= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,expiresIn=Just WORKON_EXPIRY} (finalizeRep repOpts noRep) tree, iworld)
= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
(Ok meta=:{TIMeta|worker=Just worker},_,Ok (TaskRep def parts))
| worker == currentUser
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn def meta) parts)
= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts,expiresIn=Just WORKON_EXPIRY} rep tree, iworld)
= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts,expiresIn=Nothing} rep tree, iworld)
| otherwise
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn (inUseDef worker) meta) parts)
= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts,expiresIn=Just WORKON_EXPIRY} rep tree, iworld)
= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts,expiresIn=Nothing} rep tree, iworld)
_
= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
# iworld = removeTaskInstanceObserver currentInstance instanceNo iworld
= (DestroyedResult,iworld)
inUseDef worker
......
......@@ -27,6 +27,7 @@ currentDate :: ReadOnlyShared Date
// Processes
topLevelTasks :: SharedTaskList Void
currentSessions :: ReadOnlyShared [TaskListItem Void]
currentProcesses :: ReadOnlyShared [TaskListItem Void]
processesForCurrentUser :: ReadOnlyShared [TaskListItem Void]
......
implementation module SystemData
import SystemTypes, Store, TaskStore, Time, Shared, Util, Text, Task, Tuple, StdFile
import SystemTypes, Store, TaskStore, Time, Shared, Util, Text, Task, Tuple, StdFile, Map
import Random
import StdList, StdBool
from StdFunc import o, seq
......@@ -11,23 +11,7 @@ SYSTEM_DATA_NS :== "SystemData"
sharedStore :: !String !a -> Shared a | JSONEncode{|*|}, JSONDecode{|*|}, TC a
sharedStore storeId defaultV = storeAccess NS_APPLICATION_SHARES storeId defaultV
/*
sharedStore :: !String !a -> Shared a | JSONEncode{|*|}, JSONDecode{|*|}, TC a
sharedStore storeId defaultV = createChangeOnWriteSDS
"sharedStore" storeId
(get (loadValue NS_APPLICATION_SHARES) defaultV)
write
where
get f defaultV iworld
# (mbV,iworld) = f storeId iworld
# res = case mbV of
Nothing = Ok defaultV
Just v = Ok v
= (res,iworld)
write v iworld = (Ok Void,storeValue NS_APPLICATION_SHARES storeId v iworld)
*/
currentDateTime :: ReadOnlyShared DateTime
currentDateTime = createReadOnlySDSPredictable SYSTEM_DATA_NS "currentDateTime" read
where
......@@ -56,31 +40,34 @@ where
// Workflow processes
topLevelTasks :: SharedTaskList Void
topLevelTasks = createReadOnlySDS read
topLevelTasks = mapRead readPrj currentProcesses
where
read iworld
# (list, iworld) = loadValue NS_TASK_INSTANCES "persistent-index" iworld
= ({TaskList|listId = TopLevelTaskList, items = fromMaybe [] list}, iworld)
readPrj items = {TaskList|listId = TopLevelTaskList, items = items}
currentSessions ::ReadOnlyShared [TaskListItem Void]
currentSessions = mapRead (\instances -> [toTaskListItem m \\ (_,m) <- (toList instances) | isSession m]) (toReadOnly taskInstances)
currentProcesses ::ReadOnlyShared [TaskListItem Void]
currentProcesses = createReadOnlySDS read
where
read iworld
# (list, iworld) = loadValue NS_TASK_INSTANCES "persistent-index" iworld
= (fromMaybe [] list, iworld)
currentProcesses = mapRead (\instances -> [toTaskListItem m \\ (_,m) <- (toList instances) | not (isSession m)]) (toReadOnly taskInstances)
processesForCurrentUser :: ReadOnlyShared [TaskListItem Void]
processesForCurrentUser = createReadOnlySDS read
processesForCurrentUser = mapRead readPrj (currentProcesses >+| currentUser)
where
read iworld=:{currentUser}
# (list, iworld) = loadValue NS_TASK_INSTANCES "persistent-index" iworld
= (maybe [] (\l -> [ p \\ p <- l | forWorker currentUser p]) list, iworld)
readPrj (items,user) = filter (forWorker user) items
forWorker user {managementMeta=Just {ManagementMeta|worker=AnyUser}} = True
forWorker (AuthenticatedUser uid1 _ _) {managementMeta=Just {ManagementMeta|worker=UserWithId uid2}} = uid1 == uid2
forWorker (AuthenticatedUser _ roles _) {managementMeta=Just {ManagementMeta|worker=UserWithRole role}} = isMember role roles
forWorker _ _ = False
isSession :: !TIMeta -> Bool
isSession {TIMeta|sessionId=Just _} = True
isSession _ = False
toTaskListItem :: !TIMeta -> TaskListItem a //TODO add task meta
toTaskListItem {TIMeta|instanceNo,progress,management}
= {taskId = TaskId instanceNo 0, value = NoValue, taskMeta = [], progressMeta = Just progress, managementMeta = Just management}
currentUser :: ReadOnlyShared User
currentUser = createReadOnlySDS (\iworld=:{currentUser} -> (currentUser,iworld))
......
......@@ -427,7 +427,7 @@ instance < TaskId
:: ProgressMeta =
{ issuedAt :: !DateTime //* When was the task created
, issuedBy :: !User //* By whom was the task created
, status :: !Stability //* Is a maintask active,suspended,finished or excepted
, stable :: !Stability //* Is a maintask stable
, firstEvent :: !Maybe DateTime //* When was the first work done on this task
, latestEvent :: !Maybe DateTime //* When was the latest event on this task
}
......
......@@ -199,7 +199,7 @@ where
show ownPid {TaskListItem|taskId,progressMeta=Just pmeta,managementMeta=Just _} = taskId <> ownPid
show ownPid _ = False
isActive {progressMeta=Just {status}} = not status
isActive {progressMeta=Just {stable}} = not stable
mkRow {TaskListItem|progressMeta=Just pmeta,managementMeta=Just mmeta} =
{WorklistRow
......
......@@ -110,7 +110,8 @@ where
= (Nothing, iworld)
Work work
# iworld = case work of
(Evaluate instanceNo) = refreshInstance instanceNo iworld
(Evaluate instanceNo) = refreshTaskInstance instanceNo iworld
(EvaluateUrgent instanceNo) = refreshTaskInstance instanceNo iworld
(TriggerSDSChange sdsId) = addOutdatedOnShareChange sdsId (const True) iworld
(CheckSDS sdsId hash checkF)
# (checkRes,iworld) = checkF iworld
......@@ -128,4 +129,4 @@ where
| delta > MAX_TIMEOUT/1000 = MAX_TIMEOUT
| otherwise = delta*1000
MAX_TIMEOUT :== 86400000 // one day
\ No newline at end of file
MAX_TIMEOUT :== 86400000 // one day
......@@ -36,12 +36,16 @@ from SharedDataSource import class registerSDSDependency, class registerSDSChang
updateCurrentDateTime :: !*IWorld -> *IWorld
queueWork :: !(!Work, !Maybe Timestamp) !*IWorld -> *IWorld
queueUrgentEvaluate :: !InstanceNo !*IWorld -> *IWorld
dequeueWork :: !*IWorld -> (!DequeueResult, !*IWorld)
dequeueWorkFilter :: !(Work -> Bool) !*IWorld -> (![Work], !*IWorld)
getResponseExpiry :: !InstanceNo !*IWorld -> (!Maybe Int, !*IWorld)
:: DequeueResult = Empty | Work !Work | WorkAt !Timestamp
:: Work = Evaluate !InstanceNo
| EvaluateUrgent !InstanceNo
| TriggerSDSChange !BasicShareId
| CheckSDS !BasicShareId !Hash (*IWorld -> *(!CheckRes, !*IWorld))
......@@ -54,4 +58,4 @@ instance reportSDSChange Void IWorld
//Sync work queue to disk (Only used with CGI wrapper)
saveWorkQueue :: !*IWorld -> *IWorld
restoreWorkQueue :: !*IWorld -> *IWorld
\ No newline at end of file
restoreWorkQueue :: !*IWorld -> *IWorld
......@@ -13,7 +13,7 @@ from StdFile import instance FileSystem World
from List_NG import splitWith
from SharedDataSource import class registerSDSDependency, class registerSDSChangeDetection, class reportSDSChange, :: CheckRes(..), :: BasicShareId, :: Hash
import TaskStore, Time, Util, StdList, Base64, _SystemArray, StdBool, StdTuple
import SerializationGraphCopy //TODO: Make switchable from within iTasks module
import SerializationGraphCopy
updateCurrentDateTime :: !*IWorld -> *IWorld
updateCurrentDateTime iworld=:{IWorld|world}
......@@ -36,11 +36,25 @@ where
instance == Work
where
(==) (Evaluate instanceNoX) (Evaluate instanceNoY) = instanceNoX == instanceNoY
(==) (TriggerSDSChange sdsIdX) (TriggerSDSChange sdsIdY) = sdsIdX == sdsIdY
(==) (CheckSDS sdsIdX hashX _) (CheckSDS sdsIdY hashY _) = sdsIdX == sdsIdY && hashX == hashY
(==) (Evaluate instanceNoX) (Evaluate instanceNoY) = instanceNoX == instanceNoY
(==) (EvaluateUrgent instanceNoX) (EvaluateUrgent instanceNoY) = instanceNoX == instanceNoY
(==) (TriggerSDSChange sdsIdX) (TriggerSDSChange sdsIdY) = sdsIdX == sdsIdY
(==) (CheckSDS sdsIdX hashX _) (CheckSDS sdsIdY hashY _) = sdsIdX == sdsIdY && hashX == hashY
(==) _ _ = False
queueUrgentEvaluate :: !InstanceNo !*IWorld -> *IWorld
queueUrgentEvaluate instanceNo iworld=:{workQueue}
= {iworld & workQueue = queue instanceNo workQueue}
where
queue newInstanceNo [] = [(EvaluateUrgent instanceNo,Nothing)]
queue newInstanceNo [(EvaluateUrgent no,ts):qs]
| newInstanceNo == no = [(EvaluateUrgent no,ts):qs]
= [(EvaluateUrgent no,ts):queue newInstanceNo qs]
queue newInstanceNo [(Evaluate no,ts):qs]
| newInstanceNo == no = [(EvaluateUrgent no,Nothing):qs]
= [(Evaluate no,ts):queue newInstanceNo qs]
queue newInstanceNo [q:qs] = [q:queue newInstanceNo qs]
dequeueWork :: !*IWorld -> (!DequeueResult, !*IWorld)
dequeueWork iworld=:{workQueue}
| isEmpty workQueue = (Empty, iworld)
......@@ -67,6 +81,23 @@ where
filter` _ (work,Nothing) = filter work
filter` curTime (work,Just time) = curTime >= time && filter work
//Determine the expiration of request, thereby determining the poll interval of
//polling clients
REGULAR_EXPIRY :== 10000
FAST_EXPIRY :== 100
IMMEDIATE_EXPIRY :== 0
getResponseExpiry :: !InstanceNo !*IWorld -> (!Maybe Int, !*IWorld)
getResponseExpiry instanceNo iworld=:{workQueue}
= (Just (expiry instanceNo workQueue), iworld)
where
expiry _ [] = REGULAR_EXPIRY
expiry instanceNo [(Evaluate _,Just (Timestamp 0)):ws] //HACK...
= IMMEDIATE_EXPIRY
expiry instanceNo [(Evaluate evalNo,_):ws]
| evalNo == instanceNo = FAST_EXPIRY
= expiry instanceNo ws
expiry instanceNo [_:ws] = expiry instanceNo ws
//Wrapper instance for file access
instance FileSystem IWorld
where
......@@ -118,4 +149,4 @@ saveWorkQueue iworld=:{workQueue} = storeValue NS_TASK_INSTANCES WORKQUEUE_INDEX
restoreWorkQueue :: !*IWorld -> *IWorld
restoreWorkQueue iworld
# (mbWorkQueue,iworld) = loadValue NS_TASK_INSTANCES WORKQUEUE_INDEX iworld
= {iworld & workQueue = fromMaybe [] mbWorkQueue}
\ No newline at end of file
= {iworld & workQueue = fromMaybe [] mbWorkQueue}
......@@ -11,33 +11,29 @@ import Maybe, JSON_NG, Error
import TaskState, iTaskClass
/**
* Create a new task instance without evaluating it by an existing instance number
* Create a new session task instance and evaluate its immediately
*
* @param The instance number
* @param Optionally the session id
* @param The parent instance number
* @param Optionally the worker use
* @param Optionally, the session id
* @param ManagementMeta
* @param ProgressMeta
* @param The task to run as session
* @param An event
* @param The IWorld state
*
* @return The created task instance
* @return The result of the targeted main task and the tasknr of the instance or an error
* @return The IWorld state
*/
createTaskInstance :: !InstanceNo !(Maybe SessionId) !InstanceNo !(Maybe User) !(Task a) !ManagementMeta !ProgressMeta !*IWorld -> (!TaskInstance, !*IWorld) | iTask a
createSessionTaskInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
/**
* Create a new session task instance and evaluate its immediately
*
* @param The task to run as session
* @param An event
* Create a stored task instance in the task pool (lazily without evaluating it)
* @param The task to store
* @param Management meta data
* @param The user who issued the task
* @param The parent instance that created the instance
* @param The IWorld state
*
* @return The result of the targeted main task and the tasknr of the instance or an error
* @return The task id of the stored instance
* @return The IWorld state
*/
createSessionInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createTopTaskInstance :: !(Task a) !ManagementMeta !User !InstanceNo !*IWorld -> (!TaskId, !*IWorld) | iTask a
/**
* Evaluate a session task instance
......@@ -49,25 +45,28 @@ createSessionInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskR
* @return The result of the targeted main task or an error
* @return The IWorld state
*/
evalSessionInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionTaskInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
/**
* Create a stored task instance in the task pool (lazily without evaluating it)
* @param The task to store
* @param Management meta data
* @param The user who issued the task
* @param The parent instance that created the instance
* Evaluate a task instance without any events
*
* @param The task instance number
* @param The IWorld state
*
* @return The task id of the stored instance
* @return The IWorld state
*/
createPersistentInstance :: !(Task a) !ManagementMeta !User !InstanceNo !*IWorld -> (!TaskId, !*IWorld) | iTask a
refreshTaskInstance :: !InstanceNo !*IWorld -> *IWorld
//Evaluate a task instance without any events
refreshInstance :: !InstanceNo !*IWorld -> *IWorld
/**
* Refresh all urgent task instances
*
* @param The IWorld state
*
* @return The IWorld state
*/
refreshUrgentTaskInstances :: !*IWorld -> *IWorld
//Helper functions that provide access to shares and parallel task lists
localShare :: !TaskId -> Shared a | iTask a
topListShare :: SharedTaskList a
parListShare :: !TaskId -> SharedTaskList a | iTask a
\ No newline at end of file
parListShare :: !TaskId -> SharedTaskList a | iTask a
implementation module TaskEval
import StdList, StdBool
import StdList, StdBool, StdTuple
import Error
import SystemTypes, IWorld, Shared, Task, TaskState, TaskStore, Util, Func
import LayoutCombinators
from CoreCombinators import :: ParallelTaskType(..), :: ParallelTask(..)
from Map import qualified newMap, fromList, toList, get, put
from SharedDataSource import qualified read, write, writeFilterMsg
from IWorld import dequeueWorkFilter
import iTaskClass
createTaskInstance :: !InstanceNo !(Maybe SessionId) !InstanceNo !(Maybe User) !(Task a) !ManagementMeta !ProgressMeta !*IWorld -> (!TaskInstance, !*IWorld) | iTask a
createTaskInstance instanceNo sessionId parent worker task mmeta pmeta iworld=:{taskTime}
# meta = {TIMeta|instanceNo=instanceNo,sessionId=sessionId,parent=parent,worker=worker,observes=[],observedBy=[],management=mmeta,progress=pmeta}
# reduct = {TIReduct|task=toJSONTask task,nextTaskNo=2,nextTaskTime=1,tree=(TCInit (TaskId instanceNo 0) 1),shares = 'Map'.newMap, lists = 'Map'.newMap}
# result = TIValue NoValue taskTime
# rep = (TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[(stringDisplay "This task has not been evaluated yet.",'Map'.newMap)],direction = Vertical,actions = []}) [])
= ((meta,reduct,result,rep),iworld)
createSessionTaskInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createSessionTaskInstance task event iworld=:{currentDateTime,taskTime}
# (sessionId,iworld) = newSessionId iworld
# (instanceNo,iworld) = newInstanceNo iworld
# worker = AnonymousUser sessionId
//Create the initial instance data in the store
# mmeta = defaultValue
# pmeta = {issuedAt=currentDateTime,issuedBy=worker,stable=False,firstEvent=Nothing,latestEvent=Nothing}
# 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
//Register the sessionId -> instanceNo relation
# iworld = registerSession sessionId instanceNo iworld
//Evaluate once
# (mbResult,iworld) = evalTaskInstance RefreshEvent instanceNo iworld
= case mbResult of
Ok result = (Ok (result,instanceNo,sessionId),iworld)
Error e = (Error e, iworld)
where
registerSession sessionId instanceNo iworld=:{IWorld|sessions}
= {IWorld|iworld & sessions = 'Map'.put sessionId instanceNo sessions}
createTopTaskInstance :: !(Task a) !ManagementMeta !User !InstanceNo !*IWorld -> (!TaskId, !*IWorld) | iTask a
createTopTaskInstance task mmeta issuer parent iworld=:{currentDateTime,taskTime}
# (instanceNo,iworld) = newInstanceNo iworld
# pmeta = {issuedAt=currentDateTime,issuedBy=issuer,stable=False,firstEvent=Nothing,latestEvent=Nothing}
# 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
= (TaskId instanceNo 0, iworld)
createMeta :: !InstanceNo (Maybe SessionId) InstanceNo !(Maybe User) !ManagementMeta !ProgressMeta -> TIMeta
createMeta instanceNo sessionId parent worker mmeta pmeta
= {TIMeta|instanceNo=instanceNo,sessionId=sessionId,parent=parent,worker=worker,observes=[],observedBy=[],management=mmeta,progress=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}
where
toJSONTask (Task eval) = Task eval`
where
......@@ -24,112 +60,120 @@ where
(ValueResult val ts rep tree,iworld) = (ValueResult (fmap toJSON val) ts rep tree, iworld)
(ExceptionResult e str,iworld) = (ExceptionResult e str,iworld)
createSessionInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createSessionInstance task event iworld=:{currentDateTime}
# (sessionId,iworld) = newSessionId iworld
# (instanceId,iworld) = newInstanceId iworld
# worker = AnonymousUser sessionId
# ((meta,reduct,result,_), iworld)
= createTaskInstance instanceId (Just sessionId) 0 (Just worker) task defaultValue {issuedAt=currentDateTime,issuedBy=worker,status=False,firstEvent=Nothing,latestEvent=Nothing} iworld
# (mbRes,iworld) = evalAndStoreInstance True event (meta,reduct,result) iworld
= case loadSessionInstance sessionId iworld of
(Ok (meta,reduct,result),iworld)
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
= case mbRes of
Ok result = (Ok (result, instanceId, sessionId), iworld)
Error e = (Error e, iworld)
(Error e, iworld)
= (Error e, iworld)
createResult :: TaskTime -> TIResult
createResult taskTime = TIValue NoValue taskTime
evalSessionInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionInstance sessionId event iworld
createRep :: TIRep
createRep = TaskRep (UIControlGroup {UIControlGroup|attributes='Map'.newMap, controls=[],direction = Vertical,actions = []}) []
//Evaluate a session task instance when a new event is received from a client
evalSessionTaskInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionTaskInstance sessionId event iworld
//Set session user
# iworld = {iworld & currentUser = AnonymousUser sessionId}
//Update current datetime in iworld
# iworld = updateCurrentDateTime iworld
//Evaluate the instance at which the event is targeted or refresh the session instance
# iworld = case event of
RefreshEvent = refreshSessionInstance sessionId iworld
_ = processEvent event iworld
//Evaluate session instance
# (mbInstance,iworld) = loadSessionInstance sessionId iworld
= case mbInstance of
Error e = (Error e, iworld)
Ok (meta,reduct,result)
//Refresh affected tasks
# iworld = refreshInstancesIfOutdated meta.observes iworld
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
= case mbRes of
Ok result = (Ok (result, meta.TIMeta.instanceNo, sessionId), iworld)
processEvent :: !Event !*IWorld -> *IWorld
processEvent RefreshEvent iworld = iworld
processEvent event iworld
= case loadTaskInstance (instanceNo event) iworld of
(Error _,iworld) = iworld
(Ok (meta,reduct,result),iworld)
//Eval the targeted instance first
# (_,iworld) = evalAndStoreInstance False event (meta,reduct,result) iworld
= iworld
//Determine which task instance to evaluate
# (sessionNo, iworld) = determineSessionInstanceNo sessionId iworld
| sessionNo == 0 = (Error ("Could not load session " +++ sessionId), iworld)
//Evaluate the task instance at which the event is targeted
# (mbResult,iworld) = evalTaskInstance event (eventTarget event sessionNo) iworld
//Evaluate urgent task instances (just started workOn's for example)
# iworld = refreshUrgentTaskInstances iworld
//If the session task is outdated compute it a second time
# (outdated,iworld) = isSessionOutdated sessionNo iworld
| outdated