Commit 3eaf7d68 authored by Bas Lijnse's avatar Bas Lijnse

Refactored parallel combinator. It now keeps the main task nodes in the task...

Refactored parallel combinator. It now keeps the main task nodes in the task tree even for sub processes that have already completed. The status of a process is now a system property that can be inspected and is automatically updated.
Also cleaned up the TSt somewhat in the process. 

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1105 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 2a445889
......@@ -4,7 +4,7 @@ definition module ProcessDBTasks
*/
import StdMaybe
from TSt import :: Task
from ProcessDB import :: ProcessStatus(..), :: Process(..), :: Menu
from ProcessDB import :: Process(..), :: Menu
from Types import :: ProcessId, :: ProcessRef, :: TaskId
from Types import :: TaskProperties, :: TaskPriority, :: TaskProgress
from TaskTree import :: TaskParallelType
......@@ -13,7 +13,7 @@ from Time import :: Timestamp
from iTasks import class iTask
import GenVisualize, GenUpdate, GenParse, GenPrint
derive class iTask ProcessRef, Process, ProcessStatus, TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskPriority, TaskProgress, Timestamp, TaskParallelType
derive class iTask ProcessRef, Process, TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskPriority, TaskProgress, Timestamp, TaskParallelType
//Allow either typed or untyped references to lookup a process table entry
class toProcessId a where toProcessId :: a -> ProcessId
......@@ -63,7 +63,7 @@ getProcesses :: ![pid] -> Task [Process] | toProcessId pid
*
* @return The list of processes having the given statuses
*/
getProcessesWithStatus :: ![ProcessStatus] -> Task [Process]
getProcessesWithStatus :: ![TaskStatus] -> Task [Process]
/**
* Retrieves the processes that are owned by indicated user and have one of the
* given statuses.
......@@ -74,7 +74,7 @@ getProcessesWithStatus :: ![ProcessStatus] -> Task [Process]
*
* @return The list of found processes
*/
getProcessesForUser :: !User ![ProcessStatus] -> Task [Process]
getProcessesForUser :: !User ![TaskStatus] -> Task [Process]
/**
* Poll who is the owner of a process.
*
......@@ -98,7 +98,7 @@ setProcessOwner :: !User !pid -> Task Void | toProcessId pid
*
* @return A task that yields the status of the referenced process
*/
getProcessStatus :: !pid -> Task ProcessStatus | toProcessId pid
getProcessStatus :: !pid -> Task TaskStatus | toProcessId pid
/**
* Change the process status to Active
*
......
......@@ -3,7 +3,7 @@ implementation module ProcessDBTasks
import StdOverloaded, StdClass, StdInt, StdArray, StdTuple, StdList
import TSt
from ProcessDB import :: Process{..}, :: ProcessStatus(..), :: Menu
from ProcessDB import :: Process{..}, :: Menu
from ProcessDB import qualified class ProcessDB(..)
from ProcessDB import qualified instance ProcessDB TSt
......@@ -18,7 +18,7 @@ import CommonCombinators
import Store
derive class iTask ProcessRef, Process, ProcessStatus, TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskPriority, TaskProgress, Timestamp, TaskParallelType
derive class iTask ProcessRef, Process, TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskStatus, TaskPriority, TaskProgress, Timestamp, TaskParallelType
derive bimap Maybe, (,)
......@@ -44,10 +44,10 @@ getProcessForManager man pid = mkInstantTask "getProcessForManager" (mkTaskFunct
getProcesses :: ![pid] -> Task [Process] | toProcessId pid
getProcesses ids = mkInstantTask "getProcessesById" (mkTaskFunction (\tst -> 'ProcessDB'.getProcessesById (map toProcessId ids) tst))
getProcessesWithStatus :: ![ProcessStatus] -> Task [Process]
getProcessesWithStatus :: ![TaskStatus] -> Task [Process]
getProcessesWithStatus statuses = mkInstantTask "getProcesses" (mkTaskFunction (\tst -> 'ProcessDB'.getProcesses statuses tst))
getProcessesForUser :: !User ![ProcessStatus] -> Task [Process]
getProcessesForUser :: !User ![TaskStatus] -> Task [Process]
getProcessesForUser user statuses = mkInstantTask "getProcessesForUser" (mkTaskFunction (\tst -> 'ProcessDB'.getProcessesForUser user statuses tst))
getProcessOwner :: !pid -> Task (Maybe User) | toProcessId pid
......@@ -65,14 +65,14 @@ where
# (_,tst) = 'ProcessDB'.setProcessOwner user (toProcessId pid) tst
= (TaskFinished Void,tst)
getProcessStatus :: !pid -> Task ProcessStatus | toProcessId pid
getProcessStatus :: !pid -> Task TaskStatus | toProcessId pid
getProcessStatus pid = mkInstantTask "getProcessStatus" getProcessStatus`
where
getProcessStatus` tst
# (mbProcess,tst) = 'ProcessDB'.getProcess (toProcessId pid) tst
= case mbProcess of
Just {Process | status} = (TaskFinished status, tst)
Nothing = (TaskFinished Deleted, tst)
Just proc = (TaskFinished proc.Process.properties.systemProperties.SystemProperties.status, tst)
Nothing = (TaskFinished Deleted, tst)
activateProcess :: !pid -> Task Void | toProcessId pid
......
......@@ -12,7 +12,6 @@ from Time import :: Timestamp
* Our local process type
*/
:: Process = { taskId :: !TaskId // The process identification
, status :: !ProcessStatus // The status of the process (updated after each run)
//Public process meta data
, properties :: !TaskProperties // The properties of the main task node of this process
//System internal information
......@@ -22,11 +21,7 @@ from Time import :: Timestamp
, inParallelType :: !(Maybe TaskParallelType) // The type of parallel, if the process is part of one
}
:: ProcessStatus = Active // A process is active and can be further evaluated
| Suspended // A process is (temporarily) suspended and will not be evaluated until it is activated
| Finished // A process terminated normally
| Excepted // A process terminated with an exception
| Deleted // A process is marked for deletion and may be garbage collected
:: Action
= ActionLabel !String
......@@ -70,12 +65,12 @@ where
getProcess :: !TaskId !*st -> (!Maybe Process, !*st)
getProcessForUser :: !User !TaskId !*st -> (!Maybe Process, !*st)
getProcessForManager :: !User !TaskId !*st -> (!Maybe Process, !*st)
getProcesses :: ![ProcessStatus] !*st -> (![Process], !*st)
getProcesses :: ![TaskStatus] !*st -> (![Process], !*st)
getProcessesById :: ![TaskId] !*st -> (![Process], !*st)
getProcessesForUser :: !User ![ProcessStatus] !*st -> (![Process], !*st)
getProcessesForUser :: !User ![TaskStatus] !*st -> (![Process], !*st)
setProcessOwner :: !User !TaskId !*st -> (!Bool, !*st)
setProcessStatus :: !ProcessStatus !TaskId !*st -> (!Bool, !*st)
setProcessStatus :: !TaskStatus !TaskId !*st -> (!Bool, !*st)
updateProcess :: !TaskId (Process -> Process) !*st -> (!Bool, !*st)
updateProcessProperties :: !TaskId (TaskProperties -> TaskProperties) !*st -> (!Bool, !*st)
......@@ -89,8 +84,7 @@ where
instance ProcessDB IWorld
instance ProcessDB TSt
instance toString ProcessStatus
instance == ProcessStatus
instance == Action
derive gPrint Action
......
......@@ -23,21 +23,6 @@ getActionIcon ActionShowAbout = "icon-help"
getActionIcon ActionFind = "icon-find"
getActionIcon _ = ""
instance == ProcessStatus
where
(==) Active Active = True
(==) Suspended Suspended = True
(==) Finished Finished = True
(==) Deleted Deleted = True
(==) _ _ = False
instance toString ProcessStatus
where
toString Active = "Active"
toString Suspended = "Suspended"
toString Finished = "Finished"
toString Deleted = "Deleted"
instance ProcessDB IWorld
where
createProcess :: !Process !*IWorld -> (!ProcessId,!*IWorld)
......@@ -96,20 +81,20 @@ where
relevantProc targetId {Process|taskId} = taskId == targetId
relevantProc _ _ = False
getProcesses :: ![ProcessStatus] !*IWorld -> (![Process], !*IWorld)
getProcesses :: ![TaskStatus] !*IWorld -> (![Process], !*IWorld)
getProcesses statusses iworld
# (procs, iworld) = processStore id iworld
= ([p \\ p <- procs | isMember p.Process.status statusses], 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 ![ProcessStatus] !*IWorld -> (![Process], !*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.status statusses ], 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
......@@ -121,9 +106,10 @@ where
setProcessOwner worker taskId iworld
= updateProcess taskId (\x -> {Process | x & properties = {TaskProperties|x.Process.properties & managerProperties = {ManagerProperties | x.Process.properties.managerProperties & worker = worker}}}) iworld
setProcessStatus :: !ProcessStatus !TaskId !*IWorld -> (!Bool,!*IWorld)
setProcessStatus status taskId iworld = updateProcess taskId (\x -> {Process| x & status = status}) iworld
setProcessStatus :: !TaskStatus !TaskId !*IWorld -> (!Bool,!*IWorld)
setProcessStatus status taskId iworld
= updateProcess taskId (\x -> {Process | x & properties = {TaskProperties|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
......@@ -220,15 +206,15 @@ where
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 :: ![ProcessStatus] !*TSt -> (![Process],!*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 ![ProcessStatus] !*TSt -> (![Process],!*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 :: !ProcessStatus !TaskId !*TSt -> (!Bool,!*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
......
......@@ -22,5 +22,5 @@ where
startWorkflow :: !Workflow !*TSt -> (!ProcessId,!*TSt)
startWorkflow workflow tst
# (_,pid,tst) = createTaskInstance workflow.Workflow.thread True Nothing True True tst
# (pid,_,_,tst) = createTaskInstance workflow.Workflow.thread True Nothing True True tst
= (pid,tst)
\ No newline at end of file
......@@ -44,7 +44,7 @@ taskService url html path req tst
Nothing
= (JSONObject [("success",JSONBool False),("error",JSONString "No such workflow")], tst)
Just workflow
# (_,taskId,tst) = createTaskInstance workflow.Workflow.thread True Nothing True True tst
# (taskId,_,_,tst) = createTaskInstance workflow.Workflow.thread True Nothing True True tst
= (JSONObject [("success",JSONBool True),("taskId",JSONString taskId)], tst)
= (serviceResponse html "create task" url createParams json, tst)
//Show task details of an individual task
......
......@@ -103,10 +103,11 @@ createThread :: !(Task a) -> Dynamic | iTask a
* @param The task state
*
* @return The process id of the new instance
* @return The result of the first run (as dynamic)
* @return The result of the first run (as dynamic result)
* @return The task tree created at the first run
* @return The modified task state
*/
createTaskInstance :: !Dynamic !Bool !(Maybe TaskParallelType) !Bool !Bool !*TSt -> (!Dynamic,!ProcessId,!*TSt)
createTaskInstance :: !Dynamic !Bool !(Maybe TaskParallelType) !Bool !Bool !*TSt -> (!ProcessId, !TaskResult Dynamic, !TaskTree, !*TSt)
/**
* Removes a running task instance from the list of processes and clears any associated data in the store
......@@ -363,6 +364,17 @@ mkMainTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
* @return The modified task state
*/
applyTask :: !(Task a) !*TSt -> (!TaskResult a,!*TSt) | iTask a
/**
* Add a subnode to the current task tree
*
* @param The sub node
* @param The task state
*
* @return The modified task state
*/
addTaskNode :: !TaskTree !*TSt -> *TSt
//// TASK CONTENT
setTUIDef :: !([TUIDef],[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
setTUIUpdates :: ![TUIUpdate] ![(Action,Bool)] !*TSt -> *TSt //Only for interactive tasks
......
This diff is collapsed.
......@@ -4,7 +4,7 @@ import JSON, TUIDefinition, TSt, ProcessDB
import StdList, StdMisc, StdTuple, StdEnum, StdBool, StdFunc
import Html
derive JSONEncode TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskPriority, TaskProgress, SubtaskInfo
derive JSONEncode TaskProperties, SystemProperties, ManagerProperties, WorkerProperties, TaskStatus, TaskPriority, TaskProgress, SubtaskInfo
derive JSONEncode TTCFormContainer, FormContent, TTCMonitorContainer, TTCMessageContainer, TTCResultContainer, TTCProcessControlContainer, TTCInstructionContainer
derive JSONEncode TTCParallelContainer, TTCGroupContainer, GroupedBehaviour, GroupContainerElement
......@@ -126,7 +126,7 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, taskId = ti.TaskInfo.taskId
, label = ti.TaskInfo.taskLabel
, description = tpi.TaskParallelInfo.description
, subtaskInfo = buildSubtaskInfo tasks currentUser
, subtaskInfo = map buildSubtaskInfo tasks
}
where
......@@ -134,6 +134,18 @@ where
IncludeGroupActions = True
ExcludeGroupActions = False
buildSubtaskInfo :: !TaskTree -> SubtaskInfo
buildSubtaskInfo (TTMainTask _ p _ _ _)
= {SubtaskInfo | taskId = p.systemProperties.SystemProperties.taskId
, subject = p.managerProperties.ManagerProperties.subject
, description = p.managerProperties.ManagerProperties.subject
, delegatedTo = toString p.managerProperties.ManagerProperties.worker
, finished = case p.systemProperties.SystemProperties.status of
Finished = True //Possible improvement:
Excepted = True //We could give more information to the client here!
_ = False
}
buildResultPanel :: !TaskTree -> TaskPanel
buildResultPanel tree = case tree of
(TTFinishedTask ti result)
......@@ -148,33 +160,6 @@ buildResultPanel tree = case tree of
_
= TaskNotDone
buildSubtaskInfo :: ![TaskTree] !User -> [SubtaskInfo]
buildSubtaskInfo tasks manager
= [buildSubtaskInfo` t \\ t <- tasks]
where
buildSubtaskInfo` :: !TaskTree -> SubtaskInfo
buildSubtaskInfo` (TTInteractiveTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTMonitorTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTInstructionTask ti _ _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTRpcTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTExtProcessTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTFinishedTask ti _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker, finished = True}
buildSubtaskInfo` (TTParallelTask ti tpi _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker, description = tpi.TaskParallelInfo.description}
buildSubtaskInfo` (TTGroupedTask ti _ _ _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
buildSubtaskInfo` (TTMainTask ti mti _ _ _)
= {SubtaskInfo | mkSti & taskId = ti.TaskInfo.taskId, subject = ti.TaskInfo.taskLabel, delegatedTo = toString ti.TaskInfo.worker}
mkSti :: SubtaskInfo
mkSti = {SubtaskInfo | finished = False, taskId = "", subject = "", delegatedTo = "", description = ""}
filterFinished container = case container.panel of
TaskDone = False
_ = True
......
......@@ -10,7 +10,7 @@ import Types
import Html, Time
import RPC
from ProcessDB import :: ProcessStatus, :: Action, :: Menu, :: MenuItem
from ProcessDB import :: Action, :: Menu, :: MenuItem
from JSON import :: JSONNode
from TUIDefinition import :: TUIDef, :: TUIUpdate
......
......@@ -5,6 +5,6 @@ import Types
import Html, Time
import RPC
from ProcessDB import :: ProcessStatus, :: Action, :: Menu, :: MenuItem
from ProcessDB import :: Action, :: Menu, :: MenuItem
from JSON import :: JSONNode
from TUIDefinition import :: TUIDef, :: TUIUpdate
......@@ -21,7 +21,7 @@ where
, TdTag [] [Text (toString process.Process.properties.managerProperties.ManagerProperties.worker)]
, TdTag [] [Text (foldr (+++) "" ["("+++toString p +++": "+++toString u+++") " \\ (p,u) <- process.Process.properties.systemProperties.subTaskWorkers])]
, TdTag [] [Text (toString process.Process.properties.systemProperties.manager)]
, TdTag [] [Text (toString process.Process.status)]
, TdTag [] [Text (toString process.Process.properties.systemProperties.SystemProperties.status)]
, TdTag [] (case process.Process.properties.systemProperties.parent of
Nothing = [Text "N/A"]
Just x = [Text x]
......
......@@ -30,9 +30,11 @@ derive JSONDecode Document
instance toString User
instance toString TaskPriority
instance toString Password
instance toString TaskStatus
instance == User
instance == Password
instance == TaskStatus
instance == Document
instance < User
......@@ -94,6 +96,7 @@ instance < User
:: SystemProperties =
{ taskId :: !TaskId // Process table identification
, parent :: !Maybe TaskId // The (direct) parent process
, status :: !TaskStatus // Is a maintask active,suspended,finished or excepted
, manager :: !User // Who is managing this task
, issuedAt :: !Timestamp // When was the task created
, firstEvent :: !Maybe Timestamp // When was the first work done on this task
......@@ -115,6 +118,12 @@ instance < User
{ progress :: !TaskProgress // Indication of the worker's progress
}
:: TaskStatus = Active // A process is active and can be further evaluated
| Suspended // A process is (temporarily) suspended and will not be evaluated until it is activated
| Finished // A process terminated normally
| Excepted // A process terminated with an exception
| Deleted // A process is deleted (never set, but returned when process can not be found)
initManagerProperties :: ManagerProperties
:: GroupedProperties =
......
......@@ -14,7 +14,6 @@ derive gVisualize UserDetails, Session
derive gUpdate UserDetails, Session
derive gError User, UserDetails, Session, Document, Hidden, HtmlDisplay, Editable, VisualizationHint
derive gHint User, UserDetails, Session, Document, Hidden, HtmlDisplay, Editable, VisualizationHint
derive gMerge User, Session, VisualizationHint, UserDetails
derive bimap Maybe, (,)
......@@ -50,6 +49,14 @@ instance toString Password
where
toString (Password p) = p
instance toString TaskStatus
where
toString Active = "Active"
toString Suspended = "Suspended"
toString Finished = "Finished"
toString Excepted = "Excepted"
toString Deleted = "Deleted"
instance toString User
where
toString user
......@@ -73,6 +80,15 @@ where
instance == Password
where
(==) (Password a) (Password b) = a == b
instance == TaskStatus
where
(==) Active Active = True
(==) Suspended Suspended = True
(==) Finished Finished = True
(==) Excepted Excepted = True
(==) Deleted Deleted = True
(==) _ _ = False
instance == Document
where
......@@ -94,6 +110,9 @@ where
(<) _ _ = False
// VisualizationHints etc..
fromVisualizationHint :: !(VisualizationHint .a) -> .a
fromVisualizationHint (VHEditable a) = a
......
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