Commit 32917a12 authored by Bas Lijnse's avatar Bas Lijnse

Generalized engine initialization

parent 50bbf679
Pipeline #31140 passed with stage
in 6 minutes
......@@ -56,12 +56,10 @@ instance Startable StartableTask
instance Startable [StartableTask]
instance Startable (a,b) | Startable a & Startable b
:: EngineOptions =
{ appName :: String
, appPath :: FilePath // Location of the application's executable
, appVersion :: String
, appConfig :: Map String String //Application specific configuration
, serverPort :: Int
, serverUrl :: String
, allowedHosts :: [String] // Only allow connections from these hosts (default ["127.0.0.1"])
......@@ -102,7 +100,7 @@ startEngine :== doTasks //Backwards compatibility
* @param The world
* @return The world
*/
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] EngineOptions) a !*World
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] (a,EngineOptions)) !*World
-> *World | Startable a
startEngineWithOptions :== doTasksWithOptions
......@@ -118,7 +116,7 @@ startEngineWithOptions :== doTasksWithOptions
* @return When Ok the engine options the engine is not started,
* when Error, the message to printed to the console
*/
defaultEngineCLIOptions :: [String] EngineOptions -> MaybeError [String] EngineOptions
defaultEngineCLIOptions :: a [String] EngineOptions -> MaybeError [String] (a, EngineOptions)
/**
* Determines the default options for an application
......
......@@ -39,15 +39,15 @@ MAX_EVENTS :== 5
derive class iTask EngineOptions
doTasks :: a !*World -> *World | Startable a
doTasks startable world = doTasksWithOptions defaultEngineCLIOptions startable world
doTasks startable world = doTasksWithOptions (defaultEngineCLIOptions startable) world
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] EngineOptions) a !*World -> *World | Startable a
doTasksWithOptions initFun startable world
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] (a,EngineOptions)) !*World -> *World | Startable a
doTasksWithOptions initFun world
# (cli,world) = getCommandLine world
# (options,world) = defaultEngineOptions world
# mbOptions = initFun cli options
| mbOptions =:(Error _) = show (fromError mbOptions) (setReturnCode 1 world)
# options = fromOk mbOptions
# (startable,options) = fromOk mbOptions
# mbIWorld = createIWorld options world
| mbIWorld =: Left _
# (Left (err, world)) = mbIWorld
......@@ -55,16 +55,16 @@ doTasksWithOptions initFun startable world
# (Right iworld) = mbIWorld
# (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (setReturnCode 1 (destroyIWorld iworld))
# iworld = if (hasDup requestPaths)
(iShow ["Warning: duplicate paths in the web tasks: " +++ join ", " ["'" +++ p +++ "'"\\p<-requestPaths]] iworld)
# iworld = if (hasDup (requestPaths startable))
(iShow ["Warning: duplicate paths in the web tasks: " +++ join ", " ["'" +++ p +++ "'"\\p<-requestPaths startable]] iworld)
iworld
# iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
# iworld = serve (startupTasks startable options) (tcpTasks startable options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
= destroyIWorld iworld
where
requestPaths = [path\\{path}<-webTasks]
webTasks = [t \\ WebTask t <- toStartable startable]
startupTasks {distributed, sdsPort}
= if webTasks=:[]
requestPaths startable = [path\\{path}<-webTasks startable]
webTasks startable = [t \\ WebTask t <- toStartable startable]
startupTasks startable {distributed, sdsPort}
= if (webTasks startable) =:[]
//if there are no webtasks: stop when stable
[systemTask (startTask stopOnStable)]
//if there are: show instructions andcleanup old sessions
......@@ -85,10 +85,10 @@ where
(Ok noSymbols, iworld) = (Ok (), {iworld & world = show ["Read number of symbols: " +++ toString noSymbols] iworld.world})
//Only run a webserver if there are tasks that are started through the web
tcpTasks serverPort keepaliveTime
| webTasks =: [] = []
tcpTasks startable serverPort keepaliveTime
| (webTasks startable)=: [] = []
| otherwise
= [(serverPort,httpServer serverPort keepaliveTime (engineWebService webTasks) taskOutput)]
= [(serverPort,httpServer serverPort keepaliveTime (engineWebService (webTasks startable)) taskOutput)]
// The iTasks engine consist of a set of HTTP Web services
engineWebService :: [WebTask] -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)]
......@@ -105,14 +105,14 @@ where
# (_,world) = fclose console world
= world
defaultEngineCLIOptions :: [String] EngineOptions -> MaybeError [String] EngineOptions
defaultEngineCLIOptions [argv0:argv] defaults
defaultEngineCLIOptions :: a [String] EngineOptions -> MaybeError [String] (a, EngineOptions)
defaultEngineCLIOptions tasks [argv0:argv] defaults
# (settings, positionals, errs) = getOpt Permute opts argv
| not (errs =: []) = Error errs
| not (positionals =: []) = Error ["Positional arguments not allowed"]
= case foldl (o) id settings (Just defaults) of
Nothing = (Error [usageInfo ("Usage " +++ argv0 +++ "[OPTIONS]") opts])
Just settings = Ok settings
Just settings = Ok (tasks,settings)
where
opts :: [OptDescr ((Maybe EngineOptions) -> Maybe EngineOptions)]
opts =
......@@ -212,7 +212,6 @@ defaultEngineOptions world
{ appName = appName
, appPath = appPath
, appVersion = appVersion
, appConfig = 'DM'.newMap
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
, serverUrl = "http://localhost/"
, allowedHosts = ["127.0.0.1"]
......
......@@ -65,4 +65,3 @@ applicationName :: SDSSource () String () // Application name
applicationVersion :: SDSSource () String () // Application build identifier
applicationDirectory :: SDSSource () FilePath () // Directory in which the applicaton resides
applicationOptions :: SDSSource () EngineOptions () //Full engine options
applicationConfig :: SDSLens () (Map String String) () //Just the application specific config from engine options
......@@ -162,6 +162,4 @@ applicationOptions = createReadOnlySDS options
where
options () iworld=:{IWorld|options} = (options,iworld)
applicationConfig :: SDSLens () (Map String String) ()
applicationConfig = mapRead (\{EngineOptions|appConfig} -> appConfig) applicationOptions
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