Merge branch 'master' into ui-reorg

# Conflicts:
#	Dependencies/clean-platform
#	Server/iTasks/_Framework/Engine.icl
#	Server/iTasks/_Framework/TaskServer.icl

clean-platform @ 4a65aaea

-Subproject commit 39a70914d16744646679de573b012cd494fea052
+Subproject commit 4a65aaeaf40e3754c6b53a0574bda2786e861e47

Dependencies/graph_copy/linux64/.gitignore

+*.[aso]
+Clean System Files/*.o

Dependencies/graph_copy/linux64/Makefile

@@ -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
 

Examples/BasicAPIExamples.icl

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

Server/iTasks/_Framework/Engine.dcl

@@ -25,6 +25,17 @@ RELATIVE_LOCATIONS		:== [".": take 5 (iterate ((</>) "..") "..")]
 	, 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
 */

Server/iTasks/_Framework/Engine.icl

@@ -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
@@ -103,9 +108,26 @@ where
 		| 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
 

Server/iTasks/_Framework/IWorld.dcl

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

Server/iTasks/_Framework/TaskServer.dcl

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

Server/iTasks/_Framework/TaskServer.icl

@@ -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}}