Commit 65ddec1b authored by Steffen Michels's avatar Steffen Michels

Merge branch 'add-application-options' into 'master'

Added application specific generic config to engine options

See merge request !336
parents 4ead5f80 32917a12
Pipeline #31141 passed with stage
in 6 minutes and 33 seconds
......@@ -56,7 +56,6 @@ 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
......@@ -101,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
......@@ -117,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
......
......@@ -29,6 +29,7 @@ import iTasks.WF.Tasks.System
import iTasks.WF.Derives
import qualified Data.Map as DM
import Data.Map.GenJSON
from TCPIP import :: Timeout
from StdFunc import :: St, seqList
......@@ -38,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
......@@ -54,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
......@@ -84,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)]
......@@ -104,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 =
......
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