Commit c117ff04 authored by Bas Lijnse's avatar Bas Lijnse

Changed the startTaskEngine to require a labeled task and a userid as main...

Changed the startTaskEngine to require a labeled task and a userid as main task. This removes the need for a toplevel "main" task of fixed user 0.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@357 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ec0ba13f
......@@ -23,7 +23,7 @@ UID_SUPPLIER2 = 2
UID_SUPPLIER3 = 3
Start :: *World -> *World
Start world = startTaskEngine (UID_CUSTOMER @:> ("Purchase product", purchaseTask)) world
Start world = startTaskEngine ("Purchase product", purchaseTask) UID_CUSTOMER world
purchaseTask :: Task Void
purchaseTask =
......@@ -49,7 +49,7 @@ selectSuppliers
collectBids :: String [(Int,String)] -> Task [((Int,String),Real)]
collectBids purchase suppliers
= andTasks
[("Collecting bid from " +++ name, uid @:: collectBid purchase supplier) \\ supplier =: (uid,name) <- suppliers]
[("Bid from " +++ name, uid @:: collectBid purchase supplier) \\ supplier =: (uid,name) <- suppliers]
where
collectBid :: String (Int,String) -> Task ((Int,String),Real)
collectBid purchase bid
......
......@@ -6,4 +6,4 @@ import InternaliTasksCommon
/**
* Handles the ajax requests for a ProcessTable tab panel.
*/
handleProcessTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
handleProcessTableRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
......@@ -9,11 +9,11 @@ import iDataForms, iDataState
/**
* Handles the ajax requests for a ProcessTable tab panel.
*/
handleProcessTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleProcessTableRequest mainTask request session hst
handleProcessTableRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleProcessTableRequest mainTask mainUser request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
= calculateTaskTree thisUserId True True True mainTask mainUser hst // calculate the TaskTree given the id of the current user
# processTable = if (isNothing maybeProcessTable) [] (fromJust maybeProcessTable)
# content = toString (DivTag [IdAttr "itasks-processtable", ClassAttr "trace"] processTable)
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......
......@@ -6,4 +6,4 @@ import InternaliTasksCommon
/**
* Handles the ajax requests for a TaskTreeForest tab panel.
*/
handleTaskTreeForestRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
handleTaskTreeForestRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
......@@ -10,11 +10,11 @@ import iDataForms, iDataState
/**
* Handles the ajax requests for a TaskTreeForest tab panel.
*/
handleTaskTreeForestRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleTaskTreeForestRequest mainTask request session hst
handleTaskTreeForestRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleTaskTreeForestRequest mainTask mainUser request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
= calculateTaskTree thisUserId True True True mainTask mainUser hst // calculate the TaskTree given the id of the current user
# taskTreeTrace = getFullTraceFromTaskTree htmlTree // calculate Task Tree
# content = toString (DivTag [IdAttr "itasks-tasktreeforest",ClassAttr "trace"] [taskTreeTrace])
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......
......@@ -6,4 +6,4 @@ import InternaliTasksCommon
/**
* Handles the ajax requests for a ThreadTable tab panel.
*/
handleThreadTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
handleThreadTableRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
......@@ -9,11 +9,11 @@ import iDataForms, iDataState
/**
* Handles the ajax requests for a ThreadTable tab panel.
*/
handleThreadTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleThreadTableRequest mainTask request session hst
handleThreadTableRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleThreadTableRequest mainTask mainUser request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
= calculateTaskTree thisUserId True True True mainTask mainUser hst // calculate the TaskTree given the id of the current user
# threadTable = if (isNothing maybeThreadTable) [] (fromJust maybeThreadTable)
# content = toString (DivTag [IdAttr "itasks-threadtable", ClassAttr "trace"] threadTable) // create tab data record
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......@@ -7,4 +7,4 @@ import InternaliTasksCommon
/**
* Handles the ajax requests from the current work filter panel.
*/
handleWorkListRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
handleWorkListRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
......@@ -27,11 +27,11 @@ import TaskTree, TaskTreeFilters, InternaliTasksCommon
derive JSONEncode WorkList, WorkListItem, TaskPriority
handleWorkListRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkListRequest mainTask request session hst
handleWorkListRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkListRequest mainTask mainUser request session hst
# uid = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable,hst)
= calculateTaskTree uid False False False mainTask hst // Calculate the TaskTree given the id of the current user
= calculateTaskTree uid False False False mainTask mainUser hst // Calculate the TaskTree given the id of the current user
# workitems = determineWorkItems uid htmlTree
# worklist = { success = True
, total = length workitems
......
......@@ -6,4 +6,4 @@ import InternaliTasksCommon
/**
* Handles the ajax requests for a work tab panel.
*/
handleWorkTabRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
handleWorkTabRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
\ No newline at end of file
......@@ -24,10 +24,10 @@ derive JSONEncode TabContent, TaskStatus, InputId, UpdateEvent, HtmlState, Stora
/**
* Handles the ajax requests for a work tab panel.
*/
handleWorkTabRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkTabRequest mainTask request session hst
handleWorkTabRequest :: !(LabeledTask a) !Int !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkTabRequest mainTask mainUser request session hst
# hst = setHStPrefix prefix hst
# (toServer, htmlTree, maybeError, _, _, hst) = calculateTaskTree thisUserId traceOn False False mainTask hst // calculate the TaskTree given the id of the current user
# (toServer, htmlTree, maybeError, _, _, hst) = calculateTaskTree thisUserId traceOn False False mainTask mainUser hst // calculate the TaskTree given the id of the current user
# (taskStatus,html,inputs) = determineTaskForTab thisUserId taskId htmlTree // filter out the code and inputs to display in this tab
# (htmlstates,hst) = getPageStates hst // Collect states that must be temporarily stored in the browser
# hst =: {states} = storeStates hst // Write states that are stored on the server
......
......@@ -3,4 +3,12 @@ definition module Startup
import iDataSettings, StdBimap
import BasicCombinators
startTaskEngine :: !(Task a) !*World -> *World | iData a
\ No newline at end of file
/**
* Starts the task engine with a single "main" workflow definition.
*
* @param A task which will be started as main task
* @param The user id of the user to whom the main task will be assigned
* @param The world
* @return The world
*/
startTaskEngine :: !(LabeledTask a) !Int !*World -> *World | iData a
\ No newline at end of file
......@@ -25,14 +25,14 @@ derive JSONDecode HtmlState, StorageFormat, Lifespan
// ******************************************************************************************************
// *** Server / Client startup
// ******************************************************************************************************
startTaskEngine :: !(Task a) !*World -> *World | iData a
startTaskEngine maintask world = doHtmlServer maintask world
startTaskEngine :: !(LabeledTask a) !Int !*World -> *World | iData a
startTaskEngine mainTask mainUser world = doHtmlServer mainTask mainUser world
doHtmlServer :: (Task a) !*World -> *World | iData a
doHtmlServer mainTask world
doHtmlServer :: (LabeledTask a) !Int !*World -> *World | iData a
doHtmlServer mainTask uid world
| ServerKind == Internal
# world = instructions world
= startServer mainTask world // link in the Clean http 1.0 server
= startServer mainTask uid world // link in the Clean http 1.0 server
//| ServerKind == CGI // build as CGI application
| otherwise
= unimplemented world
......@@ -53,18 +53,18 @@ where
# (_,world) = fclose console world
= world
startServer :: (Task a) !*World -> *World | iData a
startServer mainTask world
startServer :: (LabeledTask a) !Int !*World -> *World | iData a
startServer mainTask mainUser world
# options = ServerOptions ++ (if TraceHTTP [HTTPServerOptDebug True] [])
= http_startServer options [((==) "/handlers/authenticate", handleAnonRequest handleAuthenticationRequest)
,((==) "/handlers/deauthenticate", handleSessionRequest handleDeauthenticationRequest)
,((==) "/handlers/new/list", handleSessionRequest handleNewListRequest)
,((==) "/handlers/new/start", handleSessionRequest handleNewStartRequest)
,((==) "/handlers/work/list", handleSessionRequest (handleWorkListRequest mainTask))
,((==) "/handlers/work/tab", handleSessionRequest (handleWorkTabRequest mainTask))
,((==) "/handlers/debug/tasktreeforest", handleSessionRequest (handleTaskTreeForestRequest mainTask))
,((==) "/handlers/debug/processtable", handleSessionRequest (handleProcessTableRequest mainTask))
,((==) "/handlers/debug/threadtable", handleSessionRequest (handleThreadTableRequest mainTask))
,((==) "/handlers/work/list", handleSessionRequest (handleWorkListRequest mainTask mainUser))
,((==) "/handlers/work/tab", handleSessionRequest (handleWorkTabRequest mainTask mainUser))
,((==) "/handlers/debug/tasktreeforest", handleSessionRequest (handleTaskTreeForestRequest mainTask mainUser))
,((==) "/handlers/debug/processtable", handleSessionRequest (handleProcessTableRequest mainTask mainUser))
,((==) "/handlers/debug/threadtable", handleSessionRequest (handleThreadTableRequest mainTask mainUser))
,(\_ -> True, handleStaticResourceRequest)
] world
......
......@@ -38,7 +38,7 @@ instance == ThreadKind
// *********************************************************************************************************************************
// calculateTasks :: currentUserId pversion traceOn maintask ->
calculateTasks :: !Int !GlobalInfo !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) | iData a
calculateTasks :: !Int !GlobalInfo !(LabeledTask a) !Int !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) | iData a
// Setting of global information for a particular user
......
......@@ -107,9 +107,9 @@ setSVersionNr user f hst
// or by evaluating the corresponding task sub tree using the stored threads
// ******************************************************************************************************
calculateTasks :: !Int !GlobalInfo !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) | iData a
calculateTasks thisUser pversion maintask tst
# maintask = scheduleWorkflows maintask
calculateTasks :: !Int !GlobalInfo !(LabeledTask a) !Int !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) | iData a
calculateTasks thisUser pversion mainTask mainUser tst
# maintask = scheduleWorkflows mainTask mainUser
= ((IF_Ajax
(startAjaxApplication thisUser pversion)
startMainTask
......@@ -124,7 +124,7 @@ where
// Event handling for Ajax calls and Sapl handling on the client
// ******************************************************************************************************
// The following functions are defined to support "Ajax technologie" and Client site evaluation of i-Tasks.
// The following functions are defined to support Client site evaluation of i-Tasks.
// To make this possible, a part of the iTask task tree must be assigened to be a thread such that it can be evaluated as a stand-alone i-Task.
// The programmer has to decide which iTask should become a thread.
// For each event (iData triplet), the system will search for the thread to handle it.
......
......@@ -8,5 +8,5 @@ definition module TaskTree
import iTasksTypes
calculateTaskTree :: !UserId !Bool !Bool !Bool !(Task a) !*HSt
calculateTaskTree :: !Int !Bool !Bool !Bool !(LabeledTask a) !Int !*HSt
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
......@@ -13,12 +13,12 @@ import InternaliTasksThreadHandling
import iTasksProcessHandling
import TSt
calculateTaskTree :: !UserId !Bool !Bool !Bool !(Task a) !*HSt
calculateTaskTree :: !Int !Bool !Bool !Bool !(LabeledTask a) !Int !*HSt
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
calculateTaskTree thisUser traceOn showProcessTable showCurrThreadTable mainTask hst
calculateTaskTree thisUser traceOn showProcessTable showCurrThreadTable mainTask mainUser hst
# (pversion,hst) = setPUserNr thisUser id hst // fetch global settings of this user
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{activated})
= calculateTasks thisUser pversion mainTask (mkTst thisUser LSTxtFile LSTxtFile hst)
= calculateTasks thisUser pversion mainTask mainUser (mkTst thisUser LSTxtFile LSTxtFile hst)
# (processTable,tst) = if showProcessTable (showWorkflows activated {tst & activated = activated}) ([],{tst & activated = activated})
# (threadTable,tst=:{html,hst,activated})
......
......@@ -58,4 +58,4 @@ deleteMe :: (Task Void)
// internally used...
showWorkflows :: !Bool !*TSt -> ([HtmlTag],*TSt)
scheduleWorkflows :: !(Task a) -> (Task a) | iData a
scheduleWorkflows :: !(LabeledTask a) !Int -> (Task a) | iData a
......@@ -119,10 +119,10 @@ where
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName (0,[]) <@ NoForm) wfs hst
= (form.Form.value,{tst & hst = hst})
scheduleWorkflows :: !(Task a) -> (Task a) | iData a
scheduleWorkflows maintask
scheduleWorkflows :: !(LabeledTask a) !Int -> (Task a) | iData a
scheduleWorkflows mainTask mainUser
//# nmaintask = newTask defaultWorkflowName (mkTask "StartMain" (assignTaskTo 0 ("main",maintask)))
# nmaintask = assignTaskTo 0 ("main",maintask)
# nmaintask = assignTaskTo mainUser mainTask
= IF_Ajax
(IF_ClientServer // we running both client and server
(IF_ClientTasks
......
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