Engine.icl 9.92 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
import iTasks.Internal.EngineTasks
28
import iTasks.Internal.Distributed.Symbols
29

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

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

37
from System.OS import IF_POSIX_OR_WINDOWS
38

39 40 41 42 43 44
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
	# (appPath,world)    = determineAppPath world	
	# (appVersion,world) = determineAppVersion appPath world
	# appDir             = takeDirectory appPath
	# appName            = (dropExtension o dropDirectory) appPath
45
	# options =	
46
		{ appName			= appName
47
		, appPath			= appPath
48
		, appVersion        = appVersion
49
		, serverPort		= IF_POSIX_OR_WINDOWS 8080 80
50
<<<<<<< HEAD
51
        , 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
=======
		, serverUrl         = "http://localhost/"
		, keepaliveTime     = 300 // 5 minutes
		, sessionTime       = 60 // 1 minute, (the client pings every 10 seconds by default)
		, persistTasks      = False
		, autoLayout        = True
		, distributed       = False
>>>>>>> Add storing symbols to the engine
65 66 67 68 69 70 71 72 73 74
		, 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 cli defaults
	//If -help option is given show help and stop
75 76 77
	# help					= fromMaybe False (boolOpt "-help" "-no-help" cli)
	| help					= (Nothing, instructions defaults)
	//Check commandline options
78 79
	# options =	
		{ defaults 
80 81 82 83 84
		& serverPort		= fromMaybe defaults.serverPort (intOpt "-port" cli)
		, webDirPath 		= fromMaybe defaults.webDirPath (stringOpt "-webdir" cli)
		, storeDirPath      = fromMaybe defaults.storeDirPath (stringOpt "-storedir" cli)
		, tempDirPath 		= fromMaybe defaults.webDirPath (stringOpt "-tempdir" cli)
		, saplDirPath 	    = fromMaybe defaults.saplDirPath (stringOpt "-sapldir" cli)
85
		}
86
	= (Just options,running options.appName options.serverPort)
87
where
88 89
	instructions :: EngineOptions -> [String]
	instructions {serverPort,webDirPath,storeDirPath,tempDirPath,saplDirPath} =
90
		["Available commandline options:"
91 92 93 94 95 96 97 98 99 100
		," -help            : Show this message and exit"
		," -port <port>     : Listen on TCP port number (default " +++ toString serverPort +++ ")"
		," -webdir <path>   : Use <path> to point to the folder that contain the application's static web content"
		,"                  : (default "+++ webDirPath +++ ")"
	    ," -storedir <path> : Use <path> as data store location"
		,"                  : (default " +++ storeDirPath +++ ")"
	    ," -tempdir <path>  : Use <path> as temporary file location"
		,"                  : (default " +++ tempDirPath +++ ")"
	    ," -sapldir <path>  : Use <path> to point to the folder that contains the sapl version of the application"
		,"                  : (default "+++ saplDirPath +++ ")"
101 102
		,""
		]
103

104 105 106 107 108
	running :: !String !Int -> [String]
	running app port = ["*** " +++ app +++ " HTTP server ***"
                       ,""
                       ,"Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]

109 110 111 112 113
	boolOpt :: !String !String ![String] -> Maybe Bool
	boolOpt trueKey falseKey opts
		| isMember trueKey opts = Just True
		| isMember falseKey opts = Just False
		                         = Nothing
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
	
	intOpt :: !String ![String] -> Maybe Int
	intOpt key []	= Nothing
	intOpt key [_]	= Nothing
	intOpt key [n,v:r]
		| n == key && isInteger v	= Just (toInt v)
									= intOpt key [v:r]
	where								
		isInteger v = and (map isDigit (fromString v))

	stringOpt :: !String [String] -> Maybe String
	stringOpt key [] = Nothing
	stringOpt key [_] = Nothing
	stringOpt key [n,v:r]
		| n == key	= Just v
					= stringOpt key [v:r]
130

131
startEngine :: a !*World -> *World | Publishable a
132 133 134 135 136 137 138 139 140 141 142 143 144 145
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)
146 147
			# (_, iworld)			= if options.distributed (storeSymbols options.appName iworld) (Ok "", iworld)
			| res =:(Error _)		= show ["Fatar error: " +++ fromError res] (destroyIWorld iworld)
Mart Lubbers's avatar
Mart Lubbers committed
148
			# iworld				= serve [TaskWrapper removeOutdatedSessions] (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
149
			= destroyIWorld iworld
150
where
151
	tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
152

153
runTasks :: a !*World -> *World | Runnable a
154 155 156 157 158 159 160 161 162
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
163 164
	# (Just options)		= mbOptions
 	# iworld				= createIWorld options world
165 166
 	# (res,iworld) 			= initJSCompilerState iworld
 	| res =:(Error _) 		= show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
167
	# iworld				= serve (toRunnable runnable) [] (timeout options.timeout) iworld
168 169
	= destroyIWorld iworld

170 171 172 173 174 175
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
176

177
// The iTasks engine consist of a set of HTTP WebService 
178
engineWebService :: publish -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)] | Publishable publish
179
engineWebService publishable = [taskUIService published, documentService, sdsService, staticResourceService [url \\ {PublishedTask|url} <- published]]
180
where
181
	published = publishAll publishable 
182

183
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
184
publish url task = {PublishedTask|url = url, task = WebTaskWrapper task}
185 186 187

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

Bas Lijnse's avatar
Bas Lijnse committed
190 191
instance Publishable (HTTPRequest -> Task a) | iTask a
where
192
	publishAll task = [publish "/" task]
Bas Lijnse's avatar
Bas Lijnse committed
193
	
194 195 196 197
instance Publishable [PublishedTask]
where
	publishAll list = list

198 199 200 201 202 203 204 205 206 207 208 209
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
210
// Determines the server executables path
211
determineAppPath :: !*World -> (!FilePath, !*World)
ecrombag's avatar
ecrombag committed
212
determineAppPath world
213 214
	# ([arg:_],world) = getCommandLine world 
	| dropDirectory arg <> "ConsoleClient.exe"	= toCanonicalPath arg world
215 216 217 218 219 220 221 222 223 224 225 226 227
	//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})
228
					(_,Ok {FileInfo | lastModifiedTime = y}) = timeGm x > timeGm y
229 230 231 232 233 234 235 236 237 238

//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)