implementation module ProcessDB import StdEnv, StdMaybe import TSt, Store, Util, Text instance ProcessDB IWorld where createProcess :: !Process !*IWorld -> (!ProcessId,!*IWorld) createProcess entry iworld #(procs,iworld=:{store,world}) = processStore id iworld # (pid,store,world) = getPid store world # (procs,iworld) = processStore (\_ -> procs ++ [{Process | entry & taskId = pid, properties = {entry.Process.properties & systemProperties = {SystemProperties|entry.Process.properties.systemProperties & taskId = pid}} }]) {iworld & store = store, world = world} = (pid, iworld) where getPid store world | entry.Process.taskId <> "" = (entry.Process.taskId,store,world) | otherwise = getNewPid store world getNewPid store world # (mbNewPid,store,world) = loadValue "NextProcessID" store world = case mbNewPid of (Just pid) # store = storeValue "NextProcessID" (pid+1) store //increment the stored counter by 1 = (toString pid,store,world) Nothing # store = storeValue "NextProcessID" 2 store //store the next value (2) = ("1",store,world) //return the first value (1) deleteProcess :: !TaskId !*IWorld -> (!Bool, !*IWorld) deleteProcess taskId iworld # (procs,iworld) = processStore id iworld # (nprocs,iworld) = processStore (\_ -> [process \\ process <- procs | process.Process.taskId <> taskId]) iworld = (length procs <> length nprocs, iworld) getProcess :: !TaskId !*IWorld -> (!Maybe Process,!*IWorld) getProcess taskId iworld # (procs,iworld) = processStore id iworld = case [process \\ process <- procs | process.Process.taskId == taskId] of [entry] = (Just entry, iworld) _ = (Nothing, iworld) getProcessForUser :: !User !TaskId !*IWorld -> (!Maybe Process,!*IWorld) getProcessForUser user taskId iworld # (procs,iworld) = processStore id iworld = case [p\\ p <- procs | p.Process.taskId == taskId && (user == p.Process.properties.managerProperties.worker || isMember user (map snd p.Process.properties.systemProperties.subTaskWorkers) )] of [entry] = (Just entry, iworld) _ = (Nothing, iworld) getProcessForManager :: !User !TaskId !*IWorld -> (!Maybe Process, !*IWorld) getProcessForManager manager taskId iworld # (procs,iworld) = processStore id iworld # managers = [p.Process.properties.systemProperties.manager \\ p <- procs | relevantProc taskId p] = case [p \\ p <- procs | p.Process.taskId == taskId && isMember manager managers] of [entry] = (Just entry, iworld) _ = (Nothing, iworld) where relevantProc targetId {Process|taskId} = taskId == targetId relevantProc _ _ = False getProcesses :: ![TaskStatus] !*IWorld -> (![Process], !*IWorld) getProcesses statusses iworld # (procs, iworld) = processStore id iworld = ([p \\ p <- procs | isMember p.Process.properties.systemProperties.SystemProperties.status statusses], iworld) getProcessesById :: ![TaskId] !*IWorld -> (![Process], !*IWorld) getProcessesById ids iworld # (procs,iworld) = processStore id iworld = ([process \\ process <- procs | isMember process.Process.taskId ids], iworld) getProcessesForUser :: !User ![TaskStatus] !*IWorld -> (![Process], !*IWorld) getProcessesForUser user statusses iworld # (procs,iworld) = processStore id iworld = ([p \\ p <- procs | p.Process.mutable && isRelevant user p && isMember p.Process.properties.systemProperties.SystemProperties.status statusses ], iworld) where isRelevant user {Process | properties} //Either you are working on the task = ( properties.managerProperties.worker == user) //Or you are working on a subtask of this task in an open collaboration || (isMember user (map snd properties.systemProperties.SystemProperties.subTaskWorkers)) setProcessOwner :: !User !TaskId !*IWorld -> (!Bool, !*IWorld) setProcessOwner worker taskId iworld = updateProcess taskId (\x -> {Process | x & properties = {x.Process.properties & managerProperties = {x.Process.properties.managerProperties & worker = worker}}}) iworld setProcessStatus :: !TaskStatus !TaskId !*IWorld -> (!Bool,!*IWorld) setProcessStatus status taskId iworld = updateProcess taskId (\x -> {Process | x & properties = {x.Process.properties & systemProperties = {SystemProperties|x.Process.properties.systemProperties & status = status}}}) iworld updateProcess :: !TaskId (Process -> Process) !*IWorld -> (!Bool, !*IWorld) updateProcess taskId f iworld # (procs,iworld) = processStore id iworld # (nprocs,upd) = unzip (map (update f) procs) # (nprocs,iworld) = processStore (\_ -> nprocs) iworld = (or upd, iworld) where update f x | x.Process.taskId == taskId = (f x, True) | otherwise = (x, False) updateProcessProperties :: !TaskId (TaskProperties -> TaskProperties) !*IWorld -> (!Bool, !*IWorld) updateProcessProperties taskId f iworld = updateProcess taskId (\p -> {Process |p & properties = f p.Process.properties}) iworld removeFinishedProcesses :: !*IWorld -> (!Bool, !*IWorld) removeFinishedProcesses iworld # (proc,iworld) = getProcesses [Finished] iworld = removeFinishedProcesses` proc iworld where removeFinishedProcesses` :: ![Process] !*IWorld -> (!Bool, !*IWorld) removeFinishedProcesses` [] iworld = (True, iworld) removeFinishedProcesses` [p:ps] iworld # (ok,iworld) = deleteProcess p.Process.taskId iworld | ok = removeFinishedProcesses` ps iworld | otherwise = (False,iworld) setImmutable :: !TaskId !*IWorld -> *IWorld setImmutable prefix iworld # (nprocs,iworld) = processStore (\procs -> [if (startsWith prefix proc.Process.taskId) {Process|proc & mutable = False} proc \\ proc <- procs]) iworld = iworld copySubProcesses :: !TaskId !TaskId !*IWorld -> *IWorld copySubProcesses fromprefix toprefix iworld # (nprocs,iworld) = processStore (\procs -> flatten [copy fromprefix toprefix proc \\ proc <- procs]) iworld = iworld where copy fromprefix toprefix proc | startsWith fromprefix proc.Process.taskId //Prefix of task id has got to be updated # taskId = toprefix +++ (proc.Process.taskId % (size fromprefix, size proc.Process.taskId)) //Update properties # systemProperties = {SystemProperties|proc.Process.properties.systemProperties //Prefix of task id has got to be updated & taskId = taskId //Prefixes of parent fields are also updated , parent = case proc.Process.properties.systemProperties.parent of Just par = Just (if (startsWith fromprefix par) (toprefix +++ (par % (size fromprefix, size par))) par) Nothing = Nothing } = [proc ,{Process| proc & taskId = taskId , properties = {proc.Process.properties & systemProperties = systemProperties} //The new copy is mutable again , mutable = True } ] | otherwise = [proc] deleteSubProcesses :: !TaskId !*IWorld -> *IWorld deleteSubProcesses prefix iworld # (nprocs,iworld) = processStore (\procs -> [process \\ process <- procs | not (startsWith prefix process.Process.taskId)]) iworld = iworld processStore :: !([Process] -> [Process]) !*IWorld -> (![Process],!*IWorld) processStore fn iworld=:{IWorld|store,world} # (mbList,store,world) = loadValue "ProcessDB" store world # list = fn (case mbList of Nothing = []; Just list = list) # store = storeValue "ProcessDB" list store = (list, {IWorld| iworld & store = store, world = world}) instance ProcessDB TSt where createProcess :: !Process !*TSt -> (!ProcessId,!*TSt) createProcess process tst = accIWorldTSt (createProcess process) tst deleteProcess :: !TaskId !*TSt -> (!Bool,!*TSt) deleteProcess processId tst = accIWorldTSt (deleteProcess processId) tst getProcess :: !TaskId !*TSt -> (!Maybe Process,!*TSt) getProcess processId tst = accIWorldTSt (getProcess processId) tst getProcessForUser :: !User !TaskId !*TSt -> (!Maybe Process,!*TSt) getProcessForUser user processId tst = accIWorldTSt (getProcessForUser user processId) tst getProcessForManager :: !User !TaskId !*TSt -> (!Maybe Process,!*TSt) getProcessForManager manager processId tst = accIWorldTSt (getProcessForManager manager processId) tst getProcesses :: ![TaskStatus] !*TSt -> (![Process],!*TSt) getProcesses statuses tst = accIWorldTSt (getProcesses statuses) tst getProcessesById :: ![TaskId] !*TSt -> (![Process],!*TSt) getProcessesById processIds tst = accIWorldTSt (getProcessesById processIds) tst getProcessesForUser :: !User ![TaskStatus] !*TSt -> (![Process],!*TSt) getProcessesForUser user statuses tst = accIWorldTSt (getProcessesForUser user statuses) tst setProcessOwner :: !User !TaskId !*TSt -> (!Bool,!*TSt) setProcessOwner user processId tst = accIWorldTSt (setProcessOwner user processId) tst setProcessStatus :: !TaskStatus !TaskId !*TSt -> (!Bool,!*TSt) setProcessStatus status processId tst = accIWorldTSt (setProcessStatus status processId) tst updateProcess :: !TaskId (Process -> Process) !*TSt -> (!Bool,!*TSt) updateProcess processId f tst = accIWorldTSt (updateProcess processId f) tst updateProcessProperties :: !TaskId (TaskProperties -> TaskProperties) !*TSt -> (!Bool,!*TSt) updateProcessProperties processId f tst = accIWorldTSt (updateProcessProperties processId f) tst removeFinishedProcesses :: !*TSt -> (!Bool,!*TSt) removeFinishedProcesses tst = accIWorldTSt removeFinishedProcesses tst setImmutable :: !TaskId !*TSt -> *TSt setImmutable prefix tst = appIWorldTSt (setImmutable prefix) tst copySubProcesses :: !TaskId !TaskId !*TSt -> *TSt copySubProcesses fromprefix toprefix tst = appIWorldTSt (copySubProcesses fromprefix toprefix) tst deleteSubProcesses :: !TaskId !*TSt -> *TSt deleteSubProcesses prefix tst = appIWorldTSt (deleteSubProcesses prefix) tst