Commit 2871cf39 authored by Steffen Michels's avatar Steffen Michels
Browse files

replaced outdated task registration by more general work queue & added support for polling SDS

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2231 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 77a938e5
......@@ -7,6 +7,8 @@ from StdFunc import o, seq
from IWorld import :: IWorld(..)
from Util import qualified currentDate, currentTime, currentDateTime, currentTimestamp, dateToTimestamp
SYSTEM_DATA_NS :== "SystemData"
sharedStore :: !String !a -> Shared a | JSONEncode{|*|}, JSONDecode{|*|}, TC a
sharedStore storeId defaultV = createChangeOnWriteSDS
"sharedStore" storeId
......@@ -23,7 +25,7 @@ where
write v iworld = (Ok Void,storeValue NS_APPLICATION_SHARES storeId v iworld)
currentDateTime :: ReadOnlyShared DateTime
currentDateTime = createReadOnlySDSPredictable read
currentDateTime = createReadOnlySDSPredictable SYSTEM_DATA_NS "currentDateTime" read
where
read iworld
# (dateTime, iworld) = 'Util'.currentDateTime iworld
......@@ -31,7 +33,7 @@ where
= ((dateTime, Timestamp (ts + 1)), iworld)
currentTime :: ReadOnlyShared Time
currentTime = createReadOnlySDSPredictable read
currentTime = createReadOnlySDSPredictable SYSTEM_DATA_NS "currentTime" read
where
read iworld
# (time, iworld) = 'Util'.currentTime iworld
......@@ -39,7 +41,7 @@ where
= ((time, Timestamp (ts + 1)), iworld)
currentDate :: ReadOnlyShared Date
currentDate = createReadOnlySDSPredictable read
currentDate = createReadOnlySDSPredictable SYSTEM_DATA_NS "currentDate" read
where
read iworld
# (DateTime date time, iworld) = 'Util'.currentDateTime iworld
......@@ -109,22 +111,35 @@ where
# (Clock seed, world) = clock world
= (hd (genRandInt seed), {IWorld|iworld & world = world})
EXTERNAL_FILE_POLLING_RATE :== 10
externalFile :: !FilePath -> Shared String
externalFile path = createChangeOnWriteSDS "externalFile" path read write
externalFile path = createPollingSDS "externalFile" path read write
where
read iworld=:{world}
# (ok,file,world) = fopen path FReadData world
| not ok = (Ok "", {IWorld|iworld & world = world}) // empty string if file doesn't exist
# (res,file) = readAll file
# (ok,world) = fclose file world
| not ok = (Error (toString CannotClose) ,{IWorld|iworld & world = world})
| isError res = (Error (toString (fromError res)) ,{IWorld|iworld & world = world})
read iworld
# (Timestamp ts, iworld) = 'Util'.currentTimestamp iworld
# (res, iworld) = read` iworld
= (fmap (\r -> (r, Timestamp (ts + EXTERNAL_FILE_POLLING_RATE), checkF r)) res, iworld)
read` iworld=:{world}
# (ok,file,world) = fopen path FReadData iworld.world
| not ok = (Ok "", {IWorld|iworld & world = world}) // empty string if file doesn't exist
# (res,file) = readAll file
# (ok,world) = fclose file world
| not ok = (Error (toString CannotClose) ,{IWorld|iworld & world = world})
| isError res = (Error (toString (fromError res)) ,{IWorld|iworld & world = world})
= (Ok (fromOk res), {IWorld|iworld & world = world})
checkF old iworld
# (res,iworld)= read` iworld
| isOk res && (fromOk res) <> old = (Changed, iworld)
# (Timestamp ts, iworld) = 'Util'.currentTimestamp iworld
= (CheckAgain (Timestamp (ts + EXTERNAL_FILE_POLLING_RATE)), iworld)
write content iworld=:{world}
# (ok,file,world) = fopen path FWriteText world
| not ok = (Error (toString CannotOpen), {IWorld|iworld & world = world})
# file = fwrites content file
# (ok,world) = fclose file world
| not ok = (Error (toString CannotClose) ,{IWorld|iworld & world = world})
# (ok,file,world) = fopen path FWriteText world
| not ok = (Error (toString CannotOpen), {IWorld|iworld & world = world})
# file = fwrites content file
# (ok,world) = fclose file world
| not ok = (Error (toString CannotClose) ,{IWorld|iworld & world = world})
= (Ok Void, {IWorld|iworld & world = world})
\ No newline at end of file
......@@ -55,9 +55,9 @@ initIWorld sdkPath world
,localShares = newMap
,localLists = newMap
,readShares = []
,outdated = False
,sessions = newMap
,uis = newMap
,workQueue = []
,world = world
}
where
......
......@@ -13,13 +13,15 @@ where
= appSnd finalizeCGIIWorld (f req (initCGIIWorld path world))
initCGIIWorld path world
//Load previous session user interfaces from disk
//Load previous session user interfaces & outdated instancesc information from disk
//(normally these are only kept in-memory)
# iworld = initIWorld path world
# iworld = restoreUICache iworld
# iworld = initIWorld path world
# iworld = restoreUICache iworld
# iworld = restoreWorkQueue iworld
= iworld
finalizeCGIIWorld iworld
//Store the session user interfaces
# iworld = saveUICache iworld
# iworld = saveWorkQueue iworld
= finalizeIWorld iworld
implementation module EngineWrapperStandalone
import StdFile, StdInt, StdList, StdChar, StdBool, StdString
import StdFile, StdInt, StdList, StdChar, StdBool, StdString, StdFunc
import TCPIP, tcp, HTTP, HttpServer, CommandLine, Func, Util
import Engine, IWorld, TaskEval
import Engine, IWorld, TaskEval, TaskStore
//Wrapper instance for TCP channels with IWorld
instance ChannelEnv IWorld
......@@ -38,8 +38,11 @@ startEngine publishable world
| isNothing mbSDKPath = show sdkpatherror world
//Normal execution
# world = show (running port) world
# options = [HTTPServerOptPort port, HTTPServerOptDebug debug, HTTPServerOptBackgroundProcess updateOutdated]
# options = [HTTPServerOptPort port, HTTPServerOptDebug debug, HTTPServerOptBackgroundProcess doWork]
# iworld = initIWorld (fromJust mbSDKPath) world
// mark all instance as outdated initially
# (maxNo,iworld) = maxInstanceNo iworld
# iworld = addOutdatedInstances [(instanceNo, Nothing) \\ instanceNo <- [1..maxNo]] iworld
# iworld = http_startServer options (engine publishable) iworld
= finalizeIWorld iworld
where
......@@ -98,17 +101,31 @@ where
| n == key = Just v
= stringOpt key [v:r]
updateOutdated :: !*IWorld -> (!Maybe Timeout, !*IWorld)
updateOutdated iworld
doWork :: !*IWorld -> (!Maybe Timeout, !*IWorld)
doWork 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
# (mbWork, iworld) = dequeueWork iworld
= case mbWork of
Empty
= (Nothing, iworld)
Work work
# iworld = case work of
(Evaluate instanceNo) = refreshInstance instanceNo iworld
(TriggerSDSChange sdsId) = addOutdatedOnShareChange sdsId (const True) iworld
(CheckSDS sdsId hash checkF)
# (checkRes,iworld) = checkF iworld
= case checkRes of
Changed = addOutdatedOnShareChange sdsId (const True) iworld
(CheckAgain time) = queueWork (CheckSDS sdsId hash checkF, Just time) iworld
= (Just 0, iworld) // give http server the chance to handle request
WorkAt time
# (curTime, iworld) = currentTimestamp iworld
= (Just (toTimeout curTime time), iworld)
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
......@@ -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
from SharedDataSource import class registerSDSDependency, class registerSDSChangeDetection, class reportSDSChange, :: CheckRes(..), :: BasicShareId, :: Hash
:: *IWorld = { application :: !String // The name of the application
, build :: !String // The date/time identifier of the application's build
......@@ -26,15 +26,30 @@ from SharedDataSource import class registerSDSMsg, class reportSDSChange
, localShares :: !Map TaskId JSONNode // The set of locally shared values
, localLists :: !Map TaskId [TaskListEntry] // The set of local parallel task lists
, readShares :: ![String] // The IDs of shares from which was read
, outdated :: !Bool // Flag that is set when an internal inconsistenty is detected
, sessions :: !Map SessionId InstanceNo // Index of sessions to instance numbers
, uis :: !Map SessionId (!Int,!UIDef) // Previous ui versions to optimize output sent to clients
, workQueue :: ![(!Work,!Maybe Timestamp)]
, world :: !*World // The outside world
}
updateCurrentDateTime :: !*IWorld -> *IWorld
queueWork :: !(!Work, !Maybe Timestamp) !*IWorld -> *IWorld
dequeueWork :: !*IWorld -> (!DequeueResult, !*IWorld)
dequeueWorkFilter :: !(Work -> Bool) !*IWorld -> (![Work], !*IWorld)
:: DequeueResult = Empty | Work !Work | WorkAt !Timestamp
:: Work = Evaluate !InstanceNo
| TriggerSDSChange !BasicShareId
| CheckSDS !BasicShareId !Hash (*IWorld -> *(!CheckRes, !*IWorld))
instance FileSystem IWorld
instance registerSDSMsg InstanceNo IWorld
instance reportSDSChange InstanceNo IWorld
\ No newline at end of file
instance registerSDSDependency InstanceNo IWorld
instance registerSDSChangeDetection IWorld
instance reportSDSChange InstanceNo IWorld
//Sync work queue to disk (Only used with CGI wrapper)
saveWorkQueue :: !*IWorld -> *IWorld
restoreWorkQueue :: !*IWorld -> *IWorld
\ No newline at end of file
......@@ -10,9 +10,10 @@ from JSON_NG import :: JSONNode
from StdFile import class FileSystem(..)
from StdFile import instance FileSystem World
from SharedDataSource import class registerSDSMsg, class reportSDSChange
import TaskStore, Time, Util
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
updateCurrentDateTime :: !*IWorld -> *IWorld
updateCurrentDateTime iworld=:{IWorld|world}
......@@ -20,6 +21,52 @@ updateCurrentDateTime iworld=:{IWorld|world}
# (timestamp,world) = time world
= {IWorld|iworld & currentDateTime = dt, timestamp = timestamp, world = world}
queueWork :: !(!Work, !Maybe Timestamp) !*IWorld -> *IWorld
queueWork newWork iworld=:{workQueue}
= {iworld & workQueue = queue newWork workQueue}
where
queue newWork [] = [newWork]
queue newWorkTs=:(newWork,mbNewTimestamp) [workTs=:(work,mbTimestamp):qs]
| newWork == work = [(work,minTs mbNewTimestamp mbTimestamp):qs]
| otherwise = [workTs:queue newWorkTs qs]
minTs Nothing _ = Nothing
minTs _ Nothing = Nothing
minTs (Just x) (Just y) = Just (min x y)
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
(==) _ _ = False
dequeueWork :: !*IWorld -> (!DequeueResult, !*IWorld)
dequeueWork iworld=:{workQueue}
| isEmpty workQueue = (Empty, iworld)
# (curTime, iworld) = currentTimestamp iworld
# (res, workQueue) = getFirst curTime Nothing workQueue
= (res, {iworld & workQueue = workQueue})
where
getFirst _ mbMin [] = (maybe Empty WorkAt mbMin,[])
getFirst curTime mbMin [(w,mbTime):ws] = case mbTime of
Nothing
= (Work w,ws)
Just time | curTime >= time
= (Work w,ws)
Just time
# (mbWork,ws) = getFirst curTime (Just (maybe time (min time) mbMin)) ws
= (mbWork,[(w,mbTime):ws])
dequeueWorkFilter :: !(Work -> Bool) !*IWorld -> (![Work], !*IWorld)
dequeueWorkFilter filter iworld=:{workQueue}
# (curTime, iworld) = currentTimestamp iworld
# (result,workQueue) = splitWith (filter` curTime) workQueue
= (map fst result, {iworld & workQueue = workQueue})
where
filter` _ (work,Nothing) = filter work
filter` curTime (work,Just time) = curTime >= time && filter work
//Wrapper instance for file access
instance FileSystem IWorld
where
......@@ -36,12 +83,33 @@ where
# (ok,file,world) = sfopen filename mode world
= (ok,file,{IWorld|iworld & world = world})
instance registerSDSMsg InstanceNo IWorld
instance registerSDSDependency InstanceNo IWorld
where
registerSDSDependency sdsId instanceNo iworld
= addShareRegistration sdsId instanceNo iworld
instance registerSDSChangeDetection IWorld
where
registerDependency shareId instanceNo iworld = addShareRegistration shareId instanceNo iworld
registerTimedMsg timestamp instanceNo iworld = addOutdatedInstances [(instanceNo, Just timestamp)] iworld
registerSDSPredictableChange timestamp sdsId iworld
= queueWork (TriggerSDSChange sdsId, Just timestamp) iworld
registerSDSCheckForChange timestamp hash checkF sdsId iworld
= queueWork (CheckSDS sdsId hash checkF, Just timestamp) iworld
instance reportSDSChange InstanceNo IWorld
where
reportSDSChange shareId filterFun iworld
= addOutdatedOnShareChange shareId filterFun iworld
\ No newline at end of file
= addOutdatedOnShareChange shareId filterFun iworld
// serialise Work as dynamic since it contains functions on unique states
JSONEncode{|Work|} work = [JSONArray [JSONString "_FUNCTION_", JSONString (base64URLEncode (serialize work))]]
JSONDecode{|Work|} [JSONArray [JSONString "_FUNCTION_",JSONString string]:c] = (Just (fromOk(deserialize {s` \\ s` <-: base64URLDecode string})) ,c)
WORKQUEUE_INDEX :== "workqueue-index"
saveWorkQueue :: !*IWorld -> *IWorld
saveWorkQueue iworld=:{workQueue} = storeValue NS_TASK_INSTANCES WORKQUEUE_INDEX workQueue iworld
restoreWorkQueue :: !*IWorld -> *IWorld
restoreWorkQueue iworld
# (mbWorkQueue,iworld) = loadValue NS_TASK_INSTANCES WORKQUEUE_INDEX iworld
= {iworld & workQueue = fromMaybe [] mbWorkQueue}
\ 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, >+<, >+|, |+<, |+|
from SharedDataSource import createChangeOnWriteSDS, createReadOnlySDS, createReadOnlySDSError, createReadOnlySDSPredictable, createReadOnlySDSErrorPredictable
from SharedDataSource import :: RWShared, null, ::ROShared, :: WOShared, mapRead, mapWrite, mapReadWrite, mapReadError, mapWriteError, mapReadWriteError, toReadOnly, >+<, >+|, |+<, |+|
from SharedDataSource import createChangeOnWriteSDS, createPollingSDS, createReadOnlySDS, createReadOnlySDSError, createReadOnlySDSPredictable, createReadOnlySDSErrorPredictable
:: ReadWriteShared r w :== RWShared r w IWorld
:: Shared a :== ReadWriteShared a a
......
......@@ -2,7 +2,7 @@ implementation module Store
import StdString, StdArray, StdChar, StdClass, StdInt, StdBool, StdFile, StdList, StdTuple, StdOrdList, StdMisc, Void
import File, Directory, OSError, Maybe, Map, Text, JSON_NG, Functor, FilePath
from IWorld import :: IWorld(..)
from IWorld import :: IWorld(..), :: Work
from SystemTypes import :: DateTime, :: User, :: Config, :: TaskId, :: TaskNo, :: InstanceNo, :: TaskListItem, :: TaskTime, :: SessionId
from UIDefinition import :: UIDef, :: UIControl
from TaskState import :: TaskListEntry
......
......@@ -64,14 +64,8 @@ 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)
//Evaluate a task instance without any events
refreshInstance :: !InstanceNo !*IWorld -> *IWorld
//Helper functions that provide access to shares and parallel task lists
localShare :: !TaskId -> Shared a | iTask a
......
......@@ -32,7 +32,6 @@ 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 meta.observes iworld
= case loadSessionInstance sessionId iworld of
(Ok (meta,reduct,result),iworld)
# (mbRes,iworld) = evalAndStoreInstance True RefreshEvent (meta,reduct,result) iworld
......@@ -58,7 +57,7 @@ evalSessionInstance sessionId event iworld
Error e = (Error e, iworld)
Ok (meta,reduct,result)
//Refresh affected tasks
# iworld = refreshOutdatedInstances meta.observes iworld
# 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)
......@@ -97,7 +96,6 @@ evalAndStoreInstance isSession event (meta=:{TIMeta|instanceNo,parent,worker=Jus
# iworld = {iworld & currentInstance = instanceNo, currentUser = worker, nextTaskNo = curNextTaskNo, taskTime = nextTaskTime, localShares = shares, localLists = lists}
//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
# (result,iworld) = eval event repAs tree iworld
# (updNextTaskNo,iworld) = getNextTaskNo iworld
......@@ -115,9 +113,9 @@ evalAndStoreInstance isSession event (meta=:{TIMeta|instanceNo,parent,worker=Jus
//Store the instance
# iworld = storeTaskInstance inst iworld
//If the result has a new value, mark the parent & observing processes as outdated
# iworld = addOutdatedInstances [(i, Nothing) \\ i <- meta.observedBy] iworld
| parent > 0 && isChanged val result
# iworld = addOutdatedInstances [(parent, Nothing)] iworld
# iworld = addOutdatedInstances [(i, Nothing) \\ i <- meta.observedBy] iworld
# iworld = addOutdatedInstances [(parent, Nothing)] iworld
= (Ok result, iworld)
| otherwise
= (Ok result, iworld)
......@@ -146,31 +144,7 @@ evalAndStoreInstance _ _ (_,_,TIException e msg) iworld
= (Ok (ExceptionResult e msg), iworld)
evalAndStoreInstance _ _ _ iworld
= (Ok (exception "Could not unpack instance state"), 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 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=:{currentDateTime}
......@@ -180,6 +154,17 @@ refreshInstance instanceNo iworld=:{currentDateTime}
# (_,iworld) = evalAndStoreInstance False RefreshEvent (meta,reduct,result) iworld
= iworld
//Evaluate given tasks if marked as outdated in the task pool
refreshInstancesIfOutdated :: ![InstanceNo] !*IWorld -> *IWorld
refreshInstancesIfOutdated instances iworld
# iworld = seqSt refreshChildren instances iworld
# (work,iworld) = dequeueWorkFilter (\w -> case w of (Evaluate instanceNo) = isMember instanceNo instances; _ = False) iworld
= seqSt refreshInstance [instanceNo \\ Evaluate instanceNo <- work] iworld
where
refreshChildren instanceNo iworld
# (children, iworld) = getTaskInstanceObserved instanceNo iworld
= refreshInstancesIfOutdated children iworld
refreshSessionInstance :: !SessionId !*IWorld -> *IWorld
refreshSessionInstance sessionId iworld
= case loadSessionInstance sessionId iworld of
......
......@@ -12,6 +12,7 @@ from SharedDataSource import :: BasicShareId
newSessionId :: !*IWorld -> (!SessionId, !*IWorld)
newInstanceId :: !*IWorld -> (!InstanceNo, !*IWorld)
maxInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
newDocumentId :: !*IWorld -> (!DocumentId, !*IWorld)
storeTaskInstance :: !TaskInstance !*IWorld -> *IWorld
......@@ -54,12 +55,6 @@ getTaskInstanceObservers :: !InstanceNo !*IWorld -> (![InstanceNo], !*IWorld)
//Keep track of outdated task instances that need to be refreshed
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
remOutdatedInstance :: !InstanceNo !*IWorld -> *IWorld
//check and remove if outdated (timed entries may remain)
checkAndRemOutdatedInstance :: !InstanceNo !*IWorld -> (Bool, !*IWorld)
getOutdatedInstances :: !*IWorld -> (![InstanceNo], !*IWorld)
getMinOutdatedTimestamp :: !*IWorld -> (!Maybe Timestamp, !*IWorld)
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
clearShareRegistrations :: !InstanceNo !*IWorld -> *IWorld
......@@ -70,6 +65,5 @@ storeCurUI :: !SessionId !Int !UIDef !*IWorld -> *IWorld
loadPrevUI :: !SessionId !Int !*IWorld -> (!Maybe UIDef, !*IWorld)
//Sync previous user interfaces to disk (Only used with CGI wrapper)
saveUICache :: !*IWorld -> *IWorld
restoreUICache :: !*IWorld -> *IWorld
saveUICache :: !*IWorld -> *IWorld
restoreUICache :: !*IWorld -> *IWorld
\ No newline at end of file
......@@ -21,7 +21,6 @@ derive JSONDecode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSize
INCREMENT :== "increment"
PERSISTENT_INDEX :== "persistent-index"
OUTDATED_INDEX :== "outdated-index"
SHARE_REGISTRATIONS :== "share-registrations"
meta_store t = toString t +++ "-meta"
......@@ -43,7 +42,14 @@ newInstanceId iworld
= (tid,iworld)
Nothing
# iworld = storeValue NS_TASK_INSTANCES INCREMENT 2 iworld //store the next value (2)
= (1,iworld) //return the first value (1)
= (1,iworld) //return the first value (1)
maxInstanceNo :: !*IWorld -> (!InstanceNo, !*IWorld)
maxInstanceNo iworld
# (mbNewTid,iworld) = loadValue NS_TASK_INSTANCES INCREMENT iworld
= case mbNewTid of
Just tid = (tid-1,iworld)
Nothing = (0,iworld)
newDocumentId :: !*IWorld -> (!DocumentId, !*IWorld)
newDocumentId iworld=:{world,timestamp}
......@@ -190,50 +196,7 @@ getTaskInstanceObservers instanceNo iworld = case loadTaskMeta instanceNo iworld
(_, iworld) = ([], iworld)
addOutdatedInstances :: ![(!InstanceNo, !Maybe Timestamp)] !*IWorld -> *IWorld
addOutdatedInstances [] iworld = iworld
addOutdatedInstances outdated iworld
# (outdParents, iworld) = mapSt (\(instanceNo,mbTimestamp) iworld -> appFst (map (\parent -> (parent,mbTimestamp))) (getTaskInstanceObservers instanceNo iworld)) outdated iworld
# iworld = addOutdatedInstances (flatten outdParents) iworld
= updateOutdatedInstanceIndex (removeDup o ((++) outdated)) iworld
remOutdatedInstance :: !InstanceNo !*IWorld -> *IWorld
remOutdatedInstance rem iworld
= updateOutdatedInstanceIndex (filter (\(i,_) -> i <> rem)) iworld
checkAndRemOutdatedInstance :: !InstanceNo !*IWorld -> (Bool, !*IWorld)
checkAndRemOutdatedInstance check iworld
# (curTime, iworld) = currentTimestamp iworld
# (outdated,iworld) = checkOutdatedInstanceIndex (\outd -> not (isEmpty (filter (\(i,mbT) -> i == check && (isNothing mbT || (fromJust mbT) <= curTime)) outd))) iworld
| outdated = (True, remOutdatedInstance check iworld)
| otherwise = (False, iworld)
getOutdatedInstances :: !*IWorld -> (![InstanceNo], !*IWorld)
getOutdatedInstances iworld
# (mbOutdated, iworld) = loadValue NS_TASK_INSTANCES OUTDATED_INDEX iworld
= case mbOutdated of
Just outdated
# (curTime, world) = time iworld.world
# iworld = {iworld & world = world}
= ([instanceNo \\ (instanceNo, mbTimestamp) <- outdated | isNothing mbTimestamp || (fromJust mbTimestamp) <= curTime], iworld)
Nothing
= ([], iworld)
getMinOutdatedTimestamp :: !*IWorld -> (!Maybe Timestamp, !*IWorld)
getMinOutdatedTimestamp iworld
# (mbOutdated, iworld) = load iworld
= case mbOutdated of
Just outdated = case map getTimestamp outdated of
[] = (Nothing, iworld)
[fstTimestamp:timestamps] = (Just (foldl min fstTimestamp timestamps), iworld)
Nothing
= (Nothing, iworld)
where