Commit 9c486898 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

made quick fix such that the main process can be started several times

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@359 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent fe974f1b
...@@ -6,4 +6,4 @@ import InternaliTasksCommon ...@@ -6,4 +6,4 @@ import InternaliTasksCommon
/** /**
* Handles the ajax requests from the 'start new work' panel. * Handles the ajax requests from the 'start new work' panel.
*/ */
handleNewListRequest :: !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) handleNewListRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt)
\ No newline at end of file \ No newline at end of file
...@@ -12,11 +12,10 @@ import InternaliTasksCommon ...@@ -12,11 +12,10 @@ import InternaliTasksCommon
derive JSONEncode NewWorkItem derive JSONEncode NewWorkItem
handleNewListRequest :: !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) handleNewListRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt)
handleNewListRequest request session hst handleNewListRequest (label,task) mainuser request session hst
= ({http_emptyResponse & rsp_data = toJSON itemlist}, hst) = ({http_emptyResponse & rsp_data = toJSON itemlist}, hst)
where where
itemlist = [ {icon = "editTask", label = "Workflow 1"} itemlist = [ {icon = "editTask", label = label}
, {icon = "editTask", label = "Workflow 2"}
] ]
...@@ -6,4 +6,4 @@ import InternaliTasksCommon ...@@ -6,4 +6,4 @@ import InternaliTasksCommon
/** /**
* Handles the ajax requests from the 'start new work' panel. * Handles the ajax requests from the 'start new work' panel.
*/ */
handleNewStartRequest :: !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) handleNewStartRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file \ No newline at end of file
...@@ -12,12 +12,21 @@ import InternaliTasksCommon ...@@ -12,12 +12,21 @@ import InternaliTasksCommon
derive JSONEncode NewWorkItem derive JSONEncode NewWorkItem
handleNewStartRequest :: !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) handleNewStartRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleNewStartRequest request session hst handleNewStartRequest labeledTask mainuser request session hst
= ({http_emptyResponse & rsp_data = response}, hst) # (taskid,hst) = startNewProcess labeledTask hst
= ({http_emptyResponse & rsp_data = response taskid}, hst)
where where
workflow = http_getValue "workflow" request.arg_get "" workflow = http_getValue "workflow" request.arg_get ""
response = "{\"success\" : true, \"taskid\": \"" +++ taskid workflow +++ "\"}" response taskid = "{\"success\" : true, \"taskid\": \"" +++ (toString taskid) /* workflow */ +++ "\"}"
taskid "Workflow 1" = "123.0" thisUser = session.Session.userId // fetch user id from the session
taskid "Workflow 2" = "32.0"
\ No newline at end of file startNewProcess labeledTask hst
# tst = mkTst mainuser LSTxtFile LSTxtFile hst // create initial tst
# (processId, tst) = latestProcessId tst
# (wid,tst=:{hst}) = appTaskTSt (spawnWorkflow thisUser True labeledTask) {tst & tasknr = [processId]}
= (getProcessId wid, hst)
import iTasksProcessHandling, Combinators, iTasksEditors
\ No newline at end of file
...@@ -58,8 +58,8 @@ startServer mainTask mainUser world ...@@ -58,8 +58,8 @@ startServer mainTask mainUser world
# options = ServerOptions ++ (if TraceHTTP [HTTPServerOptDebug True] []) # options = ServerOptions ++ (if TraceHTTP [HTTPServerOptDebug True] [])
= http_startServer options [((==) "/handlers/authenticate", handleAnonRequest handleAuthenticationRequest) = http_startServer options [((==) "/handlers/authenticate", handleAnonRequest handleAuthenticationRequest)
,((==) "/handlers/deauthenticate", handleSessionRequest handleDeauthenticationRequest) ,((==) "/handlers/deauthenticate", handleSessionRequest handleDeauthenticationRequest)
,((==) "/handlers/new/list", handleSessionRequest handleNewListRequest) ,((==) "/handlers/new/list", handleSessionRequest (handleNewListRequest mainTask mainUser))
,((==) "/handlers/new/start", handleSessionRequest handleNewStartRequest) ,((==) "/handlers/new/start", handleSessionRequest (handleNewStartRequest mainTask mainUser))
,((==) "/handlers/work/list", handleSessionRequest (handleWorkListRequest mainTask mainUser)) ,((==) "/handlers/work/list", handleSessionRequest (handleWorkListRequest mainTask mainUser))
,((==) "/handlers/work/tab", handleSessionRequest (handleWorkTabRequest mainTask mainUser)) ,((==) "/handlers/work/tab", handleSessionRequest (handleWorkTabRequest mainTask mainUser))
,((==) "/handlers/debug/tasktreeforest", handleSessionRequest (handleTaskTreeForestRequest mainTask mainUser)) ,((==) "/handlers/debug/tasktreeforest", handleSessionRequest (handleTaskTreeForestRequest mainTask mainUser))
......
...@@ -53,6 +53,9 @@ waitForWorkflowWid :: !String -> Task (Maybe (Wid a)) | iData a ...@@ -53,6 +53,9 @@ waitForWorkflowWid :: !String -> Task (Maybe (Wid a)) | iData a
suspendMe :: (Task Void) suspendMe :: (Task Void)
deleteMe :: (Task Void) deleteMe :: (Task Void)
getProcessId :: (Wid a) -> ProcessNr
latestProcessId :: *TSt -> (ProcessNr,*TSt)
// internally used... // internally used...
......
...@@ -71,6 +71,15 @@ gerda{|Task|} ga = abort "Cannot yet store an iTask of type TCL in a Database\n ...@@ -71,6 +71,15 @@ gerda{|Task|} ga = abort "Cannot yet store an iTask of type TCL in a Database\n
import DrupBasic import DrupBasic
getProcessId :: (Wid a) -> ProcessNr
getProcessId (Wid (entry,processIds)) = entry
latestProcessId :: *TSt -> (ProcessNr,*TSt)
latestProcessId tst
# ((processid,wfls),tst) = workflowProcessStore id tst // read workflow process administration
= (processid,tst)
isValidWorkflowReference :: !WorkflowProcess !ProcessIds -> Bool // checks whether pointer to workflow is still refering to to right entry in the table isValidWorkflowReference :: !WorkflowProcess !ProcessIds -> Bool // checks whether pointer to workflow is still refering to to right entry in the table
isValidWorkflowReference workflowprocess idsref = drop1tuple3 (getWorkflowWid workflowprocess) == drop1tuple3 idsref isValidWorkflowReference workflowprocess idsref = drop1tuple3 (getWorkflowWid workflowprocess) == drop1tuple3 idsref
where where
......
...@@ -9,10 +9,33 @@ derive gUpd [] ...@@ -9,10 +9,33 @@ derive gUpd []
Start :: *World -> *World Start :: *World -> *World
Start world = startTaskEngine myTask5 world Start world = startTaskEngine ("My mian example", StartUp simples) 0 world
StartUp :: [Task a] -> Task Void | iData a
StartUp tasks = foreverTask selectOne
where
selectOne
= chooseTask [Text "Startup a new task"]
[ ("Start Task " <+++ i, startProcess ("Start Task " <+++ i, task)) \\ task <- tasks & i <- [0..]]
#>> return_V Void
startProcess (label, task)
= spawnWorkflow 0 True (label, mytask)
#>> return_V Void
where
mytask
= task
// #>> deleteMe
// #>> return_V Void
simples = [editTask "OK 0" 0, editTask "OK 1" 1, editTask "OK 2" 2]
myTask5 myTask5
= seqTasks = andTasks
[("Coffee: 100", editTask "OK" (100,"Coffee")) [("Coffee: 100", editTask "OK" (100,"Coffee"))
,("Cappucino: 150", editTask "OK" (150,"Cappucino")) ,("Cappucino: 150", editTask "OK" (150,"Cappucino"))
,("Tea: 50", editTask "OK" (50, "Tea")) ,("Tea: 50", editTask "OK" (50, "Tea"))
......
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