Commit 6de0df39 authored by Bas Lijnse's avatar Bas Lijnse

Moved displaying of web server instructions to a startup task

parent 0a92516d
......@@ -6,6 +6,7 @@ definition module iTasks.Engine
*/
from Data.Maybe import :: Maybe
from Data.Error import :: MaybeError
from System.FilePath import :: FilePath
from System.Time import :: Timespec
from Internet.HTTP import :: HTTPRequest
......@@ -85,12 +86,12 @@ startEngine :== doTasks //Backwards compatibility
* @param An initialization function to set the engine options with:
@param The command line arguments
@param The default options
@return Maybe the engine options, in case of Nothing, the engine is not started
@return A message that is printed to the console when the engine is started
@return When Ok the engine options the engine is not started,
when Error, a message is printed to the console
* @param The world
* @return The world
*/
doTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] EngineOptions) a !*World
-> *World | Startable a
startEngineWithOptions :== doTasksWithOptions
......@@ -103,10 +104,10 @@ startEngineWithOptions :== doTasksWithOptions
* @param The command line arguments
* @param The default options
* @return Maybe the engine options, in case of Nothing, the engine is not started
* @return A message that is printed to the console when the engine is started
* @return When Ok the engine options the engine is not started,
* when Error, the message to printed to the console
*/
defaultEngineCLIOptions :: [String] EngineOptions -> (!Maybe EngineOptions,![String])
defaultEngineCLIOptions :: [String] EngineOptions -> MaybeError [String] EngineOptions
/**
* Determines the default options for an application
......
......@@ -3,119 +3,56 @@ implementation module iTasks.Engine
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum
import iTasks.WF.Combinators.Common
import iTasks.WF.Tasks.System
import StdInt, StdChar, StdString
from StdFunc import o, seqList, ::St, const, id
import tcp
import Internet.HTTP, System.GetOpt, Data.Func, Data.Functor
from Data.Map import :: Map
from Data.Queue import :: Queue(..)
from Data.Set import :: Set, newSet
import qualified Data.Map as DM
from System.OS import IF_POSIX_OR_WINDOWS, OS_NEWLINE
import Data.List, Data.Error, Data.Func, Data.Tuple, Math.Random, Text
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
import iTasks.Internal.Util, iTasks.Internal.HtmlUtil
import iTasks.Internal.IWorld, iTasks.Internal.WebService, iTasks.Internal.SDSService
import qualified iTasks.Internal.SDS as SDS
import iTasks.UI.Layout, iTasks.UI.Layout.Default
from iTasks.WF.Tasks.SDS import get
from iTasks.WF.Combinators.Tune import class tune(..), instance tune ApplyLayout Task, :: ApplyLayout(..)
from iTasks.SDS.Combinators.Common import sdsFocus
import StdInt, StdChar, StdString
import tcp
import Internet.HTTP, System.Time, System.CommandLine, Data.Func
from iTasks.SDS.Sources.System import applicationOptions
import iTasks.Internal.IWorld, iTasks.Internal.TaskEval, iTasks.Internal.TaskStore
import iTasks.Internal.Util
import iTasks.Internal.TaskServer
import iTasks.Internal.EngineTasks
from iTasks.Extensions.DateTime import toDate, toTime, instance == Date, instance == Time
from Data.Set import :: Set, newSet
from Sapl.Linker.LazyLinker import generateLoaderState, :: LoaderStateExt
from Sapl.Linker.SaplLinkerShared import :: SkipSet
from Sapl.Target.Flavour import :: Flavour, toFlavour
from System.OS import IF_POSIX_OR_WINDOWS
import System.GetOpt
import Data.Functor
MAX_EVENTS :== 5
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
# (appPath,world) = determineAppPath world
# (appVersion,world) = determineAppVersion appPath world
# appDir = takeDirectory appPath
# appName = (dropExtension o dropDirectory) appPath
# options =
{ appName = appName
, appPath = appPath
, appVersion = appVersion
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
, serverUrl = "http://localhost/"
, keepaliveTime = {tv_sec=300,tv_nsec=0} // 5 minutes
, sessionTime = {tv_sec=60,tv_nsec=0} // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
, autoLayout = True
, timeout = Just 500
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
, tempDirPath = appDir </> appName +++ "-data" </> "tmp"
, saplDirPath = appDir </> appName +++ "-sapl"
}
= (options,world)
defaultEngineCLIOptions :: [String] EngineOptions -> (!Maybe EngineOptions,![String])
defaultEngineCLIOptions [argv0:argv] defaults
# (settings, positionals, errs) = getOpt Permute opts argv
| not (errs =: []) = (Nothing, errs)
| not (positionals =: []) = (Nothing, ["Positional arguments not allowed"])
= case foldl (o) id settings (Just defaults) of
Nothing = (Nothing, [usageInfo ("Usage " +++ argv0 +++ "[OPTIONS]") opts])
Just settings = (Just settings,
["*** " +++ settings.appName +++ " HTTP server ***"
,""
,"Running at http://localhost" +++ if (settings.serverPort == 80) "/" (":" +++ toString settings.serverPort +++ "/")])
where
opts :: [OptDescr ((Maybe EngineOptions) -> Maybe EngineOptions)]
opts =
[ Option ['?'] ["help"] (NoArg $ const Nothing)
"Display this message"
, Option ['p'] ["port"] (ReqArg (\p->fmap \o->{o & serverPort=toInt p}) "PORT")
("Specify the HTTP port (default: " +++ toString defaults.serverPort)
, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the keepalive time in seconds (default: 300)"
, Option [] ["sessiontime"] (ReqArg (\p->fmap \o->{o & sessionTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the expiry time for a session in seconds (default: 60)"
, Option [] ["autolayout"] (NoArg (fmap \o->{o & autoLayout=True}))
"Enable autolayouting (default)"
, Option [] ["no-autolayout"] (NoArg (fmap \o->{o & autoLayout=False}))
"Disable autolayouting"
, Option [] ["persist-tasks"] (NoArg (fmap \o->{o & persistTasks=True}))
"Enable the persistence of tasks"
, Option [] ["no-persist-tasks"] (NoArg (fmap \o->{o & persistTasks=False}))
"Disable the persistence of tasks (default)"
, Option [] ["webdir"] (ReqArg (\p->fmap \o->{o & webDirPath=p}) "PATH")
("Specify the folder containing static web content\ndefault: " +++ defaults.webDirPath)
, Option [] ["storedir"] (ReqArg (\p->fmap \o->{o & storeDirPath=p}) "PATH")
("Specify the folder containing the data stores\ndefault: " +++ defaults.storeDirPath)
, Option [] ["tempdir"] (ReqArg (\p->fmap \o->{o & tempDirPath=p}) "PATH")
("Specify the folder containing the temporary files\ndefault: " +++ defaults.tempDirPath)
, Option [] ["sapldir"] (ReqArg (\p->fmap \o->{o & saplDirPath=p}) "PATH")
("Specify the folder containing the sapl files\ndefault: " +++ defaults.saplDirPath)
]
derive class iTask EngineOptions
doTasks :: a !*World -> *World | Startable a
doTasks startable world = doTasksWithOptions defaultEngineCLIOptions startable world
doTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Startable a
doTasksWithOptions :: ([String] EngineOptions -> MaybeError [String] EngineOptions) 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
| mbOptions =: Nothing = world
# (Just options) = mbOptions
# mbOptions = initFun cli options
| mbOptions =:(Error _) = show (fromError mbOptions) world
# options = fromOk mbOptions
# iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
......@@ -143,21 +80,60 @@ where
]
]
// The iTasks engine consist of a set of HTTP Web services
engineWebService :: [WebTask] -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)]
engineWebService webtasks =
[taskUIService webtasks
,documentService
,sdsService
,staticResourceService [path \\ {WebTask|path} <- webtasks]
]
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
// The iTasks engine consist of a set of HTTP Web services
engineWebService :: [WebTask] -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)]
engineWebService webtasks =
[taskUIService webtasks
,documentService
,sdsService
,staticResourceService [path \\ {WebTask|path} <- webtasks]
]
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ OS_NEWLINE) c) lines console
# (_,world) = fclose console world
= world
defaultEngineCLIOptions :: [String] EngineOptions -> MaybeError [String] EngineOptions
defaultEngineCLIOptions [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
where
opts :: [OptDescr ((Maybe EngineOptions) -> Maybe EngineOptions)]
opts =
[ Option ['?'] ["help"] (NoArg $ const Nothing)
"Display this message"
, Option ['p'] ["port"] (ReqArg (\p->fmap \o->{o & serverPort=toInt p}) "PORT")
("Specify the HTTP port (default: " +++ toString defaults.serverPort)
, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the keepalive time in seconds (default: 300)"
, Option [] ["sessiontime"] (ReqArg (\p->fmap \o->{o & sessionTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the expiry time for a session in seconds (default: 60)"
, Option [] ["autolayout"] (NoArg (fmap \o->{o & autoLayout=True}))
"Enable autolayouting (default)"
, Option [] ["no-autolayout"] (NoArg (fmap \o->{o & autoLayout=False}))
"Disable autolayouting"
, Option [] ["persist-tasks"] (NoArg (fmap \o->{o & persistTasks=True}))
"Enable the persistence of tasks"
, Option [] ["no-persist-tasks"] (NoArg (fmap \o->{o & persistTasks=False}))
"Disable the persistence of tasks (default)"
, Option [] ["webdir"] (ReqArg (\p->fmap \o->{o & webDirPath=p}) "PATH")
("Specify the folder containing static web content\ndefault: " +++ defaults.webDirPath)
, Option [] ["storedir"] (ReqArg (\p->fmap \o->{o & storeDirPath=p}) "PATH")
("Specify the folder containing the data stores\ndefault: " +++ defaults.storeDirPath)
, Option [] ["tempdir"] (ReqArg (\p->fmap \o->{o & tempDirPath=p}) "PATH")
("Specify the folder containing the temporary files\ndefault: " +++ defaults.tempDirPath)
, Option [] ["sapldir"] (ReqArg (\p->fmap \o->{o & saplDirPath=p}) "PATH")
("Specify the folder containing the sapl files\ndefault: " +++ defaults.saplDirPath)
]
onRequest :: String (HTTPRequest -> Task a) -> StartableTask | iTask a
onRequest path task = WebTask {WebTask|path = path, task = WebTaskWrapper task}
......@@ -171,11 +147,17 @@ where
instance Startable (Task a) | iTask a //Default as web task
where
toStartable task = [onRequest "/" (const task)]
toStartable task =
[onStartup defaultValue viewWebServerInstructions
,onRequest "/" (const task)
]
instance Startable (HTTPRequest -> Task a) | iTask a //As web task
where
toStartable task = [onRequest "/" task]
toStartable task =
[onStartup defaultValue viewWebServerInstructions
,onRequest "/" task
]
instance Startable StartableTask
where
......@@ -189,6 +171,43 @@ instance Startable (a,b) | Startable a & Startable b
where
toStartable (x,y) = toStartable x ++ toStartable y
viewWebServerInstructions :: Task String
viewWebServerInstructions
= get applicationOptions
>>- \{EngineOptions|appName,serverPort} ->
traceValue (join OS_NEWLINE
["*** " +++ appName +++ " HTTP server ***"
,""
,"Running at http://localhost" +++
if (serverPort == 80)
"/"
(":" +++ toString serverPort +++ "/")
])
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
# (appPath,world) = determineAppPath world
# (appVersion,world) = determineAppVersion appPath world
# appDir = takeDirectory appPath
# appName = (dropExtension o dropDirectory) appPath
# options =
{ appName = appName
, appPath = appPath
, appVersion = appVersion
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
, serverUrl = "http://localhost/"
, keepaliveTime = {tv_sec=300,tv_nsec=0} // 5 minutes
, sessionTime = {tv_sec=60,tv_nsec=0} // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
, autoLayout = True
, timeout = Just 500
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
, tempDirPath = appDir </> appName +++ "-data" </> "tmp"
, saplDirPath = appDir </> appName +++ "-sapl"
}
= (options,world)
// Determines the server executables path
determineAppPath :: !*World -> (!FilePath, !*World)
determineAppPath 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