We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit 8cfe1385 authored by ecrombag's avatar ecrombag

Two updates:

1) Split the single 'Store' into 'dataStore' and 'systemStore'. dataStore contains task-related information and dynamics and has the 'lastModified' time (this is os-independent information) of the executable as suffix. So by default, when a new excecutable is compiled, a fresh dataStore is created. 
2) Fixed a bug regarding incomplete garbage collection. Task-data was stored with the prefix 'iTask_'+taskId, where as other data (like masks,selections,etc..) where stored with just the taskId and a suffix. When a task is finished all files starting with 'iTask_'+taskId are removed, leaving the masks and such. Fixed, by appending the 'iTask_' prefix also to the other data.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@654 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent e8bb3b86
......@@ -20,21 +20,21 @@ derive gParse DBRef
readDB :: !(DBid a) -> Task a | iTask a
readDB key = mkInstantTask "readDB" readDB`
where
readDB` tst=:{TSt|store,world}
# (mbVal,store,world) = loadValue key store world
readDB` tst=:{TSt|dataStore,world}
# (mbVal,dstore,world) = loadValue key dataStore world
= case mbVal of
Just val
= (val,{TSt|tst & store = store, world = world})
= (val,{TSt|tst & dataStore = dstore, world = world})
Nothing
# (val,world) = defaultValue world
= (val,{TSt|tst & store = store, world = world})
= (val,{TSt|tst & dataStore = dstore, world = world})
writeDB :: !(DBid a) !a -> Task a | iTask a
writeDB key value = mkInstantTask "writeDB" writeDB`
where
writeDB` tst=:{TSt|store}
# store = storeValue key value store
= (value, {TSt| tst & store = store})
writeDB` tst=:{TSt|dataStore}
# dstore = storeValue key value dataStore
= (value, {TSt| tst & dataStore = dstore})
mkDBid :: !String -> (DBid a)
mkDBid s = s
......
......@@ -46,11 +46,11 @@ where
_ = (Nothing, tst)
staticDynamicStore :: !([(DynamicId,String)] -> [(DynamicId,String)]) !*TSt -> (![(DynamicId,String)],!*TSt)
staticDynamicStore fn tst=:{TSt|store,world}
# (mbList,store,world) = loadValue "DynamicDB" store world
staticDynamicStore fn tst=:{TSt|dataStore,world}
# (mbList,dstore,world) = loadValue "DynamicDB" dataStore world
# list = fn (case mbList of Nothing = []; Just list = list)
# store = storeValue "DynamicDB" list store
= (list, {TSt|tst & store = store, world = world})
# dstore = storeValue "DynamicDB" list dstore
= (list, {TSt|tst & dataStore = dstore, world = world})
maxDynId :: [(DynamicId,String)] -> DynamicId
maxDynId db = foldr max 0 (map fst db)
......@@ -198,11 +198,11 @@ mkEmbeddedProcessEntry ancestor taskid properties status parent
}
processStore :: !([Process] -> [Process]) !*TSt -> (![Process],!*TSt)
processStore fn tst=:{TSt|store,world}
# (mbList,store,world) = loadValue "ProcessDB" store world
processStore fn tst=:{TSt|systemStore,world}
# (mbList,sstore,world) = loadValue "ProcessDB" systemStore world
# list = fn (case mbList of Nothing = []; Just list = list)
# store = storeValue "ProcessDB" list store
= (list, {TSt|tst & store = store, world = world})
# sstore = storeValue "ProcessDB" list sstore
= (list, {TSt|tst & systemStore = sstore, world = world})
maxPid :: [Process] -> ProcessId
maxPid db = foldr max 0 [processId \\ {Process|processId} <- db]
......
......@@ -55,8 +55,8 @@ getTimeStamp tst
= (t, tst)
sessionStore :: !([Session] -> [Session]) !*TSt -> (![Session],!*TSt)
sessionStore fn tst=:{TSt|store,world = world}
# (mbList,store,world) = loadValue "SessionDB" store world
sessionStore fn tst=:{TSt|systemStore,world = world}
# (mbList,sstore,world) = loadValue "SessionDB" systemStore world
# list = fn (case mbList of Nothing = []; Just list = list)
# store = storeValue "SessionDB" list store
= (list, {TSt|tst & store = store, world = world })
\ No newline at end of file
# sstore = storeValue "SessionDB" list sstore
= (list, {TSt|tst & systemStore = sstore, world = world })
\ No newline at end of file
......@@ -144,8 +144,8 @@ lookupUserProperty users selectFunction defaultValue userId
_ = defaultValue
userStore :: !([User] -> [User]) !*TSt -> (![User],!*TSt)
userStore fn tst=:{TSt|store,world}
# (mbList,store,world) = loadValue "UserDB" store world
userStore fn tst=:{TSt|systemStore,world}
# (mbList,sstore,world) = loadValue "UserDB" systemStore world
# list = fn (case mbList of Nothing = testUsers; Just list = list)
# store = storeValue "UserDB" list store
= (list, {TSt|tst & store = store, world = world})
\ No newline at end of file
# sstore = storeValue "UserDB" list sstore
= (list, {TSt|tst & systemStore = sstore, world = world})
\ No newline at end of file
implementation module Engine
import StdMisc, StdArray, StdList, StdChar, GenBimap
import StdMisc, StdArray, StdList, StdChar, StdFile, GenBimap
from StdFunc import o
from StdLibMisc import ::Date{..}, ::Time{..}
import Store, UserDB, ProcessDB, SessionDB
import Text, Util
import CoreCombinators
import CommandLine
import Directory
import Http, HttpUtil
......@@ -97,11 +101,24 @@ where
initTSt :: !HTTPRequest !Config ![Workflow] !*World -> *TSt
initTSt request config flows world
# (appName,world) = determineAppName world
= mkTSt appName config request (abort "session not active yet") flows (createStore (appName +++ "-store")) world
# (pathstr,world) = determineAppPath world
# ((ok, path),world) = pd_StringToPath (pathstr) world
| not ok = abort "Cannot find the executable."
# ((err,info),world) = getFileInfo path world
| err <> NoDirError = abort "Cannot get executable info."
# (date,time) = info.pi_fileInfo.lastModified
# datestr = (toString date.Date.year)+++(toString date.Date.month)+++(toString date.Date.day)+++"-"+++(toString time.Time.hours)+++(toString time.Time.minutes)+++(toString time.Time.seconds)
= mkTSt appName config request (abort "session not active yet") flows (createStore (appName +++ "-systemStore")) (createStore (appName +++ "-dataStore-" +++ datestr)) world //TODO: Insert exec.-compile time as data store suffix
finalizeTSt :: !*TSt -> *World
finalizeTSt tst=:{TSt|world} = world
// Determines the server executables path
determineAppPath :: !*World -> (!String, !*World)
determineAppPath world
# (args,world) = getCommandLine world
= (hd args,world)
// Determines the server executables name
determineAppName :: !*World -> (!String,!*World)
determineAppName world
......
......@@ -7,6 +7,8 @@ import Map, Text
import GenPrint
import GenParse
import StdDebug
import dynamic_string //Static dynamic serialization
:: *Store =
......@@ -88,7 +90,7 @@ where
deleteValues :: !String !*Store !*World -> (!*Store, !*World)
deleteValues prefix store=:{cache,location} world
//Delete items from cache
# cache = fromList [(key,item) \\ (key,item) <- toList cache | not (startsWith prefix key)]
# cache = trace_n("Delete values for " +++ prefix) fromList [(key,item) \\ (key,item) <- toList cache | not (startsWith prefix key)]
//Delete items from disk
# world = deleteFromDisk prefix location world
= ({store & cache = cache},world)
......@@ -104,7 +106,7 @@ where
= world
unlink prefix dir [f:fs] world
| startsWith prefix f.fileName
# (err,world) = fremove (pathDown dir f.fileName) world
# (err,world) = trace_n("Removing file: "+++f.fileName) fremove (pathDown dir f.fileName) world
= unlink prefix dir fs world
| otherwise
= unlink prefix dir fs world
......@@ -185,10 +187,10 @@ where
= ([(key,(False,item)):is], world)
writeToDisk key {StoreItem|format,content} location world
# filename = location +++ "/" +++ key +++ (case format of SFPlain = ".txt" ; SFDynamic = ".bin")
# filename = location +++ "/" +++ key +++ (case format of SFPlain = ".txt" ; SFDynamic = ".bin")
# (ok,file,world) = fopen filename FWriteData world
| not ok = abort ("Failed to write value to store: " +++ filename)
# file = fwrites content file
# file = trace_n("Writing file to disk: "+++filename) fwrites content file
# (ok,world) = fclose file world
= world
......@@ -41,7 +41,8 @@ import GenPrint, GenParse, GenVisualize, GenUpdate
, config :: !Config // The server configuration
, request :: !HTTPRequest // The current http request
, store :: !Store // Generic store
, systemStore :: !Store // ProcessDB, UserDB
, dataStore :: !Store // Runtime data (Sessions, Tasks, Dynamics)
, world :: !*World // The world
}
......@@ -85,7 +86,7 @@ import GenPrint, GenParse, GenVisualize, GenUpdate
*
* @return a TSt iTask state
*/
mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*World -> *TSt
mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*World -> *TSt
/**
* Calculates all task trees that are relevant to the current user
......
......@@ -15,8 +15,8 @@ derive gPrint TaskState
derive gParse TaskState
derive gEq TaskState
mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*World -> *TSt
mkTSt appName config request session workflows store world
mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*World -> *TSt
mkTSt appName config request session workflows systemStore dataStore world
= { taskNr = []
, taskInfo = initTaskInfo
, firstRun = False
......@@ -34,7 +34,8 @@ mkTSt appName config request session workflows store world
, changes = []
, config = config
, request = request
, store = store
, systemStore = systemStore
, dataStore = dataStore
, world = world
}
......@@ -381,9 +382,9 @@ where
= taskfun {tst & tree = TTMainTask taskInfo undef [], taskNr = [0,0:taskNr]}
applyTask :: !(Task a) !*TSt -> (!a,!*TSt) | iTask a
applyTask (Task name mbCxt taskfun) tst=:{taskNr,tree=tree,options,activated,store,world}
applyTask (Task name mbCxt taskfun) tst=:{taskNr,tree=tree,options,activated,dataStore,world}
# taskId = iTaskId taskNr ""
# (mbtv,store,world) = loadValue taskId store world
# (mbtv,dstore,world) = loadValue taskId dataStore world
# (state,curval) = case mbtv of
(Just (state, value)) = (state, Just value)
_ = (TSNew, Nothing)
......@@ -393,7 +394,7 @@ applyTask (Task name mbCxt taskfun) tst=:{taskNr,tree=tree,options,activated,sto
, finished = state === TSDone
, traceValue = ""
}
# tst = {TSt|tst & store = store, world = world}
# tst = {TSt|tst & dataStore = dstore, world = world}
|state === TSDone || not activated
# tst = addTaskNode (TTFinishedTask {taskInfo & traceValue = printToString(fromJust curval)}) tst
= (fromJust curval, {tst & taskNr = incTaskNr taskNr, activated = state === TSDone})
......@@ -404,17 +405,17 @@ applyTask (Task name mbCxt taskfun) tst=:{taskNr,tree=tree,options,activated,sto
// Execute task function
# (a, tst) = taskfun tst
// Remove user updates (needed for looping. a new task may get the same tasknr again, but should not get the events)
# tst=:{tree=node,activated,store} = clearUserUpdates tst
# tst=:{tree=node,activated,dataStore} = clearUserUpdates tst
// Update task state
| activated
# tst=:{TSt|store} = deleteTaskStates taskNr {TSt|tst & store = store}
# store = storeValue taskId (TSDone, a) store
# tst = addTaskNode (TTFinishedTask {taskInfo & traceValue = printToString a}) {tst & taskNr = incTaskNr taskNr, tree = tree, options = options, store = store}
# tst=:{TSt|dataStore} = deleteTaskStates taskNr {TSt|tst & dataStore = dataStore}
# dataStore = storeValue taskId (TSDone, a) dataStore
# tst = addTaskNode (TTFinishedTask {taskInfo & traceValue = printToString a}) {tst & taskNr = incTaskNr taskNr, tree = tree, options = options, dataStore = dataStore}
= (a, tst)
| otherwise
# node = updateTaskNode activated (printToString a) node
# store = storeValue taskId (TSActive, a) store
# tst = addTaskNode node {tst & taskNr = incTaskNr taskNr, tree = tree, options = options, store = store}
# dataStore = storeValue taskId (TSActive, a) dataStore
# tst = addTaskNode node {tst & taskNr = incTaskNr taskNr, tree = tree, options = options, dataStore = dataStore}
= (a, tst)
where
......@@ -463,18 +464,18 @@ getTaskValue tst=:{curValue = Just (a :: a^)} = (Just a, tst)
getTaskValue tst = (Nothing, tst)
setTaskStore :: !String !a !*TSt -> *TSt | iTask a
setTaskStore key value tst=:{taskNr,store}
# store = storeValue storekey value store
= {TSt|tst & store = store}
setTaskStore key value tst=:{taskNr,dataStore}
# dataStore = storeValue storekey value dataStore
= {TSt|tst & dataStore = dataStore}
where
storekey = taskNrToString taskNr +++ "-" +++ key
storekey = "iTask_" +++ (taskNrToString taskNr) +++ "-" +++ key
getTaskStore :: !String !*TSt -> (Maybe a, !*TSt) | iTask a
getTaskStore key tst=:{taskNr,store,world}
# (mbValue,store,world) = loadValue storekey store world
= (mbValue,{TSt|tst&store = store, world = world})
getTaskStore key tst=:{taskNr,dataStore,world}
# (mbValue,dataStore,world) = loadValue storekey dataStore world
= (mbValue,{TSt|tst&dataStore = dataStore, world = world})
where
storekey = taskNrToString taskNr +++ "-" +++ key
storekey = "iTask_" +++ (taskNrToString taskNr) +++ "-" +++ key
getUserUpdates :: !*TSt -> ([(String,String)],!*TSt)
getUserUpdates tst=:{taskNr,request} = (updates request, tst);
......@@ -511,19 +512,20 @@ resetSequence tst=:{taskNr,tree}
_ = {tst & tree = tree}
deleteTaskStates :: !TaskNr !*TSt -> *TSt
deleteTaskStates tasknr tst=:{TSt|store,world}
# (store,world) = deleteValues (iTaskId tasknr "") store world
= {TSt|tst & store = store, world = world}
deleteTaskStates tasknr tst=:{TSt|dataStore,world}
# (dstore,world) = deleteValues (iTaskId tasknr "") dataStore world
= {TSt|tst & dataStore = dstore, world = world}
copyTaskStates :: !TaskNr !TaskNr !*TSt -> *TSt
copyTaskStates fromtask totask tst=:{TSt|store,world}
# (store,world) = copyValues (iTaskId fromtask "") (iTaskId totask "") store world
= {TSt|tst & store = store, world = world}
copyTaskStates fromtask totask tst=:{TSt|dataStore,world}
# (dstore,world) = copyValues (iTaskId fromtask "") (iTaskId totask "") dataStore world
= {TSt|tst & dataStore = dstore, world = world}
flushStore :: !*TSt -> *TSt
flushStore tst=:{TSt|store,world}
# (store,world) = flushCache store world
= {TSt|tst & store = store, world = world}
flushStore tst=:{TSt|dataStore,systemStore,world}
# (dstore,world) = flushCache dataStore world
# (sstore,world) = flushCache systemStore world
= {TSt|tst & dataStore = dstore, systemStore = sstore, world = world}
taskNrToString :: !TaskNr -> String
taskNrToString [] = ""
......
......@@ -8,19 +8,19 @@ import TSt, Store, Util
try :: !(Task a) !(e -> Task a) -> Task a | iTask a & iTask e
try normalTask handlerTask = mkSequenceTask "try" exceptionTask
where
exceptionTask tst=:{taskNr,options,store,world}
exceptionTask tst=:{taskNr,options,dataStore,world}
# key = iTaskId (tl taskNr) "exception"
# (mbEx,store,world)= loadValue key store world
# (mbEx,dstore,world)= loadValue key dataStore world
= case mbEx of
Just ex
= applyTask (handlerTask ex) {TSt|tst & store = store, world = world}
= applyTask (handlerTask ex) {TSt|tst & dataStore = dstore, world = world}
Nothing
# (a, tst =:{exception}) = applyTask normalTask {TSt|tst & store = store, world = world}
# (a, tst =:{exception}) = applyTask normalTask {TSt|tst & dataStore = dstore, world = world}
= case exception of
Just (ex :: e^)
# tst=:{TSt|store} = deleteTaskStates (tl taskNr) tst //Garbage collect
# store = storeValueAs SFDynamic key ex store //Store the exception
= applyTask (handlerTask ex) (resetSequence {tst & exception = Nothing, activated = True, store = store}) //Run the handler
# tst=:{TSt|dataStore} = deleteTaskStates (tl taskNr) tst //Garbage collect
# dstore = storeValueAs SFDynamic key ex dataStore //Store the exception
= applyTask (handlerTask ex) (resetSequence {tst & exception = Nothing, activated = True, dataStore = dstore}) //Run the handler
_ = (a, tst) //Don't handle the exception
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment