Commit 82c8c416 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into ui-reorg

# Conflicts:
#	Dependencies/clean-platform
#	Server/iTasks/_Framework/Engine.icl
#	Server/iTasks/_Framework/TaskServer.icl
parents 51cdc0cf 871d16c6
Subproject commit 39a70914d16744646679de573b012cd494fea052
Subproject commit 4a65aaeaf40e3754c6b53a0574bda2786e861e47
*.[aso]
Clean System Files/*.o
......@@ -22,12 +22,12 @@ copy_string_to_graph_interface.o: copy_string_to_graph_interface.s
cp copy_string_to_graph_interface.o "Clean System Files"/copy_string_to_graph_interface.o
cleanup:
rm copy_graph_to_string.o
rm copy_graph_to_string_interface.o
rm copy_string_to_graph.o
rm copy_string_to_graph_interface.o
rm "Clean System Files"/copy_graph_to_string.o
rm "Clean System Files"/copy_graph_to_string_interface.o
rm "Clean System Files"/copy_string_to_graph.o
rm "Clean System Files"/copy_string_to_graph_interface.o
rm -f copy_graph_to_string.o
rm -f copy_graph_to_string_interface.o
rm -f copy_string_to_graph.o
rm -f copy_string_to_graph_interface.o
rm -f "Clean System Files"/copy_graph_to_string.o
rm -f "Clean System Files"/copy_graph_to_string_interface.o
rm -f "Clean System Files"/copy_string_to_graph.o
rm -f "Clean System Files"/copy_string_to_graph_interface.o
......@@ -639,7 +639,7 @@ text x = TdTag [AlignAttr "center"] [Text (toString x)]
TileTag :: !(!Int,!Int) !String -> HtmlTag
TileTag (width,height) tile
= ImgTag [SrcAttr ("/"<+++ tile <+++ ".png"),w,h]
= ImgTag [SrcAttr ("/"<+++ tile <+++ ".png"), StyleAttr "min-height:0;",w,h]
where
(w,h) = (WidthAttr (toString width),HeightAttr (toString height))
......
......@@ -24,6 +24,17 @@ RELATIVE_LOCATIONS :== [".": take 5 (iterate ((</>) "..") "..")]
{ url :: String
, task :: TaskWrapper
}
:: ServerOptions =
{ appName :: String
, appPath :: FilePath
, sdkPath :: Maybe FilePath
, serverPort :: Int
, keepalive :: Int
, webDirPaths :: Maybe [FilePath]
, storeOpt :: Maybe FilePath
, saplOpt :: Maybe FilePath
}
:: TaskWrapper = E.a: TaskWrapper (HTTPRequest -> Task a) & iTask a
......@@ -36,6 +47,16 @@ RELATIVE_LOCATIONS :== [".": take 5 (iterate ((</>) "..") "..")]
*/
startEngine :: a !*World -> *World | Publishable a
/**
* Starts the task engine with options and a list of published task definitions.
*
* @param Tasks to start
* @param Options to use like port and server paths.
* @param The world
* @return The world
*/
startEngineWithOptions :: a ServerOptions !*World -> *World | Publishable a
/**
* Wraps a task together with a url to make it publishable by the engine
*/
......
......@@ -31,10 +31,18 @@ from Sapl.Linker.LazyLinker import generateLoaderState, :: LoaderStateExt
from Sapl.Linker.SaplLinkerShared import :: SkipSet
from Sapl.Target.Flavour import :: Flavour, toFlavour
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
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world
# (opts,world) = getCommandLine world
# (appName,world) = determineAppName world
# (appPath,world) = determineAppPath world
# (mbSDKPath,world) = determineSDKPath SEARCH_PATHS world
// Show server name
# world = show (infoline appName) world
......@@ -51,23 +59,18 @@ startEngine publishable world
| help = show instructions world
//Check sdkpath
# mbSDKPath = maybe mbSDKPath Just sdkOpt //Commandline SDK option overrides found paths
//Normal execution
# world = show (running port) world
# iworld = createIWorld appName mbSDKPath webDirPaths storeOpt saplOpt world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _)
= show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
// All persistent task instances should receive a reset event to continue their work
# iworld = queueAllPersistent iworld
//Run task server
# iworld = serve port (httpServer port keepalive (engine publishable) allUIChanges)
[BackgroundTask removeOutdatedSessions
,BackgroundTask updateClocks, BackgroundTask (processEvents MAX_EVENTS)] timeout iworld
= destroyIWorld iworld
# options =
{ appName = appName
, appPath = appPath
, sdkPath = mbSDKPath
, serverPort = port
, keepalive = keepalive
, webDirPaths = webDirPaths
, storeOpt = storeOpt
, saplOpt = saplOpt
}
= startEngineWithOptions publishable options world
where
infoline :: !String -> [String]
infoline app = ["*** " +++ app +++ " HTTP server ***",""]
instructions :: [String]
instructions =
["Available commandline options:"
......@@ -81,8 +84,10 @@ where
,""
]
running :: !Int -> [String]
running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
//running :: !Int -> [String]
//running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
infoline :: !String -> [String]
infoline app = ["*** " +++ app +++ " HTTP server ***",""]
boolOpt :: !String ![String] -> Bool
boolOpt key opts = isMember key opts
......@@ -102,10 +107,27 @@ where
stringOpt key [n,v:r]
| n == key = Just v
= stringOpt key [v:r]
startEngineWithOptions :: a ServerOptions !*World -> *World | Publishable a
startEngineWithOptions publishable options=:{appName,sdkPath,serverPort,webDirPaths,keepalive,storeOpt,saplOpt} world
# world = show (running serverPort) world
# iworld = createIWorld appName sdkPath webDirPaths storeOpt saplOpt world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
// All persistent task instances should receive a reset event to continue their work
# iworld = queueAllPersistent iworld
//Start task server
# iworld = serve serverPort (httpServer serverPort keepalive (engine publishable) allUIChanges)
[BackgroundTask removeOutdatedSessions
,BackgroundTask updateClocks, BackgroundTask (processEvents MAX_EVENTS)] timeout iworld
= destroyIWorld iworld
where
running :: !Int -> [String]
running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld)
timeout iworld = case 'SDS'.read taskEvents iworld of //Check if there are events in the queue
(Ok (Queue [] []),iworld) = (Just 100,iworld) //Empty queue, don't waste CPU, but refresh
(Ok (Queue [] []),iworld) = (Just 10,iworld) //Empty queue, don't waste CPU, but refresh
(Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait
(Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast
......
......@@ -96,7 +96,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: *IOTaskInstance
= ListenerInstance !ListenerInstanceOpts !*TCP_Listener
| ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel
| BackgroundInstance !BackgroundTask
| BackgroundInstance !BackgroundInstanceOpts !BackgroundTask
:: ListenerInstanceOpts =
{ taskId :: !TaskId //Reference to the task that created the listener
......@@ -116,6 +116,13 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: ConnectionId :== Int
:: BackgroundInstanceOpts =
{ bgInstId :: !BackgroundTaskId
}
:: BackgroundTaskId :== Int
:: IOStates :== Map TaskId IOState
:: IOState
= IOActive !(Map ConnectionId (!Dynamic,!Bool))
......
......@@ -8,7 +8,7 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from System.Time import :: Timestamp
from Data.Error import :: MaybeError
from iTasks.API.Core.Types import :: TaskId
from iTasks._Framework.IWorld import :: IWorld
from iTasks._Framework.IWorld import :: IWorld, :: BackgroundTaskId
from iTasks._Framework.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException
//Core task server loop
......@@ -19,3 +19,9 @@ addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskE
//Dynamically add a connection
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically add a background task
addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically remove a background task
removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
......@@ -19,7 +19,7 @@ from iTasks._Framework.TaskStore import queueRefresh
:: *IOTaskInstanceDuringSelect
= ListenerInstanceDS !ListenerInstanceOpts
| ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel
| BackgroundInstanceDS !BackgroundTask
| BackgroundInstanceDS !BackgroundInstanceOpts !BackgroundTask
serve :: !Int !ConnectionTask ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve port ct bt determineTimeout iworld
......@@ -31,7 +31,7 @@ init port ct bt iworld=:{IWorld|ioTasks,world}
| not success = abort ("Error: port "+++ toString port +++ " already in use.\n")
# opts = {ListenerInstanceOpts|taskId=TaskId 0 0, nextConnectionId=0, port=port, connectionTask=ct, removeOnClose = True}
# ioStates = 'DM'.fromList [(TaskId 0 0, IOActive 'DM'.newMap)]
= {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map BackgroundInstance bt]}, ioStates = ioStates, world = world}
= {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map (BackgroundInstance {bgInstId=0})bt]}, ioStates = ioStates, world = world}
loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld
loop determineTimeout iworld
......@@ -63,7 +63,7 @@ toSelectSet [i:is]
= case i of
ListenerInstance opts l = ([l:ls],rs,[ListenerInstanceDS opts:is])
ConnectionInstance opts {rChannel,sChannel} = (ls,[rChannel:rs],[ConnectionInstanceDS opts sChannel:is])
BackgroundInstance bt = (ls,rs,[BackgroundInstanceDS bt:is])
BackgroundInstance opts bt = (ls,rs,[BackgroundInstanceDS opts bt:is])
/* Restore the list of main loop instances.
In the same pass also update the indices in the select result to match the
......@@ -99,9 +99,9 @@ where
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners (numSeenReceivers+1) ls rs [(c,what):ch] is
= ([ConnectionInstance opts {rChannel=rChannel,sChannel=sChannel}:is],ch)
//Background tasks
fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS bt:is]
fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS opts bt:is]
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is
= ([BackgroundInstance bt:is],ch)
= ([BackgroundInstance opts bt:is],ch)
ulength [] = (0,[])
ulength [x:xs]
......@@ -263,10 +263,10 @@ process i chList iworld=:{ioTasks={done,todo=[ConnectionInstance opts {rChannel,
# world = closeChannel sChannel world
= process (i+1) chList {iworld & ioTasks={done=done,todo=todo}, ioStates = ioStates, world=world}
process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance bt=:(BackgroundTask eval):todo]}}
process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance opts bt=:(BackgroundTask eval):todo]}}
# (mbe,iworld=:{ioTasks={done,todo}}) = eval {iworld & ioTasks = {done=done,todo=todo}}
| mbe =: (Error _) = abort (snd (fromError mbe)) //TODO Handle the error without an abort
= process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance bt:done],todo=todo}}
= process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance opts bt:done],todo=todo}}
process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
= process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}}
......@@ -321,6 +321,24 @@ addConnection taskId=:(TaskId instanceNo _) host port connectionTask iworld=:{io
Error e = 'DM'.put taskId (IOException e) ioStates
= (Ok (),{iworld & ioTasks = {done=done,todo=todo}, ioStates = ioStates, world = world})
//Dynamically add a background task
addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
addBackgroundTask btid bt iworld=:{ioTasks={done,todo}}
# todo = todo ++ [BackgroundInstance {BackgroundInstanceOpts|bgInstId=btid} bt]
= (Ok (), {iworld & ioTasks={done=done, todo=todo}})
//Dynamically remove a background task
removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
removeBackgroundTask btid iworld=:{ioTasks={done,todo}}
//We filter the tasks and use the boolean state to hold whether a task was dropped
# (r, todo) = foldr (\e (b, l)->let (b`, e`)=drop e in (b` || b, if b` l [e`:l])) (False, []) todo
# iworld = {iworld & ioTasks={done=done, todo=todo}}
| not r = (Error (exception "No backgroundtask with that id"), iworld)
= (Ok (), iworld)
where
drop a=:(BackgroundInstance {bgInstId} _) = (bgInstId == btid, a)
drop a = (False, a)
checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!SelectResult)])
checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws)
checkSelect i chList = (Nothing,chList)
......@@ -334,6 +352,6 @@ halt iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done
# world = closeRChannel rChannel world
# world = closeChannel sChannel world
= halt {iworld & ioTasks = {todo=todo,done=done}}
halt iworld=:{ioTasks={todo=[BackgroundInstance _ :todo],done},world}
halt iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world}
= halt {iworld & ioTasks= {todo=todo,done=done}}
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