Commit d6aba26b authored by Bas Lijnse's avatar Bas Lijnse

Extended itasks main function (renamed from startEngine to doTasks) to also enable

directly creating task instances when an application is started.
This was already possible internally, but was not yet exposed in the API.
parent 4842d549
......@@ -23,4 +23,4 @@ import MultiUser.Tasks
Start :: *World -> *World
Start world
= StartMultiUserTasks [ workflow "Ligretto" "Play Ligretto" play_Ligretto ] [] world
= startMultiUserTasks [ workflow "Ligretto" "Play Ligretto" play_Ligretto ] [] world
......@@ -2,4 +2,4 @@ definition module MultiUser.Tasks
import iTasks.Extensions.Admin.UserAdmin
StartMultiUserTasks :: [Workflow] [PublishedTask] *World -> *World
startMultiUserTasks :: [Workflow] [StartableTask] *World -> *World
......@@ -3,8 +3,8 @@ implementation module MultiUser.Tasks
import iTasks
import iTasks.Extensions.Admin.UserAdmin
StartMultiUserTasks :: [Workflow] [PublishedTask] *World -> *World
StartMultiUserTasks workflows tasks world
startMultiUserTasks :: [Workflow] [StartableTask] *World -> *World
startMultiUserTasks workflows tasks world
= startTask [ workflow "Manage users" "Manage system users..." manageUsers
: workflows
] tasks world
......
......@@ -24,4 +24,4 @@ import MultiUser.Tasks
Start :: *World -> *World
Start world
= StartMultiUserTasks [ workflow "Trax" "Play Trax" play_trax ] [] world
= startMultiUserTasks [ workflow "Trax" "Play Trax" play_trax ] [] world
......@@ -30,13 +30,14 @@ import iTasks.WF.Definition
}
/**
* Starts the task engine with a list of published task definitions.
* Executes the task framework with a collection of startable task definitions.
*
* @param Tasks to start
* @param The world
* @return The world
*/
startEngine :: a !*World -> *World | Publishable a
doTasks :: a !*World -> *World | Startable a
startEngine :== doTasks //Backwards compatibility
/**
* Starts the task engine with options and a list of published task definitions.
......@@ -50,13 +51,16 @@ startEngine :: a !*World -> *World | Publishable a
* @param The world
* @return The world
*/
startEngineWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Publishable a
doTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World
-> *World | Startable a
startEngineWithOptions :== doTasksWithOptions
/**
* The function that takes the 'standard' command line options of an itask engine and
* shows the default help and startup message
*
* Essentially: startEngine = startEngineWithOptions defaultEngineCLIOptions
* Essentially: doTasks = doTasksWithOptions defaultEngineCLIOptions
* @param The command line arguments
* @param The default options
......@@ -65,11 +69,6 @@ startEngineWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![Str
*/
defaultEngineCLIOptions :: [String] EngineOptions -> (!Maybe EngineOptions,![String])
/**
* Determines the default options for an application
*/
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
/**
* Start a stripped task engine (without an HTTP server) with a list of tasks to be created
*/
......@@ -77,35 +76,51 @@ runTasks :: a !*World -> *World | Runnable a
runTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Runnable a
/*
* There are two ways tasks can be started:
* Interactively when a user requests it through the web,
* or directly when the application (server) is started,
*/
:: StartableTask
= WebTask !WebTask
| StartupTask !StartupTask
// === Wrapping interactive tasks for use with the builtin iTask webserver ===
:: WebTask =
{ url :: !String
, task :: !WebTaskWrapper
}
:: PublishedTask =
{ url :: String
, task :: WebTaskWrapper
:: StartupTask =
{ attributes :: !TaskAttributes
, task :: !TaskWrapper
}
:: WebTaskWrapper = E.a: WebTaskWrapper (HTTPRequest -> Task a) & iTask a
:: TaskWrapper = E.a: TaskWrapper (Task a) & iTask a
/**
* Wraps a task together with a url to make it publishable by the engine
*/
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
//Utility functions for creating collections of startable tasks
atRequest :: String (HTTPRequest -> Task a) -> StartableTask | iTask a
atStartup :: TaskAttributes (Task a) -> StartableTask | iTask a
publish :== atRequest //Backwards compatibility
class Publishable a
class Startable a
where
publishAll :: !a -> [PublishedTask]
toStartable :: !a -> [StartableTask]
instance Publishable (Task a) | iTask a
instance Publishable (HTTPRequest -> Task a) | iTask a
instance Publishable [PublishedTask]
instance Startable (Task a) | iTask a //Default as web task
instance Startable (HTTPRequest -> Task a) | iTask a //As web task
instance Startable StartableTask
instance Startable [StartableTask]
// === Wrapping non-interactive tasks for running on the command line ===
class Runnable a
where
toRunnable :: !a -> [TaskWrapper]
toRunnable :: !a -> [StartableTask]
instance Runnable (Task a) | iTask a
instance Runnable [TaskWrapper]
/**
* Determines the default options for an application
*/
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
......@@ -105,34 +105,43 @@ where
("Specify the folder containing the sapl files\ndefault: " +++ defaults.saplDirPath)
]
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world = startEngineWithOptions defaultEngineCLIOptions publishable world
doTasks :: a !*World -> *World | Startable a
doTasks startable world = doTasksWithOptions defaultEngineCLIOptions startable world
startEngineWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Publishable a
startEngineWithOptions initFun publishable world
doTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Startable a
doTasksWithOptions initFun startable world
# (cli,world) = getCommandLine world
# (options,world) = defaultEngineOptions world
# (mbOptions,msg) = initFun cli options
# world = show msg world
= case mbOptions of
Nothing = world
Just options
# iworld = createIWorld (fromJust mbOptions) world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve [] (tcpTasks options.serverPort options.keepaliveTime) engineTasks (timeout options.timeout) iworld
= destroyIWorld iworld
| mbOptions =: Nothing = world
# (Just options) = mbOptions
# iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve startupTasks (tcpTasks options.serverPort options.keepaliveTime)
engineTasks (timeout options.timeout) iworld
= destroyIWorld iworld
where
tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
webTasks = [t \\ WebTask t <- toStartable startable]
startupTasks = [t \\ StartupTask t <- toStartable startable]
hasWebTasks = not (webTasks =: [])
//Only run a webserver if there are tasks that are started through the web
tcpTasks serverPort keepaliveTime
| webTasks =: [] = []
| otherwise
= [(serverPort,httpServer serverPort keepaliveTime (engineWebService webTasks) taskOutput)]
engineTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle]
runTasks :: a !*World -> *World | Runnable a
runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world
:if (webTasks =: [])
[BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle
]
[BackgroundTask stopOnStable]
]
runTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Runnable a
runTasksWithOptions initFun runnable world
# (cli,world) = getCommandLine world
......@@ -144,14 +153,21 @@ runTasksWithOptions initFun runnable world
# iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve (toRunnable runnable) [] systemTasks (timeout options.timeout) iworld
# iworld = serve startupTasks [] systemTasks (timeout options.timeout) iworld
= destroyIWorld iworld
where
startupTasks = [t \\ StartupTask t <- toRunnable runnable]
systemTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask stopOnStable]
runTasks :: a !*World -> *World | Runnable a
runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
......@@ -160,37 +176,51 @@ show lines world
= world
// The iTasks engine consist of a set of HTTP WebService
engineWebService :: publish -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)] | Publishable publish
engineWebService publishable = [taskUIService published, documentService, sdsService, staticResourceService [url \\ {PublishedTask|url} <- published]]
engineWebService :: [WebTask] -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)]
engineWebService webtasks =
[taskUIService webtasks
,documentService
,sdsService
,staticResourceService [url \\ {WebTask|url} <- webtasks]
]
atRequest :: String (HTTPRequest -> Task a) -> StartableTask | iTask a
atRequest url task = WebTask {WebTask|url = url, task = WebTaskWrapper task}
atStartup :: TaskAttributes (Task a) -> StartableTask | iTask a
atStartup attributes task = StartupTask {StartupTask|attributes = attributes, task = TaskWrapper task}
class Runnable a
where
published = publishAll publishable
toRunnable :: !a -> [StartableTask]
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
publish url task = {url = url, task = WebTaskWrapper task}
instance Runnable (Task a) | iTask a
where
toRunnable task = [StartupTask {StartupTask|attributes='DM'.newMap,task=TaskWrapper task}]
instance Publishable (Task a) | iTask a
instance Runnable [StartableTask]
where
publishAll task = [publish "/" (const task)]
toRunnable list = list
instance Publishable (HTTPRequest -> Task a) | iTask a
class Startable a
where
publishAll task = [publish "/" task]
instance Publishable [PublishedTask]
toStartable :: !a -> [StartableTask]
instance Startable (Task a) | iTask a //Default as web task
where
publishAll list = list
toStartable task = [atRequest "/" (const task)]
class Runnable a
instance Startable (HTTPRequest -> Task a) | iTask a //As web task
where
toRunnable :: !a -> [TaskWrapper]
toStartable task = [atRequest "/" task]
instance Runnable (Task a) | iTask a
instance Startable StartableTask
where
toRunnable task = [TaskWrapper task]
toStartable task = [task]
instance Runnable [TaskWrapper]
instance Startable [StartableTask]
where
toRunnable list = list
toStartable list = list
// Determines the server executables path
determineAppPath :: !*World -> (!FilePath, !*World)
......
......@@ -12,10 +12,10 @@ from iTasks.Internal.Task import :: ConnectionTask, :: TaskException
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.IWorld import :: IWorld, :: BackgroundTaskId
from iTasks.Internal.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException
from iTasks.Engine import :: TaskWrapper
from iTasks.Engine import :: StartupTask
//Core task server loop
serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve :: ![StartupTask] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
//Dynamically add a listener
addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
......
......@@ -26,11 +26,11 @@ import iTasks.SDS.Combinators.Common
| ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel
| BackgroundInstanceDS !BackgroundInstanceOpts !BackgroundTask
serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve :: ![StartupTask] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve its cts bts determineTimeout iworld
= loop determineTimeout (init its cts bts iworld)
init :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] !*IWorld -> *IWorld
init :: ![StartupTask] ![(!Int,!ConnectionTask)] ![BackgroundTask] !*IWorld -> *IWorld
init its cts bts iworld
// Check if the initial tasks have been added already
# iworld = createInitialInstances its iworld
......@@ -40,16 +40,16 @@ init its cts bts iworld
# ioStates = 'DM'.fromList [(TaskId 0 0, IOActive 'DM'.newMap)]
= {iworld & ioTasks = {done=[],todo=listeners ++ map (BackgroundInstance {bgInstId=0}) bts}, ioStates = ioStates, world = world}
where
createInitialInstances :: [TaskWrapper] !*IWorld -> *IWorld
createInitialInstances :: [StartupTask] !*IWorld -> *IWorld
createInitialInstances its iworld
# (mbNextNo,iworld) = read nextInstanceNo iworld
| (mbNextNo =: (Ok 1)) = createAll its iworld //This way we check if it is the initial run of the program
= iworld
createAll :: [TaskWrapper] !*IWorld -> *IWorld
createAll :: [StartupTask] !*IWorld -> *IWorld
createAll [] iworld = iworld
createAll [TaskWrapper task:ts] iworld
= case createTaskInstance task iworld of
createAll [{StartupTask|task=TaskWrapper task,attributes}:ts] iworld
= case createTaskInstance task attributes iworld of
(Ok _,iworld) = createAll ts iworld
(Error (_,e),iworld) = abort e
......
......@@ -112,7 +112,7 @@ taskInstanceOutput :: RWShared InstanceNo TaskOutput TaskOutput
createClientTaskInstance :: !(Task a) !String !InstanceNo !*IWorld -> *(!MaybeError TaskException TaskId, !*IWorld) | iTask a
//Create a task instance
createTaskInstance :: !(Task a) !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
createTaskInstance :: !(Task a) !TaskAttributes !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
/**
* Create a stored task instance in the task store (lazily without evaluating it)
......
......@@ -141,15 +141,15 @@ createClientTaskInstance task sessionId instanceNo iworld=:{options={appVersion}
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) iworld
`b` \iworld -> (Ok (TaskId instanceNo 0), iworld)
createTaskInstance :: !(Task a) !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
createTaskInstance task iworld=:{options={appVersion,autoLayout},current={taskTime},clock}
createTaskInstance :: !(Task a) !TaskAttributes !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
createTaskInstance task attributes iworld=:{options={appVersion,autoLayout},current={taskTime},clock}
# task = if autoLayout (applyLayout defaultSessionLayout task) task
# (mbInstanceNo,iworld) = newInstanceNo iworld
# instanceNo = fromOk mbInstanceNo
# (instanceKey,iworld) = newInstanceKey iworld
# progress = {InstanceProgress|value=Unstable,instanceKey=instanceKey,attachedTo=[],firstEvent=Nothing,lastEvent=Nothing}
# constants = {InstanceConstants|session=True,listId=TaskId 0 0,build=appVersion,issuedAt=clock}
= 'SDS'.write (instanceNo, Just constants,Just progress,Just defaultValue) (sdsFocus instanceNo taskInstance) iworld
= 'SDS'.write (instanceNo, Just constants,Just progress,Just attributes) (sdsFocus instanceNo taskInstance) iworld
`b` \iworld -> 'SDS'.write (createReduct defaultTonicOpts instanceNo task taskTime) (sdsFocus instanceNo taskInstanceReduct) iworld
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) iworld
`b` \iworld -> (Ok (instanceNo,instanceKey), iworld)
......
......@@ -2,7 +2,6 @@ definition module iTasks.Internal.Tonic
from iTasks.Internal.SDS import :: Shared, :: ReadWriteShared, :: RWShared
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Engine import :: PublishedTask
from iTasks.Internal.Task import :: TaskEvalOpts, :: TaskResult
from iTasks.WF.Definition import :: Task, :: InstanceNo, class iTask
from iTasks.UI.Tune import class tune
......
......@@ -4,7 +4,7 @@ definition module iTasks.Internal.WebService
* It also provides access to upload/download of blob content.
*/
from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from iTasks.Engine import :: PublishedTask
from iTasks.Engine import :: WebTask
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.Task import :: Task, :: ConnectionTask
from iTasks.Internal.TaskState import :: TIUIState
......@@ -45,7 +45,7 @@ httpServer :: !Int !Timespec ![WebService r w] (RWShared () r w) -> ConnectionTa
:: OutputQueues :== Map InstanceNo TaskOutput
taskUIService :: ![PublishedTask] -> WebService OutputQueues OutputQueues
taskUIService :: ![WebTask] -> WebService OutputQueues OutputQueues
documentService :: WebService r w
staticResourceService :: [String] -> WebService r w
......@@ -254,8 +254,8 @@ where
:: ChangeQueues :== Map InstanceNo (Queue UIChange)
taskUIService :: ![PublishedTask] -> WebService OutputQueues OutputQueues
taskUIService taskUrls = { urlMatchPred = matchFun [url \\ {PublishedTask|url} <-taskUrls]
taskUIService :: ![WebTask] -> WebService OutputQueues OutputQueues
taskUIService taskUrls = { urlMatchPred = matchFun [url \\ {WebTask|url} <-taskUrls]
, completeRequest = True
, onNewReq = reqFun taskUrls
, onData = dataFun
......@@ -393,8 +393,8 @@ where
disconnectFun _ _ (clientname,state,instances) iworld = (Nothing, snd (updateInstanceDisconnect (map fst instances) iworld))
disconnectFun _ _ _ iworld = (Nothing, iworld)
createTaskInstance` req [{PublishedTask|url,task=WebTaskWrapper task}:taskUrls] iworld
| req.HTTPRequest.req_path == uiUrl url = createTaskInstance (task req) iworld
createTaskInstance` req [{WebTask|url,task=WebTaskWrapper task}:taskUrls] iworld
| req.HTTPRequest.req_path == uiUrl url = createTaskInstance (task req) 'DM'.newMap iworld
| otherwise = createTaskInstance` req taskUrls iworld
uiUrl matchUrl = (if (endsWith "/" matchUrl) matchUrl (matchUrl +++ "/")) +++ "gui-wsock"
......
......@@ -122,7 +122,7 @@ where
//Empty the store to make sure that we get a reliable task instance no 1
# iworld = emptyStore iworld
//Create an instance with autolayouting disabled at the top level
# (res,iworld) = createTaskInstance task iworld
# (res,iworld) = createTaskInstance task 'DM'.newMap iworld
= case res of
(Ok (instanceNo,instanceKey))
//Apply all events
......
......@@ -11,7 +11,7 @@ where
# (options,world) = defaultEngineOptions world
# iworld = createIWorld options world
//Create a task instance
# (res,iworld) = createTaskInstance minimalTask iworld
# (res,iworld) = createTaskInstance minimalTask defaultValue iworld
# world = destroyIWorld iworld
= (res,world)
......
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