Commit 77abee7e authored by Bas Lijnse's avatar Bas Lijnse

Added basic switching between tree types. Pre-heavy refactor commit :)

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1133 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 82d25ca1
......@@ -46,40 +46,45 @@ updateInformationAboutA :: question ![TaskAction a] b a -> Task (!Action,!a) | h
updateInformationAboutA question actions about initial = mkInteractiveTask "updateInformationAboutA" (makeInformationTask question (Just initial) (Just (visualizeAsHtmlDisplay about)) actions True)
makeInformationTask :: question (Maybe a) (Maybe [HtmlTag]) ![TaskAction a] !Bool !*TSt -> (!TaskResult (!Action,!a),!*TSt) | html question & iTask a
makeInformationTask question initial context actions actionStored tst=:{taskNr, newTask}
makeInformationTask question initial context actions actionStored tst=:{taskNr, newTask, treeType}
# taskId = taskNrToString taskNr
# editorId = "tf-" +++ taskNrToString taskNr
# (ovalue,tst) = readValue initial tst
# (omask,tst) = readMask initial tst
# buttonActions = getButtonActions actions
# (anyEvent,tst) = anyEvents tst
| newTask || not anyEvent
// generate TUI definition
# (form,valid) = visualizeAsEditor editorId Nothing omask ovalue
# menuActions = evaluateConditions (getMenuActions actions) valid ovalue
# buttonActions = evaluateConditions buttonActions valid ovalue
# tst = setTUIDef (taskPanel taskId (html question) context (Just form) (makeButtons editorId buttonActions)) (html question) menuActions tst
= (TaskBusy,tst)
| otherwise
//Check for events
# (events,tst) = getEvents tst
| isEmpty events
// no change for this task
# tst = setTUIUpdates [] [] tst
= case treeType of
SpineTree
= (TaskBusy,tst)
| otherwise
# (nvalue,nmask,tst) = applyUpdates [(s2dp key,value) \\ (key,value) <- events | isdps key] ovalue omask tst
# (action,tst) = getAction events (map fst buttonActions) tst
| isJust action = (TaskFinished (fromJust action,nvalue),tst)
UITree
# (anyEvent,tst) = anyEvents tst
| newTask || not anyEvent
// generate TUI definition
# (form,valid) = visualizeAsEditor editorId Nothing omask ovalue
# menuActions = evaluateConditions (getMenuActions actions) valid ovalue
# buttonActions = evaluateConditions buttonActions valid ovalue
# tst = setTUIDef (taskPanel taskId (html question) context (Just form) (makeButtons editorId buttonActions)) (html question) menuActions tst
= (TaskBusy,tst)
| otherwise
# tst = setTaskStore "value" nvalue tst
# tst = setTaskStore "mask" nmask tst
# updpaths = events2Paths events
# (updates,valid) = determineEditorUpdates editorId Nothing updpaths omask nmask ovalue nvalue
# menuActions = evaluateConditions (getMenuActions actions) valid nvalue
# buttonActions = evaluateConditions buttonActions valid nvalue
# tst = setTUIUpdates (enables editorId buttonActions ++ updates) menuActions tst
= (TaskBusy, tst)
//Check for events
# (events,tst) = getEvents tst
| isEmpty events
// no change for this task
# tst = setTUIUpdates [] [] tst
= (TaskBusy,tst)
| otherwise
# (nvalue,nmask,tst) = applyUpdates [(s2dp key,value) \\ (key,value) <- events | isdps key] ovalue omask tst
# (action,tst) = getAction events (map fst buttonActions) tst
| isJust action
= (TaskFinished (fromJust action,nvalue),tst)
| otherwise
# tst = setTaskStore "value" nvalue tst
# tst = setTaskStore "mask" nmask tst
# updpaths = events2Paths events
# (updates,valid) = determineEditorUpdates editorId Nothing updpaths omask nmask ovalue nvalue
# menuActions = evaluateConditions (getMenuActions actions) valid nvalue
# buttonActions = evaluateConditions buttonActions valid nvalue
# tst = setTUIUpdates (enables editorId buttonActions ++ updates) menuActions tst
= (TaskBusy, tst)
where
readValue initial tst
# (mbvalue,tst) = getTaskStore "value" tst
......
......@@ -6,7 +6,7 @@ from TSt import :: Task, :: TSt(..), :: IWorld(..), :: Store, :: HTTPRequest, ::
from TSt import mkInstantTask, mkMonitorTask, accWorldTSt
import Types
from TaskTree import :: TaskTree, :: TaskInfo, :: TaskPriority(..), ::TaskParallelType(..)
from TaskTree import :: TaskTree, :: TaskInfo, :: TaskPriority(..), ::TaskParallelType(..), :: TreeType(..)
from TaskTree import :: TaskProperties(..), :: SystemProperties(..), :: WorkerProperties, :: ManagerProperties(..)
from Time import :: Timestamp, :: Clock(..), clock
......
......@@ -300,7 +300,7 @@ where
= (result,{TSt|tst & tree = node})
createOrEvaluateTaskInstance :: !(Maybe TaskParallelType) !(Task a) !*TSt -> (!TaskResult a, !TaskTree, !*TSt) | iTask a
createOrEvaluateTaskInstance mbpartype task tst=:{TSt|taskNr,events}
createOrEvaluateTaskInstance mbpartype task tst=:{TSt|taskNr,events,treeType}
//Try to load the stored process for this subtask
# taskId = taskNrToString taskNr
# (mbProc,tst) = getProcess taskId tst
......@@ -320,7 +320,7 @@ createOrEvaluateTaskInstance mbpartype task tst=:{TSt|taskNr,events}
# user = proc.Process.properties.managerProperties.ManagerProperties.worker
# tst = addSubTaskWorker taskId user mbpartype tst
// -> TSt in subprocess
# (result,tree,tst) = evaluateTaskInstance proc events Nothing False False tst
# (result,tree,tst) = evaluateTaskInstance proc treeType events Nothing False False tst
// <- TSt back to current process
//Add parallel type after the new proc is evaluated
= case result of
......
......@@ -7,7 +7,7 @@ import RPC
handleRPCListRequest :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCListRequest request tst
# (forest, tst) = calculateTaskForest [] tst
# (forest, tst) = ([],tst) //calculateTaskForest [] tst
# (rpcinfos, tst) = determineRPCItems forest tst
= ({http_emptyResponse & rsp_data = toString (toJSON rpcinfos)},tst)
......@@ -24,7 +24,7 @@ determineTreeRPCItems _ = []
handleRPCUpdates :: !HTTPRequest !*TSt -> (!HTTPResponse, !*TSt)
handleRPCUpdates request tst
# (tree, tst) = calculateTaskTree procId [] tst //TODO add updates
# (tree, tst) = calculateTaskTree procId SpineTree [] tst //TODO add updates
# tst = updateTimeStamps procId tst
= case tree of
(TTFinishedTask ti _) = finished tst
......
......@@ -29,16 +29,22 @@ JSONEncode{|TaskTree|} (TTGroupedTask a0 a1 a2 a3)
= [JSONArray [JSONString "TTGroupedTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1 ++ JSONEncode{|*|} a3]] //DOES NOT INCLUDE a2
JSONEncode{|TaskTree|} (TTInteractiveTask a0 a1)
= [JSONArray [JSONString "TTInteractiveTask":JSONEncode{|*|} a0]]
= [JSONArray [JSONString "TTInteractiveTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTMonitorTask a0 a1)
= [JSONArray [JSONString "TTMonitorTask":JSONEncode{|*|} a0]]
= [JSONArray [JSONString "TTMonitorTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTInstructionTask a0 a1)
= [JSONArray [JSONString "TTInstructionTask":JSONEncode{|*|} a0]]
= [JSONArray [JSONString "TTInstructionTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTFinishedTask a0 a1)
= [JSONArray [JSONString "TTFinishedTask":JSONEncode{|*|} a0]]
= [JSONArray [JSONString "TTFinishedTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskTree|} (TTRpcTask a0 a1)
= [JSONArray [JSONString "TTRpcTask":JSONEncode{|*|} a0]]
= [JSONArray [JSONString "TTRpcTask":JSONEncode{|*|} a0 ++ JSONEncode{|*|} a1]]
JSONEncode{|TaskOutput|} fx NoOutput = [JSONNull]
JSONEncode{|TaskOutput|} fx (UIOutput _) = [JSONString "User Interface Definition"]
JSONEncode{|TaskOutput|} fx (JSONOutput v) = [v]
JSONEncode{|InteractiveTask|} _ = [JSONNull]
JSONEncode{|Timestamp|} (Timestamp x) = JSONEncode{|*|} x
JSONDecode{|Timestamp|} [JSONInt x:c] = (Just (Timestamp x),c)
......@@ -104,7 +110,11 @@ taskService url html path req tst
Nothing
= (notFoundResponse req, tst)
Just proc
# (tree,tst) = calculateTaskTree taskId [] tst
# treeType = case typeParam of
"ui" = UITree
"json" = JSONTree
_ = SpineTree
# (tree,tst) = calculateTaskTree taskId treeType [] tst
# json = JSONObject [("success",JSONBool True),("task",toJSON proc),("tree",toJSON tree)]
= (serviceResponse html "Task debug" taskDebugDescription url debugParams json, tst)
//Show / Update task user interface definition
......@@ -127,7 +137,7 @@ taskService url html path req tst
//The menusChanged parameter is a global flag that is set when any task in the tree has
//changed the menu and thus the menu needs to be replaced
# (tree,tst=:{TSt|menusChanged})
= calculateTaskTree taskId events tst
= calculateTaskTree taskId UITree events tst
= case tree of
(TTMainTask ti properties menus _ content)
# tui = buildTaskPanel content menus menusChanged session.Session.user
......@@ -223,12 +233,13 @@ where
listParams = [("session",sessionParam,True),("user",userParam,False)]
debugParams = [("session",sessionParam,True)]
debugParams = [("session",sessionParam,True),("type",typeParam,False)]
typeParam = paramValue "type" req
detailsParams = [("session",sessionParam,True)]
tuiParams = [("session",sessionParam,True),("events",eventsParam,False)]
eventsParam = paramValue "events" req
propParams = [("session",sessionParam,True),("update",updateParam,False)]
updateParam = paramValue "update" req
......
......@@ -24,6 +24,7 @@ import GenPrint, GenParse, GenVisualize, GenUpdate
:: *TSt = { taskNr :: !TaskNr // for generating unique form-id's
, taskInfo :: !TaskInfo // task information available to tasks
, tree :: !TaskTree // accumulator for constructing a task tree
, treeType :: !TreeType // the type of task tree that is to be constructed
, newTask :: !Bool // does the task run for the first time
, events :: ![TaskEvent] // The update events for interactive tasks
......@@ -134,6 +135,7 @@ garbageCollectTaskInstance :: !ProcessId !*TSt -> (!Bool,!*TSt)
* Evaluates an existing task instance
*
* @param Process information from the process database
* @param The type of task tree to build
* @param The value updates to apply
* @param Optionally a new Change that is to be applied to this task instance
* @param Is the instance evaluated as top node, or as subnode while evaluating a parent process
......@@ -142,7 +144,7 @@ garbageCollectTaskInstance :: !ProcessId !*TSt -> (!Bool,!*TSt)
*
* @return The modified task state
*/
evaluateTaskInstance :: !Process ![TaskEvent] !(Maybe ChangeInjection) !Bool !Bool !*TSt-> (!TaskResult Dynamic, !TaskTree, !*TSt)
evaluateTaskInstance :: !Process !TreeType ![TaskEvent] !(Maybe ChangeInjection) !Bool !Bool !*TSt-> (!TaskResult Dynamic, !TaskTree, !*TSt)
/**
* Applies a change to a running task process task state.
*
......@@ -157,13 +159,14 @@ applyChangeToTaskTree :: !ProcessId !ChangeInjection !*TSt -> *TSt
* Calculates a single task tree for a given process id
*
* @param The task id of the process
* @param The type of task tree to build
* @param The value updates to apply
* @param The task state
*
* @return Just an HtmlTree when the process is found, Nothing on failure
* @return The modified task state
*/
calculateTaskTree :: !TaskId ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree :: !TaskId !TreeType ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
/**
* Render resultpanel from a task which is not process
*
......@@ -175,16 +178,6 @@ calculateTaskTree :: !TaskId ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
**/
calculateTaskResult :: !TaskId !*TSt -> (!TaskTree, !*TSt)
/**
* Calculates all task trees
*
* @param The value updates to apply
* @param The task state
*
* @return The list of task trees (task forest)
* @return The modified task state
*/
calculateTaskForest :: ![TaskEvent] !*TSt -> (![TaskTree], !*TSt)
/**
* Lists which workflows are available
*
* @param The task state
......
......@@ -32,6 +32,7 @@ mkTSt appName config request workflows store world
= { taskNr = []
, taskInfo = initTaskInfo
, tree = TTMainTask initTaskInfo initTaskProperties Nothing Nothing (TTFinishedTask initTaskInfo NoOutput)
, treeType = SpineTree
, newTask = True
, events = []
, properties = initTaskProperties
......@@ -157,7 +158,7 @@ createTaskInstance thread=:(Container {TaskThread|originalTask} :: Container (Ta
# tst = storeThread processId thread tst
| activate
//If directly active, evaluate the process once to kickstart automated steps that can be set in motion immediately
# (result,tree,tst) = evaluateTaskInstance process [] Nothing toplevel True {tst & staticInfo = {tst.staticInfo & currentProcessId = processId}}
# (result,tree,tst) = evaluateTaskInstance process SpineTree [] Nothing toplevel True {tst & staticInfo = {tst.staticInfo & currentProcessId = processId}}
= (processId,result,tree,tst)
| otherwise
= (processId, TaskBusy, node properties processId, tst)
......@@ -217,8 +218,8 @@ loadThread processId tst=:{TSt|iworld = iworld =:{IWorld|store,world}}
//END NEW THREAD FUNCTIONS
//Computes a workflow (sub) process
evaluateTaskInstance :: !Process ![TaskEvent] !(Maybe ChangeInjection) !Bool !Bool !*TSt-> (!TaskResult Dynamic, !TaskTree, !*TSt)
evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount, inParallelType} events newChange isTop firstRun tst=:{TSt|currentChange,pendingChanges,tree=parentTree,events=parentEvents,properties=parentProperties,menus=parentMenus}
evaluateTaskInstance :: !Process !TreeType ![TaskEvent] !(Maybe ChangeInjection) !Bool !Bool !*TSt-> (!TaskResult Dynamic, !TaskTree, !*TSt)
evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount, inParallelType} treeType events newChange isTop firstRun tst=:{TSt|currentChange,pendingChanges,tree=parentTree,treeType=parentTreeType,events=parentEvents,properties=parentProperties,menus=parentMenus}
// Update access timestamps in properties
# (now,tst) = accWorldTSt time tst
# properties = {properties & systemProperties = {properties.systemProperties
......@@ -227,7 +228,7 @@ evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount,
Nothing = Just now
Just t = Just t }}
// Reset the task state
# tst = resetTSt taskId events properties inParallelType tst
# tst = resetTSt taskId treeType events properties inParallelType tst
// Queue all stored persistent changes (only when run as top node)
# tst = if isTop (loadPersistentChanges taskId tst) tst
// When a change is injected set it as active change
......@@ -250,7 +251,7 @@ evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount,
# (tree,tst) = normalizeInteractiveTasks tree tst
// Store the adapted persistent changes
# tst = if isTop (storePersistentChanges taskId tst) tst
# tst = restoreTSt parentTree parentEvents parentProperties parentMenus tst
# tst = restoreTSt parentTree parentTreeType parentEvents parentProperties parentMenus tst
= case result of
TaskBusy
//Update process table (changeCount & properties)
......@@ -271,7 +272,7 @@ evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount,
Nothing
= (result,tree,tst)
Just parentProcess
# (_,_,tst) = evaluateTaskInstance parentProcess events Nothing True False tst
# (_,_,tst) = evaluateTaskInstance parentProcess treeType events Nothing True False tst
= (result,tree,tst)
| otherwise
= (result,tree,tst)
......@@ -288,18 +289,18 @@ evaluateTaskInstance process=:{Process | taskId, properties, menus, changeCount,
# (_,tst) = updateProcess taskId (\p -> {Process|p & properties = properties, menus = menus, changeCount = changeCount }) tst
= (TaskException e, tree, tst)
where
resetTSt :: !TaskId ![TaskEvent] !TaskProperties !(Maybe TaskParallelType) !*TSt -> *TSt
resetTSt taskId events properties inptype tst
resetTSt :: !TaskId !TreeType ![TaskEvent] !TaskProperties !(Maybe TaskParallelType) !*TSt -> *TSt
resetTSt taskId treeType events properties inptype tst
# taskNr = taskNrFromString taskId
# info = { initTaskInfo
& taskId = taskId
, taskLabel = properties.managerProperties.subject
}
# tree = TTMainTask info properties menus inptype (TTFinishedTask info NoOutput)
= {TSt| tst & taskNr = taskNr, tree = tree, events = events, staticInfo = {tst.staticInfo & currentProcessId = taskId}}
= {TSt| tst & taskNr = taskNr, tree = tree, treeType = treeType, events = events, staticInfo = {tst.staticInfo & currentProcessId = taskId}}
restoreTSt :: !TaskTree ![TaskEvent] !TaskProperties !(Maybe [Menu]) !*TSt -> *TSt
restoreTSt tree events properties menus tst = {TSt|tst & tree = tree, events = events, properties = properties, menus = menus}
restoreTSt :: !TaskTree !TreeType ![TaskEvent] !TaskProperties !(Maybe [Menu]) !*TSt -> *TSt
restoreTSt tree treeType events properties menus tst = {TSt|tst & tree = tree, treeType = treeType, events = events, properties = properties, menus = menus}
/*
* Load all stored persistent changes that are applicable to the current (sub) process.
* In case of evaluating a subprocess, this also includes the changes that have been injected
......@@ -495,7 +496,7 @@ applyChangeToTaskTree pid (lifetime,change) tst=:{taskNr,taskInfo,tree,staticInf
# (mbProcess,tst) = getProcess pid tst
= case mbProcess of
(Just proc)
# (_,_,tst) = evaluateTaskInstance proc [] (Just (lifetime,change)) True False tst
# (_,_,tst) = evaluateTaskInstance proc SpineTree [] (Just (lifetime,change)) True False tst
= {tst & taskNr = taskNr, taskInfo = taskInfo,properties = properties, menus = menus
, tree = tree, staticInfo = staticInfo, currentChange = currentChange, pendingChanges = pendingChanges}
Nothing
......@@ -525,8 +526,8 @@ calculateTaskResult taskId tst
}
= (TTFinishedTask info result, {TSt | tst & iworld = {IWorld | iworld & store = store, world = world}})
calculateTaskTree :: !TaskId ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree taskId events tst
calculateTaskTree :: !TaskId !TreeType ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree taskId treeType events tst
# (mbProcess,tst) = getProcess taskId tst
= case mbProcess of
Nothing
......@@ -540,7 +541,7 @@ calculateTaskTree taskId events tst
= case properties.systemProperties.SystemProperties.status of
Active
//Evaluate the process
# (result,tree,tst) = evaluateTaskInstance process events Nothing True False tst
# (result,tree,tst) = evaluateTaskInstance process treeType events Nothing True False tst
= (tree,tst)
_
//retrieve process result from store and show it??
......@@ -559,17 +560,6 @@ calculateTaskTree taskId events tst
renderResult :: Dynamic -> [HtmlTag]
renderResult (Container value :: Container a a) = visualizeAsHtmlDisplay value
calculateTaskForest :: ![TaskEvent] !*TSt -> (![TaskTree], !*TSt)
calculateTaskForest events tst
# (processes, tst) = getProcesses [Active] tst
= calculateTrees [taskId \\ {Process|taskId,properties} <- processes | isNothing properties.systemProperties.parent] tst
where
calculateTrees [] tst = ([],tst)
calculateTrees [p:ps] tst
# (tree,tst) = calculateTaskTree p events tst
# (trees,tst) = calculateTrees ps tst
= ([tree:trees],tst)
getCurrentSession :: !*TSt -> (!Session, !*TSt)
getCurrentSession tst =:{staticInfo} = (staticInfo.currentSession, tst)
......
......@@ -40,9 +40,14 @@ from TUIDefinition import :: TUIDef, :: TUIUpdate
//A task that represents an rpc invocation
| TTRpcTask TaskInfo RPCExecute
// Different trees can be constructed.
:: TreeType = SpineTree //Only construct the the spine, with minimal output
| UITree //Generate user interfaces for the leaf nodes
| JSONTree //Generate the JSON representation of the current value at leaf nodes
// 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
......
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