Commit 5962a5a9 authored by Steffen Michels's avatar Steffen Michels
Browse files

added background process updating outdated instances using SDSs with...

added background process updating outdated instances using SDSs with predictable change to single-threaded HTTP server

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2202 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 03945ba3
......@@ -11,7 +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, read
from SharedDataSource import writeFilterMsg, read
derive class iTask ParallelTaskType, WorkOnStatus
......@@ -50,12 +50,12 @@ where
ExceptionResult e str
= (ExceptionResult e str,iworld)
projectOnShare val result iworld
projectOnShare val result iworld=:{currentInstance}
# (er, iworld) = read share iworld
= case er of
Ok r = case projection val r of
Just w
# (ew, iworld) = write w share iworld
# (ew, iworld) = writeFilterMsg w ((<>) currentInstance) share iworld
= case ew of
Ok _ = (result, iworld)
Error e = (exception e, iworld)
......@@ -473,8 +473,8 @@ where
_
= (ValueResult (Value WODeleted Stable) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld
//TODO: Remove this workon from the observers
eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
# iworld = removeTaskInstanceObserver currentInstance instanceNo iworld
= (DestroyedResult,iworld)
inUseDef worker
......
......@@ -3,7 +3,7 @@ implementation module CoreTasks
import StdList, StdBool, StdInt, StdTuple,StdMisc, Util, HtmlUtil, Time, Error, OSError, Map, Tuple, List_NG
import qualified StdList
import iTaskClass, Task, TaskState, TaskEval, TaskStore, UIDefinition, LayoutCombinators, Shared
from SharedDataSource import qualified read, readRegister, write
from SharedDataSource import qualified read, readRegister, writeFilterMsg
from StdFunc import o, id
from IWorld import :: IWorld(..)
from SystemData import topLevelTasks
......@@ -33,8 +33,8 @@ where
set :: !a !(ReadWriteShared r a) -> Task a | iTask a
set val shared = mkInstantTask eval
where
eval taskId iworld=:{taskTime}
# (res,iworld) ='SharedDataSource'.write val shared iworld
eval taskId iworld=:{taskTime,currentInstance}
# (res,iworld) ='SharedDataSource'.writeFilterMsg val ((<>) currentInstance) shared iworld
= case res of
Ok _ = (Ok val,iworld)
Error e = (Error (dynamic (SharedException e), e), iworld)
......@@ -42,13 +42,13 @@ where
update :: !(r -> w) !(ReadWriteShared r w) -> Task w | iTask r & iTask w
update fun shared = mkInstantTask eval
where
eval taskId iworld=:{taskTime}
eval taskId iworld=:{taskTime,currentInstance}
# (er, iworld) = 'SharedDataSource'.read shared iworld
= case er of
Error e = (Error (dynamic (SharedException e), e), iworld)
Ok r
# w = fun r
# (er, iworld) = 'SharedDataSource'.write w shared iworld
# (er, iworld) = 'SharedDataSource'.writeFilterMsg w ((<>) currentInstance) shared iworld
= case er of
Ok _ = (Ok w, iworld)
Error e = (Error (dynamic (SharedException e), e), iworld)
......
......@@ -23,22 +23,30 @@ where
write v iworld = (Ok Void,storeValue NS_APPLICATION_SHARES storeId v iworld)
currentDateTime :: ReadOnlyShared DateTime
currentDateTime = createReadOnlySDS read
currentDateTime = createReadOnlySDSPredictable read
where
read iworld=:{currentInstance} //Marking instances outdated directly is a bit of a workaround
= 'Util'.currentDateTime (addOutdatedInstances [currentInstance] iworld)
read iworld
# (dateTime, iworld) = 'Util'.currentDateTime iworld
# (Timestamp ts, iworld) = 'Util'.currentTimestamp iworld
= ((dateTime, Timestamp (ts + 1)), iworld)
currentTime :: ReadOnlyShared Time
currentTime = createReadOnlySDS read
currentTime = createReadOnlySDSPredictable read
where
read iworld=:{currentInstance} //Marking instances outdated directly is a bit of a workaround
= 'Util'.currentTime (addOutdatedInstances [currentInstance] iworld)
read iworld
# (time, iworld) = 'Util'.currentTime iworld
# (Timestamp ts, iworld) = 'Util'.currentTimestamp iworld
= ((time, Timestamp (ts + 1)), iworld)
currentDate :: ReadOnlyShared Date
currentDate = createReadOnlySDS read
currentDate = createReadOnlySDSPredictable read
where
read iworld=:{currentInstance} //Marking instances outdated directly is a bit of a workaround
= 'Util'.currentDate (addOutdatedInstances [currentInstance] iworld)
read iworld
# (DateTime date time, iworld) = 'Util'.currentDateTime iworld
# (Timestamp ts, iworld) = 'Util'.currentTimestamp iworld
= ((date, Timestamp (ts + secondsUntilChange time)), iworld)
secondsUntilChange {Time|hour,min,sec} = (23-hour)*3600 + (59-min)*60 + (60-sec)
// Workflow processes
topLevelTasks :: SharedTaskList Void
......
......@@ -183,7 +183,7 @@ instance toEmail String
class toUserConstraint a
where
toUserConstraint :: a -> UserConstraint
toUserConstraint :: !a -> UserConstraint
instance toUserConstraint UserConstraint
instance toUserConstraint User
......
......@@ -577,7 +577,7 @@ where
class toUserConstraint a
where
toUserConstraint :: a -> UserConstraint
toUserConstraint :: !a -> UserConstraint
instance toUserConstraint UserConstraint
where
......
......@@ -44,7 +44,7 @@ authenticateUser :: !Username !Password -> Task (Maybe User)
doAuthenticated :: (Task a) -> Task a | iTask a
doAuthenticatedWith :: (Credentials -> Task (Maybe User)) (Task a) -> Task a | iTask a
doAuthenticatedWith :: !(Credentials -> Task (Maybe User)) (Task a) -> Task a | iTask a
/**
* Add a new user
......
......@@ -53,7 +53,7 @@ doAuthenticated task = doAuthenticatedWith verify task
where
verify {Credentials|username,password} = authenticateUser username password
doAuthenticatedWith :: (Credentials -> Task (Maybe User)) (Task a) -> Task a | iTask a
doAuthenticatedWith :: !(Credentials -> Task (Maybe User)) (Task a) -> Task a | iTask a
doAuthenticatedWith verifyCredentials task
= enterInformation ("Log in","Please enter your credentials") []
>>! verifyCredentials
......
implementation module EngineWrapperStandalone
import StdFile, StdInt, StdList, StdChar, StdBool, StdString
import TCPIP, tcp, HTTP, HttpServer, CommandLine, Func
import TCPIP, tcp, HTTP, HttpServer, CommandLine, Func, Util
import Engine, IWorld
import Engine, IWorld, TaskEval
//Wrapper instance for TCP channels with IWorld
instance ChannelEnv IWorld
......@@ -38,7 +38,7 @@ startEngine publishable world
| isNothing mbSDKPath = show sdkpatherror world
//Normal execution
# world = show (running port) world
# options = [HTTPServerOptPort port, HTTPServerOptDebug debug]
# options = [HTTPServerOptPort port, HTTPServerOptDebug debug, HTTPServerOptBackgroundProcess updateOutdated]
# iworld = initIWorld (fromJust mbSDKPath) world
# iworld = http_startServer options (engine publishable) iworld
= finalizeIWorld iworld
......@@ -97,6 +97,18 @@ where
stringOpt key [n,v:r]
| n == key = Just v
= stringOpt key [v:r]
updateOutdated :: !*IWorld -> (!Maybe Timeout, !*IWorld)
updateOutdated iworld
# iworld = updateCurrentDateTime iworld
# (mbMin, iworld) = refreshAllOutdatedInstances iworld
# (curTime, iworld) = currentTimestamp iworld
= (fmap (toTimeout curTime) mbMin, iworld)
where
toTimeout (Timestamp curTime) (Timestamp nextRefresh)
# delta = nextRefresh - curTime
| delta < 0 = 0
| delta > MAX_TIMEOUT/1000 = MAX_TIMEOUT
| otherwise = delta*1000
MAX_TIMEOUT :== 86400000 // one day
\ No newline at end of file
......@@ -6,7 +6,6 @@ import GenUpdate, StdMisc
derive gVerify (,), (,,), (,,,), Void, Either, DateTime, Timestamp, Map, EmailAddress, Action, TreeNode, UserConstraint, ManagementMeta, TaskPriority, Tree
derive gVerify GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapType
import StdDebug
derive JSONEncode UpdateMask, VerifyMask, ErrorMessage
verifyForm :: !a !UpdateMask -> VerifyMask | gVerify{|*|} a
......
......@@ -9,7 +9,7 @@ from Time import :: Timestamp
from TaskState import :: TaskListEntry
from JSON_NG import :: JSONNode
from StdFile import class FileSystem
from SharedDataSource import class registerSDSMsg, class reportSDSChange, class reportSDSChangeFilter
from SharedDataSource import class registerSDSMsg, class reportSDSChange
:: *IWorld = { application :: !String // The name of the application
, build :: !String // The date/time identifier of the application's build
......@@ -32,8 +32,9 @@ from SharedDataSource import class registerSDSMsg, class reportSDSChange, class
, world :: !*World // The outside world
}
updateCurrentDateTime :: !*IWorld -> *IWorld
instance FileSystem IWorld
instance registerSDSMsg InstanceNo IWorld
instance reportSDSChange IWorld
instance reportSDSChangeFilter InstanceNo IWorld
\ No newline at end of file
instance reportSDSChange InstanceNo IWorld
\ No newline at end of file
......@@ -11,8 +11,14 @@ from JSON_NG import :: JSONNode
from StdFile import class FileSystem(..)
from StdFile import instance FileSystem World
from SharedDataSource import class registerSDSMsg, class reportSDSChange, class reportSDSChangeFilter
import TaskStore
from SharedDataSource import class registerSDSMsg, class reportSDSChange
import TaskStore, Time, Util
updateCurrentDateTime :: !*IWorld -> *IWorld
updateCurrentDateTime iworld=:{IWorld|world}
# (dt,world) = currentDateTimeWorld world
# (timestamp,world) = time world
= {IWorld|iworld & currentDateTime = dt, timestamp = timestamp, world = world}
//Wrapper instance for file access
instance FileSystem IWorld
......@@ -32,13 +38,10 @@ where
instance registerSDSMsg InstanceNo IWorld
where
registerSDSMsg shareId instanceNo iworld = addShareRegistration shareId instanceNo iworld
instance reportSDSChange IWorld
where
reportSDSChange shareId iworld = addOutdatedOnShareChange shareId iworld
registerDependency shareId instanceNo iworld = addShareRegistration shareId instanceNo iworld
registerTimedMsg timestamp instanceNo iworld = addOutdatedInstances [(instanceNo, Just timestamp)] iworld
instance reportSDSChangeFilter InstanceNo IWorld
instance reportSDSChange InstanceNo IWorld
where
reportSDSChangeFilter shareId filterFun iworld //TODO
= addOutdatedOnShareChange shareId iworld
\ No newline at end of file
reportSDSChange shareId filterFun iworld
= addOutdatedOnShareChange shareId filterFun iworld
\ No newline at end of file
definition module Shared
import IWorld, Void, Error
from SharedDataSource import :: RWShared, :: Hash, null, ::ROShared, :: WOShared, mapRead, mapWrite, mapReadWrite, mapReadError, mapWriteError, mapReadWriteError, toReadOnly, >+<, >+|, |+<, |+|, createChangeOnWriteSDS, createReadOnlySDS, createReadOnlySDSError
from SharedDataSource import :: RWShared, :: Hash, null, ::ROShared, :: WOShared, mapRead, mapWrite, mapReadWrite, mapReadError, mapWriteError, mapReadWriteError, toReadOnly, >+<, >+|, |+<, |+|
from SharedDataSource import createChangeOnWriteSDS, createReadOnlySDS, createReadOnlySDSError, createReadOnlySDSPredictable, createReadOnlySDSErrorPredictable
:: ReadWriteShared r w :== RWShared r w IWorld
:: Shared a :== ReadWriteShared a a
......
......@@ -68,16 +68,16 @@ exception :: !e -> TaskResult a | TC, toString e
/**
* Determine the layout function for a rep target
*/
repLayout :: TaskRepOpts -> Layout
repLayout :: !TaskRepOpts -> Layout
/**
* Determine what function to apply after a layout has been done
*/
afterLayout :: TaskRepOpts -> (UIDef -> UIDef)
afterLayout :: !TaskRepOpts -> (UIDef -> UIDef)
/**
* Apply the final layout if necessary
*/
finalizeRep :: TaskRepOpts TaskRep -> TaskRep
finalizeRep :: !TaskRepOpts !TaskRep -> TaskRep
/**
* Create a task that finishes instantly
......
......@@ -62,13 +62,13 @@ gPutRecordFields{|Task|} _ t _ fields = (t,fields)
exception :: !e -> TaskResult a | TC, toString e
exception e = ExceptionResult (dynamic e) (toString e)
repLayout :: TaskRepOpts -> Layout
repLayout :: !TaskRepOpts -> Layout
repLayout {TaskRepOpts|useLayout,modLayout} = (fromMaybe id modLayout) (fromMaybe autoLayout useLayout)
afterLayout :: TaskRepOpts -> (UIDef -> UIDef)
afterLayout :: !TaskRepOpts -> (UIDef -> UIDef)
afterLayout {TaskRepOpts|afterLayout} = fromMaybe id afterLayout
finalizeRep :: TaskRepOpts TaskRep -> TaskRep
finalizeRep :: !TaskRepOpts !TaskRep -> TaskRep
finalizeRep repOpts=:{TaskRepOpts|appFinalLayout=True} rep=:(TaskRep def parts) = TaskRep (UIFinal ((repLayout repOpts).Layout.final def)) parts
finalizeRep repOpts rep = rep
......
......@@ -64,6 +64,15 @@ evalSessionInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskRe
*/
createPersistentInstance :: !(Task a) !ManagementMeta !User !InstanceNo !*IWorld -> (!TaskId, !*IWorld) | iTask a
/**
* Evaluate all tasks marked as outdated in the task pool
* @param The IWorld state
*
* @return The moment of time when the next instance can predicated to be outdated
* @return The IWorld state
*/
refreshAllOutdatedInstances :: !*IWorld -> (!Maybe Timestamp, !*IWorld)
//Helper functions that provide access to shares and parallel task lists
localShare :: !TaskId -> Shared a | iTask a
topListShare :: SharedTaskList a
......
......@@ -2,7 +2,7 @@ implementation module TaskEval
import StdList, StdBool
import Error
import SystemTypes, IWorld, Shared, Task, TaskState, TaskStore, Util
import SystemTypes, IWorld, Shared, Task, TaskState, TaskStore, Util, Func
import LayoutCombinators
from CoreCombinators import :: ParallelTaskType(..), :: ParallelTask(..)
......@@ -12,7 +12,7 @@ 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,observers=[],management=mmeta,progress=pmeta}
# 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 ('Map'.newMap, [(stringDisplay "This task has not been evaluated yet.",'Map'.newMap)],Vertical,[])) [])
......@@ -32,7 +32,7 @@ createSessionInstance task event iworld=:{currentDateTime}
# ((meta,reduct,result,_), iworld)
= createTaskInstance instanceId (Just sessionId) 0 (Just worker) task noMeta {issuedAt=currentDateTime,issuedBy=worker,status=Unstable,firstEvent=Nothing,latestEvent=Nothing} iworld
# (mbRes,iworld) = evalAndStoreInstance True event (meta,reduct,result) iworld
# iworld = refreshOutdatedInstances iworld
# iworld = refreshOutdatedInstances meta.observes iworld
= case loadSessionInstance sessionId iworld of
(Ok (meta,reduct,result),iworld)
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
......@@ -52,23 +52,16 @@ evalSessionInstance sessionId event iworld
# iworld = case event of
RefreshEvent = refreshSessionInstance sessionId iworld
_ = processEvent event iworld
//Refresh affected tasks
# iworld = refreshOutdatedInstances iworld
//Evaluate session instance
# (mbInstance,iworld) = loadSessionInstance sessionId iworld
= case mbInstance of
Error e = (Error e, iworld)
Ok (meta,reduct,result)
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
# iworld = remOutdatedInstance meta.TIMeta.instanceNo iworld
//Refresh affected tasks
# iworld = refreshOutdatedInstances meta.observes iworld
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
= case mbRes of
Ok result = (Ok (result, meta.TIMeta.instanceNo, sessionId), iworld)
Error e = (Error e, iworld)
where
updateCurrentDateTime :: !*IWorld -> *IWorld
updateCurrentDateTime iworld=:{IWorld|world}
# (dt,world) = currentDateTimeWorld world
= {IWorld|iworld & currentDateTime = dt, world = world}
Ok result = (Ok (result, meta.TIMeta.instanceNo, sessionId), iworld)
processEvent :: !Event !*IWorld -> *IWorld
processEvent RefreshEvent iworld = iworld
......@@ -102,7 +95,7 @@ evalAndStoreInstance isSession event (meta=:{TIMeta|instanceNo,parent,worker=Jus
//Update current process id & eval stack in iworld
# taskId = TaskId instanceNo 0
# iworld = {iworld & currentInstance = instanceNo, currentUser = worker, nextTaskNo = curNextTaskNo, taskTime = nextTaskTime, localShares = shares, localLists = lists}
//Clear the instance's registrations for share changes & remove from outdated queue
//Clear the instance's registrations for share changes
# iworld = clearShareRegistrations instanceNo iworld
# iworld = remOutdatedInstance instanceNo iworld
//Apply task's eval function and take updated nextTaskId from iworld
......@@ -113,13 +106,18 @@ evalAndStoreInstance isSession event (meta=:{TIMeta|instanceNo,parent,worker=Jus
//Restore current process id, nextTask id and local shares in iworld
# iworld = {iworld & currentInstance = currentInstance, currentUser = currentUser, nextTaskNo = nextTaskNo, taskTime = taskTime, localShares = localShares, localLists = localLists}
# reduct = {TIReduct|reduct & nextTaskNo = updNextTaskNo, nextTaskTime = nextTaskTime + 1, tree = tasktree result, shares = shares, lists = lists}
//Load possibly changed meta
# (meta, iworld) = case loadTaskMeta instanceNo iworld of
(Ok meta, iworld) = (meta, iworld)
(_, iworld) = (meta, iworld)
# meta = {TIMeta|meta & progress = setStatus result progress}
# inst = (meta,reduct,taskres result,taskrep result)
//Store the instance
# iworld = storeTaskInstance inst iworld
//If the result has a new value, mark the parent process as outdated
//If the result has a new value, mark the parent & observing processes as outdated
| parent > 0 && isChanged val result
# iworld = addOutdatedInstances [parent] iworld
# iworld = addOutdatedInstances [(parent, Nothing)] iworld
# iworld = addOutdatedInstances [(i, Nothing) \\ i <- meta.observedBy] iworld
= (Ok result, iworld)
| otherwise
= (Ok result, iworld)
......@@ -149,19 +147,33 @@ evalAndStoreInstance _ _ (_,_,TIException e msg) iworld
evalAndStoreInstance _ _ _ iworld
= (Ok (exception "Could not unpack instance state"), iworld)
//Evaluate tasks marked as outdated in the task pool
refreshOutdatedInstances :: !*IWorld -> *IWorld
refreshOutdatedInstances iworld = refresh [] iworld
//Evaluate given tasks if marked as outdated in the task pool
refreshOutdatedInstances :: ![InstanceNo] !*IWorld -> *IWorld
refreshOutdatedInstances [] iworld = iworld
refreshOutdatedInstances instances iworld = seqSt refresh instances iworld
where
refresh done iworld = case nextOutdatedInstance iworld of
(Nothing,iworld) = iworld
(Just next,iworld)
| isMember next done = iworld
= refresh [next:done] (refreshInstance next iworld)
refresh instanceNo iworld
# (outdChildren, iworld) = getTaskInstanceObserved instanceNo iworld
# iworld = refreshOutdatedInstances outdChildren iworld
# (outdated, iworld) = checkAndRemOutdatedInstance instanceNo iworld
| outdated = refreshInstance instanceNo iworld
| otherwise = iworld
//Evaluate all tasks marked as outdated in the task pool
refreshAllOutdatedInstances :: !*IWorld -> (!Maybe Timestamp, !*IWorld)
refreshAllOutdatedInstances iworld
# (outdated, iworld) = getOutdatedInstances iworld
# iworld = refresh outdated [] iworld
= getMinOutdatedTimestamp iworld
where
refresh [] _ iworld = iworld
refresh [outd:outds] done iworld
| isMember outd done = iworld
= refresh outds [outd:done] (refreshInstance outd iworld)
//Evaluate a task instance without any events
refreshInstance :: !InstanceNo !*IWorld -> *IWorld
refreshInstance instanceNo iworld
refreshInstance instanceNo iworld=:{currentDateTime}
= case loadTaskInstance instanceNo iworld of
(Error _,iworld) = iworld
(Ok (meta,reduct,result),iworld)
......@@ -218,10 +230,10 @@ where
//Top list share has no items, and is therefore completely polymorphic
topListShare :: SharedTaskList a
topListShare = createReadOnlySDSError read
topListShare = createReadOnlySDS read
where
read iworld
= (Ok {TaskList|listId = TopLevelTaskList, items = []}, iworld)
= ({TaskList|listId = TopLevelTaskList, items = []}, iworld)
parListShare :: !TaskId -> SharedTaskList a | iTask a
parListShare taskId=:(TaskId instanceNo taskNo) = createReadOnlySDSError read
......
......@@ -16,7 +16,8 @@ derive JSONDecode TIMeta, TIReduct, TIResult, TaskTree
{ instanceNo :: !InstanceNo //Unique global identification
, sessionId :: !Maybe SessionId //zero for top-level instances, instance that detached this one otherwise
, parent :: !InstanceNo
, observers :: ![InstanceNo] //List of instances that may be affected by changes in this instance
, observes :: ![InstanceNo] //List of instances that this instance observes (using workOn)
, observedBy :: ![InstanceNo] //List of instances that may be affected by changes in this instance
, worker :: !Maybe User //Identity of the user working on this instance (this determines the value of the currentUser share)
, progress :: !ProgressMeta
, management :: !ManagementMeta
......
......@@ -42,19 +42,28 @@ 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
setTaskWorker :: !User !InstanceNo !*IWorld -> *IWorld
addTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
//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] !*IWorld -> *IWorld
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
remOutdatedInstance :: !InstanceNo !*IWorld -> *IWorld
//check and remove if outdated (timed entries may remain)
checkAndRemOutdatedInstance :: !InstanceNo !*IWorld -> (Bool, !*IWorld)
nextOutdatedInstance :: !*IWorld -> (!Maybe InstanceNo,!*IWorld)
getOutdatedInstances :: !*IWorld -> (![InstanceNo], !*IWorld)
getMinOutdatedTimestamp :: !*IWorld -> (!Maybe Timestamp, !*IWorld)
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
clearShareRegistrations :: !InstanceNo !*IWorld -> *IWorld
addOutdatedOnShareChange :: !BasicShareId !*IWorld -> *IWorld
addOutdatedOnShareChange :: !BasicShareId !(InstanceNo -> Bool) !*IWorld -> *IWorld
//Keep last version of session user interfaces around, to be able to send differences to client
storeCurUI :: !SessionId !Int !UIDef !*IWorld -> *IWorld
......
......@@ -2,7 +2,7 @@ implementation module TaskStore
import StdEnv, Maybe
import IWorld, TaskState, Task, Store, Util, Text, Time, Random, JSON_NG, UIDefinition, Map
import IWorld, TaskState, Task, Store, Util, Text, Time, Random, JSON_NG, UIDefinition, Map, Func, Tuple
import SharedDataSource
import SerializationGraphCopy //TODO: Make switchable from within iTasks module
......@@ -156,10 +156,9 @@ updateTaskInstanceMeta :: !InstanceNo !(TIMeta -> TIMeta) !*IWorld -> *IWorld
updateTaskInstanceMeta instanceNo f iworld
= case loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld of
(Nothing,iworld) = iworld
(Just meta,iworld)
(Just meta,iworld)
# iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) (f meta) iworld
# iworld = addOutdatedInstances [instanceNo] iworld
= iworld
= addOutdatedInstances [(instanceNo, Nothing)] iworld
setTaskWorker :: !User !InstanceNo !*IWorld -> *IWorld
setTaskWorker worker instanceNo iworld
......@@ -169,23 +168,72 @@ where
set _ inst = inst
addTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld
addTaskInstanceObserver observer instanceNo iworld
= updateTaskInstanceMeta instanceNo (add observer) 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)