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
This diff is collapsed.
......@@ -11,26 +11,17 @@ from Time import :: Timestamp
from SharedDataSource import :: BasicShareId, :: RWShared
newSessionId :: !*IWorld -> (!SessionId, !*IWorld)
newInstanceId :: !*IWorld -> (!InstanceNo, !*IWorld)
newInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
maxInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
newDocumentId :: !*IWorld -> (!DocumentId, !*IWorld)
storeTaskInstance :: !TaskInstance !*IWorld -> *IWorld
//Task instance state accessible as shared data sources
taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWorld //The master index of available instances
loadTaskInstance :: !InstanceNo !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld)
loadSessionInstance :: !SessionId !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld)
//Separated load functions
loadTaskMeta :: !InstanceNo !*IWorld -> (!MaybeErrorString TIMeta, !*IWorld)
loadTaskReduct :: !InstanceNo !*IWorld -> (!MaybeErrorString TIReduct, !*IWorld)
loadTaskResult :: !InstanceNo !*IWorld -> (!MaybeErrorString TIResult, !*IWorld)
loadTaskRep :: !InstanceNo !*IWorld -> (!MaybeErrorString TIRep, !*IWorld)
//Store
storeTaskMeta :: !InstanceNo !TIMeta !*IWorld -> *IWorld
storeTaskReduct :: !InstanceNo !TIReduct !*IWorld -> *IWorld
storeTaskResult :: !InstanceNo !TIResult !*IWorld -> *IWorld
storeTaskRep :: !InstanceNo !TIRep !*IWorld -> *IWorld
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
deleteTaskInstance :: !InstanceNo !*IWorld -> *IWorld
......@@ -39,32 +30,14 @@ createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError
createDocumentWith :: !String !String (*File -> *File) !*IWorld -> (!MaybeError FileError Document, !*IWorld)
loadDocumentContent :: !DocumentId !*IWorld -> (!Maybe String, !*IWorld)
loadDocumentMeta :: !DocumentId !*IWorld -> (!Maybe Document, !*IWorld)
documentLocation :: !DocumentId !*IWorld -> (!FilePath,!*IWorld)
setTaskWorker :: !User !InstanceNo !*IWorld -> *IWorld
//Keep track of which instances depend on other instances
//first instance observes second one
addTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
removeTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
//instances observed by given instance
getTaskInstanceObserved :: !InstanceNo !*IWorld -> (![InstanceNo], !*IWorld)
//instances observing given instance
getTaskInstanceObservers :: !InstanceNo !*IWorld -> (![InstanceNo], !*IWorld)
//Keep track of outdated task instances that need to be refreshed
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
clearShareRegistrations :: !InstanceNo !*IWorld -> *IWorld
//Queue evaluation when shares change
addOutdatedOnShareChange :: !BasicShareId !(InstanceNo -> Bool) !*IWorld -> *IWorld
//Task state accessible as shared data sources
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceResult :: !InstanceNo -> RWShared TIResult TIResult IWorld
taskInstanceRep :: !InstanceNo -> RWShared TIRep TIRep IWorld
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
//Keep last version of session user interfaces around, to be able to send differences to client
storeCurUI :: !SessionId !Int !UIDef !*IWorld -> *IWorld
......
......@@ -37,8 +37,8 @@ newSessionId iworld=:{IWorld|world,timestamp}
# (Clock c, world) = clock world
= (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- genRandInt (toInt timestamp+c)]) , {IWorld|iworld & world = world})
newInstanceId :: !*IWorld -> (!InstanceNo,!*IWorld)
newInstanceId iworld
newInstanceNo :: !*IWorld -> (!InstanceNo,!*IWorld)
newInstanceNo iworld
# (mbNewTid,iworld) = loadValue NS_TASK_INSTANCES INCREMENT iworld
= case mbNewTid of
Just tid
......@@ -170,38 +170,6 @@ updateTaskInstanceMeta instanceNo f iworld
# iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) (f meta) iworld
= addOutdatedInstances [(instanceNo, Nothing)] iworld
setTaskWorker :: !User !InstanceNo !*IWorld -> *IWorld
setTaskWorker worker instanceNo iworld
= updateTaskInstanceMeta instanceNo (set worker) iworld
where
set worker inst=:{TIMeta|worker=Nothing} = {TIMeta|inst & worker = Just worker}
set _ inst = inst
addTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
addTaskInstanceObserver observer observed iworld
# iworld = updateTaskInstanceMeta observer (\meta -> {TIMeta|meta & observes = removeDup (meta.observes ++ [observed])}) iworld
# iworld = updateTaskInstanceMeta observed (\meta -> {TIMeta|meta & observedBy = removeDup (meta.observedBy ++ [observer])}) iworld
= iworld
removeTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
removeTaskInstanceObserver observer observed iworld
# iworld = updateTaskInstanceMeta observer (\meta-> {TIMeta|meta & observes = filter ((<>) observed) meta.observes}) iworld
# iworld = updateTaskInstanceMeta observed (\meta-> {TIMeta|meta & observedBy = filter ((<>) observer) meta.observedBy}) iworld
= iworld
getTaskInstanceObserved :: !InstanceNo !*IWorld -> (![InstanceNo], !*IWorld)
getTaskInstanceObserved instanceNo iworld = case loadTaskMeta instanceNo iworld of
(Ok {observes},iworld) = (observes, iworld)
(_, iworld) = ([], iworld)
getTaskInstanceObservers :: !InstanceNo !*IWorld -> (![InstanceNo], !*IWorld)
getTaskInstanceObservers instanceNo iworld = case loadTaskMeta instanceNo iworld of
(Ok {observedBy},iworld) = (observedBy, iworld)
(_, iworld) = ([], iworld)
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
addOutdatedInstances outdated iworld = seqSt queueWork [(Evaluate instanceNo,mbTs) \\ (instanceNo,mbTs) <- outdated] iworld
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
addShareRegistration shareId instanceNo iworld
# (mbRegs,iworld) = loadValue NS_TASK_INSTANCES SHARE_REGISTRATIONS iworld
......@@ -230,8 +198,20 @@ addOutdatedOnShareChange shareId filterFun iworld
= storeValue NS_TASK_INSTANCES SHARE_REGISTRATIONS regs iworld
_ = iworld
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
addOutdatedInstances outdated iworld = seqSt queueWork [(Evaluate instanceNo,mbTs) \\ (instanceNo,mbTs) <- outdated] iworld
taskInstances :: RWShared (Map InstanceNo TIMeta) (Map InstanceNo TIMeta) IWorld
taskInstances = storeAccess NS_TASK_INSTANCES "instances" newMap
taskInstanceMeta :: !InstanceNo -> RWShared TIMeta TIMeta IWorld
taskInstanceMeta instanceNo = storeAccess NS_TASK_INSTANCES (meta_store instanceNo) (abort "Read task instance meta too early")
taskInstanceMeta instanceNo = mapReadWriteError (readPrj,writePrj) taskInstances
where
readPrj instances = case get instanceNo instances of
Just i = Ok i
_ = Error ("Task instance " +++ toString instanceNo +++ " could not be found")
writePrj i instances = Ok (Just (put instanceNo i instances))
taskInstanceReduct :: !InstanceNo -> RWShared TIReduct TIReduct IWorld
taskInstanceReduct instanceNo = storeAccess NS_TASK_INSTANCES (reduct_store instanceNo) (abort "Read task instance reduct too early")
......
......@@ -51,34 +51,35 @@ webService task defaultFormat req iworld=:{IWorld|timestamp,application}
//Load or create session context and edit / evaluate
# (mbResult, mbPrevUI, iworld) = case sessionParam of
""
# (mbResult, iworld) = createSessionInstance (task req) RefreshEvent iworld
# (mbResult, iworld) = createSessionTaskInstance (task req) RefreshEvent iworld
= (mbResult, Nothing, iworld)
sessionId
//Check if there is a previous tui definition and check if it is still current
# (mbPrevUI,iworld) = loadPrevUI sessionId guiVersion iworld
# (mbResult, iworld) = evalSessionInstance sessionId event iworld
# (mbResult, iworld) = evalSessionTaskInstance sessionId event iworld
= (mbResult,mbPrevUI,iworld)
# (json, iworld) = case mbResult of
//Determine expiry date
# (json, iworld) = case mbResult of
Error err
= (JSONObject [("success",JSONBool False),("error",JSONString err)],iworld)
Ok (ExceptionResult _ err,_,_)
= (JSONObject [("success",JSONBool False),("error",JSONString err)], iworld)
Ok (ValueResult (Value _ True) _ _ _,_,_)
= (JSONObject ([("success",JSONBool True),("done",JSONBool True)]), iworld)
Ok (ValueResult _ info curRep context,_,sessionId)
Ok (ValueResult _ info curRep context,instanceNo,sessionId)
# (expiresIn,iworld) = getResponseExpiry instanceNo iworld
# json = case (mbPrevUI,curRep) of
(Nothing, TaskRep def _)
= JSONObject [("success",JSONBool True)
,("session",JSONString sessionId)
,("expiresIn",toJSON info.TaskInfo.expiresIn)