We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit 4574b948 authored by Bas Lijnse's avatar Bas Lijnse

Made startEngine overloaded. Possible to publish multiple tasks to different urls.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1887 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 26392cec
......@@ -80,8 +80,8 @@ where
getTask iworld
# (mbWorkflow,iworld) = 'WorkflowDB'.getWorkflow wid iworld
= case mbWorkflow of
Just {task} = (Ok task, iworld)
_ = (Error ("could not find workflow " +++ (toString wid)), iworld)
Just {Workflow|task} = (Ok task, iworld)
_ = (Error ("could not find workflow " +++ (toString wid)), iworld)
// MANAGEMENT TASKS
......
......@@ -9,18 +9,30 @@ from IWorld import :: IWorld
from HTTP import :: HTTPRequest, :: HTTPResponse
from Config import :: Config
:: HandlerFormat :== String
:: Handler :== (!String,![HandlerFormat],!String HandlerFormat [String] HTTPRequest *IWorld -> *(!HTTPResponse, !*IWorld))
:: PublishedTask =
{ url :: String
, task :: TaskWrapper
}
/**
* Creates the iTasks system from a set of workflow definitions
* Creates the iTasks system from a set of published tasks
*
* @param An optional config record
* @param A task to execute
* @return A list of predicate/handler pairs that can be plugged into a server
*/
engine :: !(Maybe Config) (Task a) ![Handler] -> [(!String -> Bool,!HTTPRequest *World -> (!HTTPResponse, !*World))] | iTask a
engine :: !(Maybe Config) publish -> [(!String -> Bool,!HTTPRequest *World -> (!HTTPResponse, !*World))] | Publishable publish
/**
* Wraps a task together with a url to make it publishable by the engine
*/
publish :: String (Task a) -> PublishedTask | iTask a
class Publishable a
where
publishAll :: a -> [PublishedTask]
instance Publishable (Task a) | iTask a
instance Publishable [PublishedTask]
/**
* Loads the itasks specific config
......
......@@ -11,8 +11,8 @@ import IWorld
import WebService
// The iTasks engine consist of a set of HTTP request handlers
engine :: !(Maybe Config) (Task a) ![Handler] -> [(!String -> Bool,!HTTPRequest *World -> (!HTTPResponse, !*World))] | iTask a
engine mbConfig task handlers
engine :: !(Maybe Config) publish -> [(!String -> Bool,!HTTPRequest *World -> (!HTTPResponse, !*World))] | Publishable publish
engine mbConfig publishable
= case mbConfig of
Just config
= handlers` config
......@@ -20,31 +20,18 @@ engine mbConfig task handlers
= [(\_ -> True, setupHandler)]
where
handlers` config
= [
// Handler to stop the server nicely
((==) "/stop", handleStopRequest)
// Webservices
,((==) "/", taskDispatch config task)
,(startsWith config.serverPath, serviceDispatch config)
,(\_ -> True, handleStaticResourceRequest config)
]
serviceDispatch config req world
# iworld = initIWorld config world
# reqpath = (urlDecode req.req_path)
# reqpath = reqpath % (size config.serverPath, size reqpath)
# (response,iworld) = case (split "/" reqpath) of
["",format,name:path] = case filter (\(name`,formats,_) -> name` == name && isMember format formats) handlers of
[(_,_,handler):_] = handler req.req_path format path req iworld
[] = (notFoundResponse req, iworld)
_
= (notFoundResponse req, iworld)
= (response, finalizeIWorld iworld)
= taskHandlers (publishAll publishable) config ++ defaultHandlers config
taskHandlers published config
= [((==) url, taskDispatch config task) \\ {url,task=TaskWrapper task} <- published]
taskDispatch config task req world
# iworld = initIWorld config world
# (response,iworld) = webService task req iworld
= (response, finalizeIWorld iworld)
defaultHandlers config
= [((==) "/stop", handleStopRequest),(\_ -> True, handleStaticResourceRequest config)]
initIWorld :: !Config !*World -> *IWorld
initIWorld config world
......@@ -124,6 +111,17 @@ handleStopRequest req world = ({newHTTPResponse & rsp_headers = fromList [("X-Se
path2name path = last (split "/" path)
publish :: String (Task a) -> PublishedTask | iTask a
publish url task = {url = url, task = TaskWrapper task}
instance Publishable (Task a) | iTask a
where
publishAll task = [publish "/" task]
instance Publishable [PublishedTask]
where
publishAll list = list
config :: !*World -> (!Maybe Config,!*World)
config world
# (appName,world) = determineAppName world
......
......@@ -13,4 +13,6 @@ import Engine
* @param The world
* @return The world
*/
startEngine :: (Task a) !*World -> *World | iTask a
startEngine :: a !*World -> *World | Publishable a
......@@ -6,22 +6,22 @@ import HTTP, HttpServer
import WebService, DocumentService
startEngine :: (Task a) !*World -> *World | iTask a
startEngine task world
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world
# (mbConfig,world) = config world
# (app,world) = determineAppName world
# world = instructions app mbConfig world
# options = case mbConfig of
Just config = [HTTPServerOptPort config.serverPort, HTTPServerOptDebug config.debug]
Nothing = []
# world = http_startServer options (engine mbConfig task handlers) world
# world = http_startServer options (engine mbConfig publishable) world
| isJust mbConfig
= world // normal operation: stop server
| otherwise
# (console,world) = stdio world
# console = fwrites ("\n\n") console
# (_,world) = fclose console world
= startEngine task world // setup mode: restart server
= startEngine publishable world // setup mode: restart server
where
instructions :: !String !(Maybe Config) *World -> *World
//Normal operation
......@@ -43,6 +43,4 @@ where
# console = fwrites ("Please open http://localhost/ and follow instructions\n") console
# (_,world) = fclose console world
= world
handlers :: [Handler]
handlers = [ ("documents",["html","json"],documentService)]
\ No newline at end of file
......@@ -61,11 +61,6 @@ taskFuncs :: !(Task a) -> TaskFuncs a | iTask a
// Gives the layouter functions for a task
taskLayouters :: !(Task a) -> (InteractionLayouter, ParallelLayouter)
:: TaskThread a =
{ originalTask :: Task a
, currentTask :: Task a
}
taskException :: !e -> TaskResult a | TC, toString e
/**
......
......@@ -22,10 +22,10 @@ setFinished meta = {meta & status = Finished}
setExcepted :: !ProgressMeta -> ProgressMeta
setExcepted meta = {meta & status = Excepted}
createThread :: (Task a) -> Dynamic | iTask a
createThread task = (dynamic container :: Container (TaskThread a^) a^)
createContainer :: (Task a) -> Dynamic | iTask a
createContainer task = (dynamic container :: Container (Task a^) a^)
where
container = Container {TaskThread|originalTask = task, currentTask = task}
container = Container task
processNo :: !ProcessId -> Int
processNo (SessionProcess _) = 0
......@@ -33,12 +33,11 @@ processNo (WorkflowProcess no) = no
processNo (EmbeddedProcess no _) = no
createContext :: !ProcessId !Dynamic !ManagementMeta !User !*IWorld -> (!TaskContext, !*IWorld)
createContext processId thread=:(Container {TaskThread|originalTask} :: Container (TaskThread a) a) mmeta user iworld=:{IWorld|localDateTime}
# originalTaskFuncs = taskFuncs originalTask
# (tcontext,iworld) = originalTaskFuncs.initFun (taskNo processId) iworld
# tmeta = taskMeta originalTask
createContext processId container=:(Container task :: Container (Task a) a) mmeta user iworld=:{IWorld|localDateTime}
# (tcontext,iworld) = (taskFuncs task).initFun (taskNo processId) iworld
# tmeta = taskMeta task
# pmeta = {issuedAt = localDateTime, issuedBy = user, status = Running, firstEvent = Nothing, latestEvent = Nothing}
= (TaskContext processId tmeta pmeta mmeta 0 (TTCRunning thread tcontext),iworld)
= (TaskContext processId tmeta pmeta mmeta 0 (TTCRunning container tcontext),iworld)
where
taskNo (WorkflowProcess pid)= [0,pid]
taskNo (SessionProcess _) = [0,0]
......@@ -47,8 +46,8 @@ where
editInstance :: !(Maybe EditEvent) !TaskContext !*IWorld -> (!MaybeErrorString TaskContext, !*IWorld)
editInstance editEvent context=:(TaskContext processId tmeta pmeta mmeta changeNo tcontext) iworld
= case tcontext of
TTCRunning thread=:(Container {TaskThread|currentTask} :: Container (TaskThread a) a) scontext
# editFun = (taskFuncs currentTask).editFun
TTCRunning container=:(Container task :: Container (Task a) a) scontext
# editFun = (taskFuncs task).editFun
# procNo = processNo processId
# taskNr = [changeNo,procNo]
# (scontext,iworld) = case editEvent of
......@@ -61,7 +60,7 @@ editInstance editEvent context=:(TaskContext processId tmeta pmeta mmeta changeN
= editFun taskNr (ProcessEvent steps event) scontext iworld
_
= (scontext, iworld)
= (Ok (TaskContext processId tmeta pmeta mmeta changeNo (TTCRunning thread scontext)), iworld)
= (Ok (TaskContext processId tmeta pmeta mmeta changeNo (TTCRunning container scontext)), iworld)
_
= (Ok context, iworld)
......@@ -71,9 +70,9 @@ evalInstance :: !TaskNr !(Maybe CommitEvent) !TaskContext !*IWorld -> (!MaybeEr
evalInstance target commitEvent context=:(TaskContext processId tmeta pmeta mmeta changeNo tcontext) iworld=:{evalStack}
= case tcontext of
//Eval instance
TTCRunning thread=:(Container {TaskThread|currentTask} :: Container (TaskThread a) a) scontext
# evalFun = (taskFuncs currentTask).evalFun
# (ilayout,playout) = taskLayouters currentTask
TTCRunning container=:(Container task :: Container (Task a) a) scontext
# evalFun = (taskFuncs task).evalFun
# (ilayout,playout) = taskLayouters task
# procNo = processNo processId
# taskNo = [changeNo,procNo]
//Update current process id & eval stack in iworld
......@@ -95,7 +94,7 @@ evalInstance target commitEvent context=:(TaskContext processId tmeta pmeta mmet
= case result of
TaskBusy tui actions scontext
// # properties = setRunning properties
# context = TaskContext processId tmeta (setRunning pmeta) mmeta changeNo (TTCRunning thread scontext)
# context = TaskContext processId tmeta (setRunning pmeta) mmeta changeNo (TTCRunning container scontext)
= (Ok (TaskBusy tui actions scontext), context, iworld)
TaskFinished val
# context = TaskContext processId tmeta (setFinished pmeta) mmeta changeNo (TTCFinished (dynamic val))
......@@ -111,7 +110,7 @@ evalInstance target commitEvent context=:(TaskContext processId tmeta pmeta mmet
createSessionInstance :: !(Task a) !*IWorld -> (!MaybeErrorString (!TaskResult Dynamic, !ProcessId), !*IWorld) | iTask a
createSessionInstance task iworld
# (sessionId,iworld) = newSessionId iworld
# (context, iworld) = createContext sessionId (createThread task) noMeta AnyUser iworld
# (context, iworld) = createContext sessionId (createContainer task) noMeta AnyUser iworld
# (mbRes,iworld) = iterateEval [0,0] Nothing context iworld
= case mbRes of
Ok result = (Ok (result, sessionId), iworld)
......@@ -188,8 +187,8 @@ where
AppendTask pid user (container :: TaskContainer Void)
//Make thread and properties
# (thread,managerProperties) = case container of
(Embedded,tfun) = (createThread (tfun GlobalTaskList),{noMeta & worker = Just user})
(Detached props,tfun) = (createThread (tfun GlobalTaskList), props)
(Embedded,tfun) = (createContainer (tfun GlobalTaskList),{noMeta & worker = Just user})
(Detached props,tfun) = (createContainer (tfun GlobalTaskList), props)
//Make context
# (context,iworld) = createContext (WorkflowProcess pid) thread managerProperties user iworld
= execControls cs (queue ++ [context]) iworld
......
......@@ -17,3 +17,4 @@ class iTask a
, TC a
:: Container a c = Container a & iTask c // container for context restrictions
:: TaskWrapper = E.a: TaskWrapper (Task a) & iTask a
\ No newline at end of file
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