Engine.icl 9.46 KB
Newer Older
1
implementation module iTasks.Engine
2

3
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum
4 5
import iTasks.WF.Combinators.Common
import iTasks.WF.Tasks.System
6
from StdFunc import o, seqList, ::St, const, id
7
from Data.Map import :: Map
8
from Data.Queue import :: Queue(..)
9
import qualified Data.Map as DM
10
import Data.List, Data.Error, Data.Func, Data.Tuple, Math.Random, Text 
11
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
12 13 14
import iTasks.Internal.Util, iTasks.Internal.HtmlUtil
import iTasks.Internal.IWorld, iTasks.Internal.WebService, iTasks.Internal.SDSService
import qualified iTasks.Internal.SDS as SDS
15
import iTasks.UI.Layout, iTasks.UI.Layout.Default
16

17
from iTasks.WF.Combinators.Tune import class tune(..), instance tune ApplyLayout Task, :: ApplyLayout(..)
18
from iTasks.SDS.Combinators.Common import sdsFocus
19

20
import StdInt, StdChar, StdString
21 22
import tcp
import Internet.HTTP, System.Time, System.CommandLine, Data.Func
23

24
import iTasks.Internal.IWorld, iTasks.Internal.TaskEval, iTasks.Internal.TaskStore
25 26
import iTasks.Internal.Util
import iTasks.Internal.TaskServer
27 28
import iTasks.Internal.EngineTasks

29
from iTasks.Extensions.DateTime import toDate, toTime, instance == Date, instance == Time
30

31 32 33
from Data.Set import :: Set, newSet
from Sapl.Linker.LazyLinker import generateLoaderState, :: LoaderStateExt
from Sapl.Linker.SaplLinkerShared import :: SkipSet
34
from Sapl.Target.Flavour import :: Flavour, toFlavour
35

36
from System.OS import IF_POSIX_OR_WINDOWS
37 38
import System.GetOpt
import Data.Functor
39

40 41 42 43 44 45
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
	# (appPath,world)    = determineAppPath world	
	# (appVersion,world) = determineAppVersion appPath world
	# appDir             = takeDirectory appPath
	# appName            = (dropExtension o dropDirectory) appPath
46
	# options =	
47
		{ appName			= appName
48
		, appPath			= appPath
49 50 51
        , appVersion        = appVersion
		, serverPort		= IF_POSIX_OR_WINDOWS 8080 80
        , serverUrl         = "http://localhost/"
52 53
		, 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)
Bas Lijnse's avatar
Bas Lijnse committed
54 55
        , persistTasks      = False
		, autoLayout        = True
Mart Lubbers's avatar
Mart Lubbers committed
56
		, timeout			= Just 500
57 58 59 60 61 62 63 64
		, 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])
65 66 67 68 69 70 71 72 73 74
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 +++ "/")])
75
where
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
	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)
104
		]
105

106
startEngine :: a !*World -> *World | Publishable a
107 108 109 110 111 112 113 114 115 116 117 118 119 120
startEngine publishable world = startEngineWithOptions defaultEngineCLIOptions publishable world

startEngineWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Publishable a
startEngineWithOptions initFun publishable 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)
Mart Lubbers's avatar
Mart Lubbers committed
121
			# iworld				= serve [TaskWrapper removeOutdatedSessions] (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
122
			= destroyIWorld iworld
123
where
124
	tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
125

126
runTasks :: a !*World -> *World | Runnable a
127 128 129 130 131 132 133 134 135
runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world

runTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String])) a !*World -> *World | Runnable a
runTasksWithOptions initFun runnable world
	# (cli,world)			= getCommandLine world
	# (options,world)       = defaultEngineOptions world
	# (mbOptions,msg)       = initFun cli options
	# world                 = show msg world
	| mbOptions =: Nothing  = world
136 137
	# (Just options)		= mbOptions
 	# iworld				= createIWorld options world
138 139
 	# (res,iworld) 			= initJSCompilerState iworld
 	| res =:(Error _) 		= show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
140
	# iworld				= serve (toRunnable runnable) [] (timeout options.timeout) iworld
141 142
	= destroyIWorld iworld

143 144 145 146 147 148
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
149

150
// The iTasks engine consist of a set of HTTP WebService 
151
engineWebService :: publish -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)] | Publishable publish
152
engineWebService publishable = [taskUIService published, documentService, sdsService, staticResourceService [url \\ {PublishedTask|url} <- published]]
153
where
154
	published = publishAll publishable 
155

156
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
Bas Lijnse's avatar
Bas Lijnse committed
157
publish url task = {url = url, task = WebTaskWrapper task}
158 159 160

instance Publishable (Task a) | iTask a
where
161
	publishAll task = [publish "/" (const task)]
162

Bas Lijnse's avatar
Bas Lijnse committed
163 164
instance Publishable (HTTPRequest -> Task a) | iTask a
where
165
	publishAll task = [publish "/" task]
Bas Lijnse's avatar
Bas Lijnse committed
166
	
167 168 169 170
instance Publishable [PublishedTask]
where
	publishAll list = list

171 172 173 174 175 176 177 178 179 180 181 182
class Runnable a
where
	toRunnable :: !a -> [TaskWrapper] 

instance Runnable (Task a) | iTask a
where
	toRunnable task = [TaskWrapper task]

instance Runnable [TaskWrapper]
where
	toRunnable list = list

ecrombag's avatar
ecrombag committed
183
// Determines the server executables path
184
determineAppPath :: !*World -> (!FilePath, !*World)
ecrombag's avatar
ecrombag committed
185
determineAppPath world
186 187
	# ([arg:_],world) = getCommandLine world 
	| dropDirectory arg <> "ConsoleClient.exe"	= toCanonicalPath arg world
188 189 190 191 192 193 194 195 196 197 198 199 200
	//Using dynamic linker:	
	# (res, world)				= getCurrentDirectory world	
	| isError res				= abort "Cannot get current directory."	
	# currentDirectory			= fromOk res
	# (res, world)				= readDirectory currentDirectory world	
	| isError res				= abort "Cannot read current directory."	
	# batchfiles				= [f \\ f <- fromOk res | takeExtension f == "bat" ]
	| isEmpty batchfiles		= abort "No dynamic linker batch file found."	
	# (infos, world)			= seqList (map getFileInfo batchfiles) world	
	| any isError infos	 		= abort "Cannot get file information."	
	= (currentDirectory </> (fst o hd o sortBy cmpFileTime) (zip2 batchfiles infos), world)	
	where		
		cmpFileTime (_,Ok {FileInfo | lastModifiedTime = x})
201
					(_,Ok {FileInfo | lastModifiedTime = y}) = timeGm x > timeGm y
202 203 204 205 206 207 208 209 210 211

//By default, we use the modification time of the applaction executable as version id
determineAppVersion :: !FilePath!*World -> (!String,!*World)	
determineAppVersion appPath world
	# (res,world)       = getFileInfo appPath world
	| res =: (Error _)  = ("unknown",world) 
	# tm				= (fromOk res).lastModifiedTime
	# version           = strfTime "%Y%m%d-%H%M%S" tm
	= (version,world)