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