Commit 82d25ca1 authored by Bas Lijnse's avatar Bas Lijnse

Added TaskOutput indirection in task tree, as preparation for building task...

Added TaskOutput indirection in task tree, as preparation for building task trees that contain no user interface or alternative output formats.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1132 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ee41bed8
......@@ -339,7 +339,7 @@ makeInstructionTask instruction context tst
# (events, tst) = getEvents tst
| isEmpty events
= case tst.tree of
(TTInstructionTask ti _ _) = (TaskBusy ,{tst & tree = TTInstructionTask ti (html instruction) context})
(TTInstructionTask ti _) = (TaskBusy ,{tst & tree = TTInstructionTask ti (UIOutput (html instruction,context))})
_ = (TaskException (dynamic "Illegal node in makeInstructionTask"), tst)
| otherwise
= (TaskFinished Void,tst)
......
......@@ -21,23 +21,25 @@ derive JSONEncode HtmlTag, HtmlAttr
//on unique states @!#$%!!
JSONEncode{|TaskTree|} (TTMainTask a0 a1 a2 a3 a4)
= [JSONArray [JSONString "TTMainTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1 ++ JSONEncode{|*|} a2 ++ JSONEncode{|*|} a3 ++ JSONEncode{|*|} a4]]
JSONEncode{|TaskTree|} (TTInteractiveTask a0 a1)
= [JSONArray [JSONString "TTInteractiveTask":JSONEncode{|*|} a0]] //DOES NOT INCLUDE a1
JSONEncode{|TaskTree|} (TTMonitorTask a0 a1)
= [JSONArray [JSONString "TTMonitorTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTInstructionTask a0 a1 a2)
= [JSONArray [JSONString "TTInstructionTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1 ++ JSONEncode{|*|} a2]]
JSONEncode{|TaskTree|} (TTRpcTask a0 a1)
= [JSONArray [JSONString "TTRpcTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTSequenceTask a0 a1)
= [JSONArray [JSONString "TTSequenceTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTParallelTask a0 a1 a2)
= [JSONArray [JSONString "TTParallelTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1 ++ JSONEncode{|*|} a2]]
JSONEncode{|TaskTree|} (TTGroupedTask a0 a1 a2 a3)
= [JSONArray [JSONString "TTGroupedTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1 ++ JSONEncode{|*|} a3]] //DOES NOT INCLUDE a2
JSONEncode{|TaskTree|} (TTFinishedTask a0 a1)
= [JSONArray [JSONString "TTFinishedTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTInteractiveTask a0 a1)
= [JSONArray [JSONString "TTInteractiveTask":JSONEncode{|*|} a0]]
JSONEncode{|TaskTree|} (TTMonitorTask a0 a1)
= [JSONArray [JSONString "TTMonitorTask":JSONEncode{|*|} a0]]
JSONEncode{|TaskTree|} (TTInstructionTask a0 a1)
= [JSONArray [JSONString "TTInstructionTask":JSONEncode{|*|} a0]]
JSONEncode{|TaskTree|} (TTFinishedTask a0 a1)
= [JSONArray [JSONString "TTFinishedTask":JSONEncode{|*|} a0]]
JSONEncode{|TaskTree|} (TTRpcTask a0 a1)
= [JSONArray [JSONString "TTRpcTask":JSONEncode{|*|} a0]]
JSONEncode{|Timestamp|} (Timestamp x) = JSONEncode{|*|} x
JSONDecode{|Timestamp|} [JSONInt x:c] = (Just (Timestamp x),c)
......
......@@ -31,7 +31,7 @@ mkTSt :: String Config HTTPRequest ![Workflow] !*Store !*World -> *TSt
mkTSt appName config request workflows store world
= { taskNr = []
, taskInfo = initTaskInfo
, tree = TTMainTask initTaskInfo initTaskProperties Nothing Nothing (TTFinishedTask initTaskInfo [])
, tree = TTMainTask initTaskInfo initTaskProperties Nothing Nothing (TTFinishedTask initTaskInfo NoOutput)
, newTask = True
, events = []
, properties = initTaskProperties
......@@ -171,7 +171,7 @@ where
& taskId = taskId
, taskLabel = properties.managerProperties.subject
}
= TTMainTask info properties Nothing mbParType (TTFinishedTask info [Text "Dummy"])
= TTMainTask info properties Nothing mbParType (TTFinishedTask info NoOutput)
deleteTaskInstance :: !ProcessId !*TSt -> *TSt
deleteTaskInstance procId tst
......@@ -295,7 +295,7 @@ where
& taskId = taskId
, taskLabel = properties.managerProperties.subject
}
# tree = TTMainTask info properties menus inptype (TTFinishedTask info [Text "Dummy"])
# tree = TTMainTask info properties menus inptype (TTFinishedTask info NoOutput)
= {TSt| tst & taskNr = taskNr, tree = tree, events = events, staticInfo = {tst.staticInfo & currentProcessId = taskId}}
restoreTSt :: !TaskTree ![TaskEvent] !TaskProperties !(Maybe [Menu]) !*TSt -> *TSt
......@@ -455,9 +455,9 @@ where
//The interactive task leaves that are normalized
normalizeInteractiveTasks (TTInteractiveTask ti it) tst
= case it of
(Func f)
(UIOutput (Func f))
# (it,tst) = f tst
= (TTInteractiveTask ti it, tst)
= (TTInteractiveTask ti (UIOutput it), tst)
_
= (TTInteractiveTask ti it, tst)
//For grouped tasks the actions are also normalized
......@@ -511,13 +511,13 @@ calculateTaskResult taskId tst
, taskLabel = "Unknown Process"
, taskDescription = "Task Result"
}
= (TTFinishedTask info [], tst)
= (TTFinishedTask info NoOutput, tst)
Just process=:{Process|properties}
# tst=:{TSt | iworld=iworld=:{store,world}} = tst
# (mbContainer,store,world) = loadValue (iTaskId taskId "container") store world
# result = case mbContainer of
(Just dyn) = renderResult dyn
(Nothing) = [Text "Cannot load result."]
(Just dyn) = UIOutput (renderResult dyn)
(Nothing) = UIOutput [Text "Cannot load result."]
# info = { initTaskInfo
& taskId = taskId
, taskLabel = properties.managerProperties.subject
......@@ -535,7 +535,7 @@ calculateTaskTree taskId events tst
, taskLabel = "Deleted Process"
, taskDescription = "Task Result"
}
= (TTFinishedTask info [], tst)
= (TTFinishedTask info NoOutput, tst)
Just process=:{Process|properties}
= case properties.systemProperties.SystemProperties.status of
Active
......@@ -547,8 +547,8 @@ calculateTaskTree taskId events tst
# tst=:{TSt | iworld=iworld=:{store,world}} = tst
# (mbContainer,store,world) = loadValue (iTaskId taskId "container") store world
# result = case mbContainer of
(Just dyn) = renderResult dyn
(Nothing) = [Text "Cannot load result."]
(Just dyn) = UIOutput (renderResult dyn)
(Nothing) = UIOutput [Text "Cannot load result."]
# info = { initTaskInfo
& taskId = taskId
, taskLabel = properties.managerProperties.subject
......@@ -626,25 +626,25 @@ mkInteractiveTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkInteractiveTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkInteractiveTask`
where
mkInteractiveTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTInteractiveTask taskInfo (abort "No interface definition given")}
= taskfun {tst & tree = TTInteractiveTask taskInfo NoOutput}
mkInstantTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkInstantTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkInstantTask`
where
mkInstantTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTFinishedTask taskInfo []} //We use a FinishedTask node because the task is finished after one evaluation
= taskfun {tst & tree = TTFinishedTask taskInfo NoOutput} //We use a FinishedTask node because the task is finished after one evaluation
mkMonitorTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkMonitorTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkMonitorTask`
where
mkMonitorTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTMonitorTask taskInfo []}
= taskfun {tst & tree = TTMonitorTask taskInfo NoOutput}
mkInstructionTask :: !String !(*TSt -> *(!TaskResult Void,!*TSt)) -> Task Void
mkInstructionTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkInstructionTask`
where
mkInstructionTask` tst =:{TSt | taskInfo}
= taskfun {tst & tree = TTInstructionTask taskInfo [] Nothing}
= taskfun {tst & tree = TTInstructionTask taskInfo NoOutput}
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpce parsefun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkRpcTask`
......@@ -727,7 +727,7 @@ mkMainTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkMainTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkMainTask`
where
mkMainTask` tst=:{taskNr,taskInfo}
= taskfun {tst & tree = TTMainTask taskInfo initTaskProperties Nothing Nothing (TTFinishedTask taskInfo [])}
= taskfun {tst & tree = TTMainTask taskInfo initTaskProperties Nothing Nothing (TTFinishedTask taskInfo NoOutput)}
applyTask :: !(Task a) !*TSt -> (!TaskResult a,!*TSt) | iTask a
applyTask (Task initProperties groupedProperties mbInitTaskNr taskfun) tst=:{taskNr,tree,properties,iworld=iworld=:{IWorld|store,world}}
......@@ -743,7 +743,7 @@ applyTask (Task initProperties groupedProperties mbInitTaskNr taskfun) tst=:{tas
# tst = {TSt|tst & taskInfo = taskInfo, newTask = isNothing taskVal, iworld = {IWorld| iworld & store = store, world = world }}
= case taskVal of
(Just (TaskFinished a))
# tst = addTaskNode (TTFinishedTask taskInfo (visualizeAsHtmlDisplay a)) tst
# tst = addTaskNode (TTFinishedTask taskInfo (UIOutput (visualizeAsHtmlDisplay a))) tst
= (TaskFinished a, {tst & taskNr = incTaskNr taskNr})
_
// If the task is new, but has run in a different context, initialize the states of the task and its subtasks
......@@ -766,7 +766,7 @@ applyTask (Task initProperties groupedProperties mbInitTaskNr taskfun) tst=:{tas
# store = if(gc) store (storeValue taskId result store)
// Store the final value and it's type as a dynamic value, so it can be visualized by the task-result service later.
# store = if(gc) store (storeValueAs SFDynamic (taskId+++"-container") (dynamic (Container a) :: Container a^ a^) store)
# tst = addTaskNode (TTFinishedTask taskInfo (visualizeAsHtmlDisplay a))
# tst = addTaskNode (TTFinishedTask taskInfo (UIOutput (visualizeAsHtmlDisplay a)))
{tst & taskNr = incTaskNr taskNr, tree = tree, iworld = {IWorld|iworld & store = store}}
= (TaskFinished a, tst)
(TaskBusy)
......@@ -779,7 +779,7 @@ applyTask (Task initProperties groupedProperties mbInitTaskNr taskfun) tst=:{tas
(TaskException e)
// Store exception
# store = storeValue taskId result store
# tst = addTaskNode (TTFinishedTask taskInfo [Text "Uncaught exception"])
# tst = addTaskNode (TTFinishedTask taskInfo (UIOutput [Text "Uncaught exception"]))
{tst & taskNr = incTaskNr taskNr, tree = tree, iworld = {IWorld|iworld & store = store}}
= (TaskException e, tst)
......@@ -806,31 +806,31 @@ addTaskNode node tst=:{tree} = case tree of
setTUIDef :: !([TUIDef],[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt
setTUIDef def taskDescription accActions tst=:{tree}
= case tree of
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (Definition def accActions)}
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (UIOutput (Definition def accActions))}
_ = tst
setTUIUpdates :: ![TUIUpdate] ![(Action,Bool)] !*TSt -> *TSt
setTUIUpdates upd accActions tst=:{tree}
= case tree of
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask info (Updates upd accActions)}
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask info (UIOutput (Updates upd accActions))}
_ = tst
setTUIFunc :: (*TSt -> *(!InteractiveTask, !*TSt)) [HtmlTag] !*TSt -> *TSt
setTUIFunc func taskDescription tst=:{tree}
= case tree of
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (Func func)}
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (UIOutput (Func func))}
_ = tst
setTUIMessage :: !([TUIDef],[TUIButton]) [HtmlTag] ![(Action,Bool)] !*TSt -> *TSt
setTUIMessage msg taskDescription accActions tst=:{tree}
= case tree of
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (Message msg accActions)}
(TTInteractiveTask info _) = {tst & tree = TTInteractiveTask {info & taskDescription = foldl (+++) "" (map toString taskDescription)} (UIOutput (Message msg accActions))}
_ = tst
setStatus :: ![HtmlTag] !*TSt -> *TSt
setStatus msg tst=:{tree}
= case tree of
(TTMonitorTask info _) = {tst & tree = TTMonitorTask info msg}
(TTMonitorTask info _) = {tst & tree = TTMonitorTask info (UIOutput msg)}
_ = tst
setGroupActions :: ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !*TSt -> *TSt
......
......@@ -35,7 +35,7 @@ buildTaskPanel` :: !TaskTree !(Maybe [Menu]) !Bool ![(Action, Bool, Bool)] !User
buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
(TTFinishedTask _ _)
= TaskDone
(TTInteractiveTask ti (Definition (def,buttons) acceptedA))
(TTInteractiveTask ti (UIOutput (Definition (def,buttons) acceptedA)))
= TTCFormContainer {TTCFormContainer
| xtype = "itasks.ttc.form"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -45,7 +45,7 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, subtaskId = Nothing
, description = ti.TaskInfo.taskDescription
}
(TTInteractiveTask ti (Updates upd acceptedA))
(TTInteractiveTask ti (UIOutput (Updates upd acceptedA)))
= TTCFormContainer {TTCFormContainer
| xtype = "itasks.ttc.form"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -55,9 +55,9 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, subtaskId = Nothing
, description = ti.TaskInfo.taskDescription
}
(TTInteractiveTask ti (Func f))
(TTInteractiveTask ti (UIOutput (Func f)))
= abort "Non-normalized interactive task left in task tree"
(TTInteractiveTask ti (Message (msg,buttons) acceptedA))
(TTInteractiveTask ti (UIOutput (Message (msg,buttons) acceptedA)))
= TTCMessageContainer {TTCMessageContainer
| xtype = "itasks.ttc.message"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -66,7 +66,7 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, subtaskId = Nothing
, description = ti.TaskInfo.taskDescription
}
(TTMonitorTask ti html)
(TTMonitorTask ti (UIOutput html))
= TTCMonitorContainer {TTCMonitorContainer
| xtype = "itasks.ttc.monitor"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -74,7 +74,7 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, html = toString (DivTag [] html)
, subtaskId = Nothing
}
(TTInstructionTask ti instruction context)
(TTInstructionTask ti (UIOutput (instruction,context)))
= TTCInstructionContainer {TTCInstructionContainer
| xtype = "itasks.ttc.instruction"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -140,7 +140,7 @@ buildSubtaskInfo (TTMainTask _ p _ _ _)
buildResultPanel :: !TaskTree -> TaskPanel
buildResultPanel tree = case tree of
(TTFinishedTask ti result)
(TTFinishedTask ti (UIOutput result))
= (TTCResultContainer {TTCResultContainer
| xtype = "itasks.ttc.result"
, id = "taskform-" +++ ti.TaskInfo.taskId
......@@ -201,7 +201,7 @@ where
TTSequenceTask ti _ = ti
TTMainTask ti _ _ _ _ = ti
TTGroupedTask ti _ _ _ = ti
TTInstructionTask ti _ _ = ti
TTInstructionTask ti _ = ti
_ = abort "Unknown panel type in group"
= info
......
......@@ -14,22 +14,38 @@ from ProcessDB import :: Action, :: Menu, :: MenuItem
from JSON import :: JSONNode
from TUIDefinition import :: TUIDef, :: TUIUpdate
// give definition/updates or determine it after entire tree is build, needed for updateShared, ...
:: InteractiveTask = Definition ([TUIDef],[TUIButton]) [(Action,Bool)] //Definition for rendering a user interface
| Updates [TUIUpdate] [(Action,Bool)] //Update an already rendered user interface
| Message ([TUIDef],[TUIButton]) [(Action,Bool)] //Just show a message
| Func (*TSt -> *(!InteractiveTask, !*TSt)) //Function for delayed generation of an interface definition.
//These functions are evaluated after the full tree has been built.
:: TaskTree = TTMainTask TaskInfo TaskProperties (Maybe [Menu]) !(Maybe TaskParallelType) TaskTree //A task that is treated as a main chunk of work
| TTInteractiveTask TaskInfo InteractiveTask //A task that can be worked on through a gui
| TTMonitorTask TaskInfo [HtmlTag] //A task that upon evaluation monitors a condition and may give status output
| TTInstructionTask TaskInfo [HtmlTag] (Maybe [HtmlTag]) //A task which displays an (offline) instruction to the user
| TTRpcTask TaskInfo RPCExecute //A task that represents an rpc invocation
| TTSequenceTask TaskInfo [TaskTree] //A task that is composed of a number of sequentially executed subtasks
| TTParallelTask TaskInfo TaskParallelInfo [TaskTree] //A task that is composed of a number of parallel executed subprocesses
| TTGroupedTask TaskInfo [TaskTree] ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !(Maybe String) //A task that is composed of a number of grouped subtasks
| TTFinishedTask TaskInfo [HtmlTag] //A completed task
:: TaskTree
//NODE CONSTRUCTORS
//A task that is treated as a main chunk of work
= TTMainTask TaskInfo TaskProperties (Maybe [Menu]) !(Maybe TaskParallelType) TaskTree
//A task that is composed of a number of sequentially executed subtasks
| TTSequenceTask TaskInfo [TaskTree]
//A task that is composed of a number of parallel executed main tasks (a division of big chunks of work)
| TTParallelTask TaskInfo TaskParallelInfo [TaskTree]
//A task that is composed of a number of grouped subtasks
| TTGroupedTask TaskInfo [TaskTree] ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !(Maybe String)
//LEAF CONSTRUCTORS
//A task which displays an (offline) instruction to the user
| TTInstructionTask TaskInfo (TaskOutput ([HtmlTag], Maybe [HtmlTag]))
//A task that can be worked on through a gui
| TTInteractiveTask TaskInfo (TaskOutput InteractiveTask)
//A task that upon evaluation monitors a condition and may give status output
| TTMonitorTask TaskInfo (TaskOutput [HtmlTag])
//A completed task
| TTFinishedTask TaskInfo (TaskOutput [HtmlTag])
//A task that represents an rpc invocation
| TTRpcTask TaskInfo RPCExecute
// Output is generated by the basictasks and combinators while building the task tree.
// Depending on the purpose of evaluating the task tree, different output is generated.
:: TaskOutput ui = NoOutput //No output is generated
| UIOutput ui //Output for a user interface is generated
| JSONOutput JSONNode //A JSON representation of the task value is generated
:: TaskInfo = { taskId :: TaskId //Task number in string format
, taskLabel :: String //Descriptive label of the task
......@@ -46,7 +62,15 @@ from TUIDefinition import :: TUIDef, :: TUIUpdate
:: TaskParallelType = Open //Everybody to whom a subtask is assigned can see the full status of this parallel, including the results of others
| Closed //Only the manager can see the overview. For assigned users, it just looks like an ordinary task.
// give definition/updates or determine it after entire tree is build, needed for updateShared, ...
:: InteractiveTask = Definition ([TUIDef],[TUIButton]) [(Action,Bool)] //Definition for rendering a user interface
| Updates [TUIUpdate] [(Action,Bool)] //Update an already rendered user interface
| Message ([TUIDef],[TUIButton]) [(Action,Bool)] //Just show a message
| Func (*TSt -> *(!InteractiveTask, !*TSt)) //Function for delayed generation of an interface definition.
//These functions are evaluated after the full tree has been built.
:: GroupedBehaviour = GBFixed //The editor is fixed in the window, user can undock editor (making it floating)
| GBFloating //The editor is shown in a floating window, user can dock editor (making it fixed)
| GBAlwaysFixed //Same as Fixed, but user cannot undock
......
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