Commit a4a835d7 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@157 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent caebf050
......@@ -95,7 +95,7 @@ workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a))
/* iTask Workflow process management:
spawnWorkflow :: spawn an iTask workflow as a new separate process, Wid is a handle to that process, bool indicates whether it is active or suspended
waitForWorkflow :: wait until the indicated process is finished and obtain the resulting value
waitForWorkflow :: wait until the indicated process is finished and obtain the resulting value; returns Nothing when process is deleted
getWorkflowStatus :: get status of workflow
deleteWorkflow :: delete iTask workflow; returns False if workflow does not exist anymore
suspendWorkflow :: suspend iTask workflow, all corresponding tasks will vanish temporally; returns False if workflow does not exist anymore
......@@ -104,21 +104,21 @@ activateWorkflow :: activate the iTask workflow again; returns False if workflo
suspendMe :: suspend current workflow process; no effect on start task
deleteMe :: delete current workflow process; no effect on start task
changeWorkflowUser :: transfer the workflow task to the indicated user; returns False if workflow does not exist anymore
*/
spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a
waitForWorkflow :: !(Wid a) -> Task a | iData a
waitForWorkflow :: !(Wid a) -> Task (Maybe a ) | iData a
getWorkflowStatus :: !(Wid a) -> Task WorkflowStatus
activateWorkflow :: !(Wid a) -> Task Bool
suspendWorkflow :: !(Wid a) -> Task Bool
deleteWorkflow :: !(Wid a) -> Task Bool
changeWorkflowUser :: !UserId !(Wid a) -> Task Bool
suspendMe :: (Task Void)
deleteMe :: (Task Void)
changeWorkflowUser :: !UserId !(Wid a) -> Task Bool
// *********************************************************************************************************************************
/* Here follow the iTasks combinators:
......
......@@ -202,7 +202,6 @@ where
toString AnyThread = "AnyThread"
toString _ = "??? print error in thread"
determineUserOptions :: ![StartUpOptions] -> UserStartUpOptions
determineUserOptions startUpOptions = determineUserOptions` startUpOptions defaultStartUpOptions
where
......@@ -303,12 +302,11 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
]
],hst)
// Here the iTasks are evaluated ...
# maintask = scheduleWorkflows maintask //
# maintask = scheduleWorkflows maintask // schedule all active tasks, not only maintask
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= /*scheduleNewWorkflows*/ ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
= ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
// epilogue
......@@ -406,9 +404,6 @@ where
mktable table = [Tr [] (mkrow rows) \\ rows <- table]
mkrow rows = [Td [Td_VAlign Alo_Top] [row] \\ row <- rows]
// Collect :: !UserId !UserId [(WorkflowLabel,TaskLabel,[BodyTag])] !HtmlTree -> (![BodyTag],![(WorkflowLabel,TaskLabel,[BodyTag])])
Filter :: !Bool !UserId !HtmlTree !*HSt -> *(![BodyTag],![BodyTag],![BodyTag],![BodyTag],![BodyTag],!*HSt)
Filter wholepage thrOwner tree hst
# startuser = if wholepage defaultUser thrOwner
......@@ -524,7 +519,6 @@ where
mode i j
| i==j = Display
= Edit
SelectStore :: !(String,Int) !TaskNr !Options (Int -> Int) *HSt -> (Int,*HSt)
......@@ -673,9 +667,14 @@ isDeletedWorkflow (DeletedWorkflow _) = True
isDeletedWorkflow _ = False
workflowProcessStore :: !((!Int,![WorflowProcess]) -> (!Int,![WorflowProcess])) !*TSt -> (!(!Int,![WorflowProcess]),!*TSt)
workflowProcessStore wfs tst=:{hst}
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName (0,[]) <@ NoForm) wfs hst
= (form.value,{tst & hst = hst})
workflowProcessStore wfs tst
= IF_ClientTasks
(abort "Cannot access workflow process table on cleint\n") // workflow table only on server site
(workflowProcessStore` wfs tst) // access workflow store
where
workflowProcessStore` wfs tst=:{hst}
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName (0,[]) <@ NoForm) wfs hst
= (form.value,{tst & hst = hst})
scheduleWorkflows :: !(Task a) -> (Task a) | iData a
scheduleWorkflows maintask = scheduleWorkflows`
......@@ -698,23 +697,6 @@ scheduleWorkflowTable done [FinishedWorkflow _ _ (TCl dyntask):wfls] procid tst
scheduleWorkflowTable done [DeletedWorkflow _:wfls] procid tst
= scheduleWorkflowTable done wfls (inc procid) tst
/*
scheduleNewWorkflows main tst=:{hst}
# (wfls,hst) = workflowProcessStore id hst // read workflow process administration
# lengthwfls = length wfls
# (res,tst=:{activated}) = main {tst & hst = hst} // calculate workflows
# (done,tst) = scheduleNewProcess lengthwfls tst
= (res,{tst & activated = activated && done})
where
scheduleNewProcess lengthwfls tst=:{hst}
# (nwfls,hst) = workflowProcessStore id hst // read workflow process administration
# lengthnwfls = length nwfls
| lengthnwfls > lengthwfls
# (done,tst) = (scheduleWorkflowTable True (drop lengthwfls nwfls) (lengthwfls + 1)) {tst & hst = hst,activated = True} // calculate this one as well
= scheduleNewProcess lengthnwfls tst
= (True,{tst & hst = hst})
*/
spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a
spawnWorkflow userid active (label,task) = \tst=:{options,staticInfo} -> (newTask ("spawn " +++ label) (spawnWorkflow` options)<<@ staticInfo.threadTableLoc) tst
where
......@@ -752,7 +734,7 @@ where
| not activated = (dyn,tst) // not finished, return
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
# wfls = case (wfls!!(entry - 1)) of // update process administration
(ActiveWorkflow _ acttask) -> updateAt (entry - 1) (FinishedWorkflow (userid,processid,label) dyn acttask) wfls
(ActiveWorkflow _ acttask) -> updateAt (entry - 1) (FinishedWorkflow (currentWorker,processid,label) dyn acttask) wfls
_ -> wfls
# (wfls,tst) = workflowProcessStore (\_ -> (processid,wfls)) tst // write workflow process administration
= (dyn,tst)
......@@ -771,7 +753,7 @@ where
# (wfls,tst) = workflowProcessStore (\_ -> (maxid,nwfls)) tst // update workflow process administration
= (True,tst) // if everything is fine it should always succeed
waitForWorkflow :: !(Wid a) -> Task a | iData a
waitForWorkflow :: !(Wid a) -> Task (Maybe a) | iData a
waitForWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("waiting for " +++ label) waitForResult`
where
waitForResult` tst
......@@ -780,8 +762,8 @@ where
# refok = isValidWorkflowReference wfl ids
| not refok = (createDefault,{tst & activated = False}) // wid does not refer to the correct entry anymore
= case wfl of // update process administration
(FinishedWorkflow _ (val::a^) _) -> (val,{tst & activated = True}) // finished
_ -> (createDefault,{tst & activated = False}) // not yet
(FinishedWorkflow _ (val::a^) _) -> (Just val,{tst & activated = True}) // finished
_ -> (Nothing,{tst & activated = False}) // not yet
deleteMe :: (Task Void)
deleteMe = deleteMe`
......@@ -872,9 +854,14 @@ where
showWorkflows :: !Bool !*TSt -> (![BodyTag],*TSt)
showWorkflows alldone tst
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
= (mkTable wfls,tst)
= IF_ClientTasks
(\tst -> ([],tst)) // workflow table not available on clients
(showWorkflows` alldone) tst // show tables
where
showWorkflows` alldone tst
# ((_,wfls),tst) = workflowProcessStore id tst // read workflow process administration
= (mkTable wfls,tst)
mkTable [] = []
mkTable wfls = [showLabel ("Workflow Process Table:"),
STable [] ( [ [showTrace "Entry:", showTrace "User Id:", showTrace "Process Id:", showTrace "Task Name:", showTrace "Status:"]
......@@ -2162,7 +2149,7 @@ where
updateAt` n x [y:ys] = [y : updateAt` (n-1) x ys]
printTrace2 Nothing = EmptyBody
printTrace2 (Just a) = BodyTag [showLabel "Task Tree:", Br, STable emptyBackground (print False a),Hr []]
printTrace2 (Just a) = BodyTag [showLabel "Task Tree Forest:", Br, STable emptyBackground (print False a),Hr []]
where
print _ [] = []
print b trace = [pr b x ++ [STable emptyBackground (print (isDone x||b) xs)]\\ (Trace x xs) <- trace]
......
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