Commit 4a27fbf4 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@141 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent d47d2b05
...@@ -264,17 +264,17 @@ where ...@@ -264,17 +264,17 @@ where
// ****************************************************************************************************** // ******************************************************************************************************
startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a
startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintask tst=:{hst,tasknr,staticInfo} startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintaskorg tst=:{hst,tasknr,staticInfo}
// prologue // prologue
# maintask = activateWorkflows maintask // force main process to start on tasknr 0.1 # maintask = scheduleWorkflows maintaskorg // force main process to start on tasknr 0.1
| thisUser < 0 = abort "Users should have id's >= 0 !\n" | thisUser < 0 = abort "Users should have id's >= 0 !\n"
# (refresh,hst) = simpleButton refreshId "Refresh" id hst # (refresh,hst) = simpleButton refreshId "Refresh" id hst
# (traceAsked,hst) = simpleButton traceId "ShowTrace" (\_ -> True) hst # (traceAsked,hst) = simpleButton traceId "ShowTrace" (\_ -> True) hst
# doTrace = traceAsked.value False # doTrace = traceAsked.value False
# versionsOn = IF_ClientTasks False versionCheckOn // no version control on client # versionsOn = IF_ClientTasks False versionCheckOn // no version control on client
# noNewVersion = not versionsOn || refresh.changed || traceAsked.changed || userchanged // no version control in these cases # noNewVersion = not versionsOn || refresh.changed || traceAsked.changed || userchanged // no version control in these cases
# (appversion,hst) = setAppversion inc hst # (appversion,hst) = setAppversion inc hst
...@@ -294,11 +294,11 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor ...@@ -294,11 +294,11 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
],hst) ],hst)
// Here the iTask starts... // Here the iTasks are evaluated ...
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated}) # ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= (IF_Ajax (startAjaxApplication thisUser pversion) startMainTask) = calculateNewWorkflows ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
maintask {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []} maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
// epilogue // epilogue
...@@ -349,7 +349,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor ...@@ -349,7 +349,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
] ]
,hst) ,hst)
where where
// wrap maintask = activateWorkflows (newTask "main" (assignTaskTo False 0 ("main",maintask))) // wrap maintask = scheduleWorkflows (newTask "main" (assignTaskTo False 0 ("main",maintask)))
// where // where
// clearIStore hst=:{world} /* would be nice but don't know how to clear this */ // clearIStore hst=:{world} /* would be nice but don't know how to clear this */
// # world = if testModeOn deleteAllStateFiles id world // # world = if testModeOn deleteAllStateFiles id world
...@@ -632,30 +632,37 @@ workflowProcessStore wfs hst ...@@ -632,30 +632,37 @@ workflowProcessStore wfs hst
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName [] <@ NoForm) wfs hst # (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName [] <@ NoForm) wfs hst
= (form.value,hst) = (form.value,hst)
activateWorkflows :: !(Task a) -> (Task a) | iData a scheduleWorkflows :: !(Task a) -> (Task a) | iData a
activateWorkflows maintask = activateWorkflows` scheduleWorkflows maintask = scheduleWorkflows`
where where
activateWorkflows` tst=:{hst} scheduleWorkflows` tst=:{hst}
# (a,tst=:{activated,hst}) = newTask defaultWorkflowName (assignTaskTo False 0 ("main",maintask)) tst // start maintask # (a,tst=:{activated,hst}) = newTask defaultWorkflowName (assignTaskTo False 0 ("main",maintask)) tst // start maintask
# (wfls,hst) = workflowProcessStore id hst // read workflow process administration # (wfls,hst) = workflowProcessStore id hst // read workflow process administration
# (done,tst) = activateAll True wfls 0 {tst & hst = hst,activated = True} // all added workflows processes are inspected (THIS NEEDS TO BE OPTIMIZED AT SOME STAGE) # (done,tst) = calculateWorkflows True wfls 0 {tst & hst = hst,activated = True} // all added workflows processes are inspected (THIS NEEDS TO BE OPTIMIZED AT SOME STAGE)
= (a,{tst & activated = activated && done}) // whole application ends when all processes have ended = (a,{tst & activated = activated && done}) // whole application ends when all processes have ended
where
activateAll done [] _ tst = (done,tst) calculateWorkflows done [] _ tst = (done,tst)
calculateWorkflows done [ActiveWorkflow _ (TCl dyntask):wfls] procid tst
activateAll done [ActiveWorkflow _ (TCl dyntask):wfls] procid tst # (_,tst=:{activated}) = dyntask {tst & activated = True}
# (_,tst=:{activated}) = dyntask tst = calculateWorkflows (done && activated) wfls (inc procid) {tst & activated = activated}
= activateAll (done && activated) wfls (inc procid) {tst & activated = activated} calculateWorkflows done [SuspendedWorkflow _ _:wfls] procid tst
= calculateWorkflows done wfls (inc procid) tst
activateAll done [SuspendedWorkflow _ _:wfls] procid tst calculateWorkflows done [FinishedWorkflow _ _ (TCl dyntask):wfls] procid tst // just to show result in trace..
= activateAll done wfls (inc procid) tst # (_,tst) = dyntask tst
= calculateWorkflows done wfls (inc procid) tst
activateAll done [FinishedWorkflow _ _ (TCl dyntask):wfls] procid tst // just to show result in trace.. calculateWorkflows done [DeletedWorkflow _:wfls] procid tst
# (_,tst) = dyntask tst = calculateWorkflows done wfls (inc procid) tst
= activateAll done wfls (inc procid) tst
calculateNewWorkflows main tst=:{hst}
activateAll done [DeletedWorkflow _:wfls] procid tst # (wfls,hst) = workflowProcessStore id hst // read workflow process administration
= activateAll done wfls (inc procid) tst # lengthwfls = length wfls
# (res,tst=:{hst}) = main {tst & hst = hst} // calculate workflows
# (nwfls,hst) = workflowProcessStore id hst // read workflow process administration
# lengthnwfls = length nwfls
| lengthnwfls > lengthwfls // more workflows processes have been added in the mean time
# (done,tst) = (calculateWorkflows True (drop (length wfls) nwfls) lengthwfls) {tst & hst = hst,activated = True} // calculate this one as well
= calculateNewWorkflows (\tst -> (res,tst)) tst
= (res,{tst & hst = hst})
spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a 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 spawnWorkflow userid active (label,task) = \tst=:{options,staticInfo} -> (newTask ("spawn " +++ label) (spawnWorkflow` options)<<@ staticInfo.threadTableLoc) tst
...@@ -1920,7 +1927,7 @@ where ...@@ -1920,7 +1927,7 @@ where
# (val,tst=:{activated,trace}) = mytask tst // active, so perform task and get its result # (val,tst=:{activated,trace}) = mytask tst // active, so perform task and get its result
# tst = {tst & tasknr = tasknr, options = options, userId = userId} # tst = {tst & tasknr = tasknr, options = options, userId = userId}
| isNothing trace || taskname == "" = (val,tst) // no trace, just return value | isNothing trace || taskname == "" = (val,tst) // no trace, just return value
= (val,{tst & trace = Just (InsertTrace activated tasknr userId options taskname (printToString val) (fromJust trace))}) // adjust trace = (val,{tst & trace = Just (InsertTrace activated tasknr userId options taskname (printToString val%(0,30)) (fromJust trace))}) // adjust trace, don't print to long values
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
mkParSubTask name i task = mkParSubTask` mkParSubTask name i task = mkParSubTask`
......
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