Engine.icl 9.37 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 39 40 41 42 43
defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world
	# (appPath,world)    = determineAppPath world	
	# (appVersion,world) = determineAppVersion appPath world
	# appDir             = takeDirectory appPath
	# appName            = (dropExtension o dropDirectory) appPath
44
	# options =	
45
		{ appName			= appName
46
		, appPath			= appPath
47 48 49
        , appVersion        = appVersion
		, serverPort		= IF_POSIX_OR_WINDOWS 8080 80
        , serverUrl         = "http://localhost/"
50 51
		, 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
52 53
        , persistTasks      = False
		, autoLayout        = True
Mart Lubbers's avatar
Mart Lubbers committed
54
		, timeout			= Just 500
55 56 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])
defaultEngineCLIOptions cli defaults
	//If -help option is given show help and stop
65 66 67
	# help					= fromMaybe False (boolOpt "-help" "-no-help" cli)
	| help					= (Nothing, instructions defaults)
	//Check commandline options
68 69
	# options =	
		{ defaults 
70 71 72 73 74
		& 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)
75
		}
76
	= (Just options,running options.appName options.serverPort)
77
where
78 79
	instructions :: EngineOptions -> [String]
	instructions {serverPort,webDirPath,storeDirPath,tempDirPath,saplDirPath} =
80
		["Available commandline options:"
81 82 83 84 85 86 87 88 89 90
		," -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 +++ ")"
91 92
		,""
		]
93

94 95 96 97 98
	running :: !String !Int -> [String]
	running app port = ["*** " +++ app +++ " HTTP server ***"
                       ,""
                       ,"Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]

99 100 101 102 103
	boolOpt :: !String !String ![String] -> Maybe Bool
	boolOpt trueKey falseKey opts
		| isMember trueKey opts = Just True
		| isMember falseKey opts = Just False
		                         = Nothing
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
	
	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]
120

121
startEngine :: a !*World -> *World | Publishable a
122 123 124 125 126 127 128 129 130 131 132 133 134 135
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
136
			# iworld				= serve [TaskWrapper removeOutdatedSessions] (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
137
			= destroyIWorld iworld
138
where
139
	tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
140

141
runTasks :: a !*World -> *World | Runnable a
142 143 144 145 146 147 148 149 150
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
151 152
	# (Just options)		= mbOptions
 	# iworld				= createIWorld options world
153 154
 	# (res,iworld) 			= initJSCompilerState iworld
 	| res =:(Error _) 		= show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
155
	# iworld				= serve (toRunnable runnable) [] (timeout options.timeout) iworld
156 157
	= destroyIWorld iworld

158 159 160 161 162 163
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
164

165
// The iTasks engine consist of a set of HTTP WebService 
166
engineWebService :: publish -> [WebService (Map InstanceNo TaskOutput) (Map InstanceNo TaskOutput)] | Publishable publish
167
engineWebService publishable = [taskUIService published, documentService, sdsService, staticResourceService [url \\ {PublishedTask|url} <- published]]
168
where
169
	published = publishAll publishable 
170

171
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
Bas Lijnse's avatar
Bas Lijnse committed
172
publish url task = {url = url, task = WebTaskWrapper task}
173 174 175

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

Bas Lijnse's avatar
Bas Lijnse committed
178 179
instance Publishable (HTTPRequest -> Task a) | iTask a
where
180
	publishAll task = [publish "/" task]
Bas Lijnse's avatar
Bas Lijnse committed
181
	
182 183 184 185
instance Publishable [PublishedTask]
where
	publishAll list = list

186 187 188 189 190 191 192 193 194 195 196 197
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
198
// Determines the server executables path
199
determineAppPath :: !*World -> (!FilePath, !*World)
ecrombag's avatar
ecrombag committed
200
determineAppPath world
201 202
	# ([arg:_],world) = getCommandLine world 
	| dropDirectory arg <> "ConsoleClient.exe"	= toCanonicalPath arg world
203 204 205 206 207 208 209 210 211 212 213 214 215
	//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})
216
					(_,Ok {FileInfo | lastModifiedTime = y}) = timeGm x > timeGm y
217 218 219 220 221 222 223 224 225 226

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