remove removeOutdatedSessions backgroundtask

Libraries/iTasks/Engine.icl

@@ -64,16 +64,14 @@ doTasksWithOptions initFun startable world
 	= destroyIWorld iworld
 where
     webTasks = [t \\ WebTask t <- toStartable startable]
-	startupTasks {distributed, sdsPort} =
+	startupTasks {distributed, sdsPort}
 		//If distributed, start sds service task
-		= (if distributed [startTask (sdsServiceTask sdsPort)] [])
-		[removeOutdatedSessions
+		=  (if distributed [startTask (sdsServiceTask sdsPort)] [])
+		++ [startTask removeOutdatedSessions]
 		//Start all startup tasks
 		++ [t \\ StartupTask t <- toStartable startable]
 
-	startTask t
-		# (StartupTask t) = onStartup t
-		= t
+	startTask t = {StartupTask|attributes=defaultValue,task=TaskWrapper t}
 
 	hasWebTasks = not (webTasks =: [])
 
@@ -92,8 +90,7 @@ where
  		[BackgroundTask (processEvents MAX_EVENTS)
 		:if (webTasks =: [])
 			[BackgroundTask stopOnStable]
-			[BackgroundTask removeOutdatedSessions
-		 	,BackgroundTask flushWritesWhenIdle
+			[BackgroundTask flushWritesWhenIdle
 			]
 		]
 
@@ -264,4 +261,3 @@ determineAppVersion appPath world
 	# tm				= (fromOk res).lastModifiedTime
 	# version           = strfTime "%Y%m%d-%H%M%S" tm
 	= (version,world)
-

Libraries/iTasks/Internal/EngineTasks.dcl

@@ -3,7 +3,7 @@ definition module iTasks.Internal.EngineTasks
 * This module defines the separate system tasks that the iTasks engine performs
 */
 from iTasks.Internal.IWorld import :: IWorld
-from iTasks.WF.Definition import :: TaskException
+from iTasks.WF.Definition import :: TaskException, :: Task
 from Data.Error import :: MaybeError
 from Data.Maybe import :: Maybe
 from TCPIP import :: Timeout
@@ -12,7 +12,8 @@ timeout :: !(Maybe Timeout) !*IWorld -> (!Maybe Timeout,!*IWorld)
 
 updateClock :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
 
-removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
+//removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
+removeOutdatedSessions :: Task ()
 
 flushWritesWhenIdle:: !*IWorld -> (!MaybeError TaskException (), !*IWorld)
 

Libraries/iTasks/Internal/EngineTasks.icl

 implementation module iTasks.Internal.EngineTasks
 
 import StdBool, StdOverloaded, StdList, StdOrdList
+import iTasks.Internal.TaskEval
 import qualified Data.Map as DM
 import qualified Data.Set as DS
 import Data.List
@@ -59,20 +60,39 @@ updateClock iworld=:{IWorld|clock,world}
 	# (mbe,iworld)     = write timespec (sdsFocus {start=zero,interval=zero} iworldTimespec) EmptyContext iworld
 	= (() <$ mbe, iworld)
 
+everyTick :: (*IWorld -> *(!MaybeError TaskException (), !*IWorld)) -> Task ()
+everyTick f = Task eval
+where
+	eval event evalOpts tree=:(TCInit taskId ts) iworld
+		# (merr, iworld) = f iworld
+		| isError merr = (ExceptionResult (fromError merr), iworld)
+		# (merr, iworld) = readRegister taskId tick iworld
+		| isError merr = (ExceptionResult (fromError merr), iworld)
+		= (ValueResult
+				NoValue
+				{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes='DM'.newMap}
+				NoChange
+				(TCInit taskId ts)
+			, iworld)
+//:: Task a = Task !(Event TaskEvalOpts TaskTree *IWorld -> *(!TaskResult a, !*IWorld))
+//   = ValueResult !(TaskValue a) !TaskEvalInfo !UIChange !TaskTree   
+		
+	
 //When we run the built-in HTTP server we need to do active garbage collection of instances that were created for sessions
-removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
-removeOutdatedSessions iworld=:{IWorld|options}
-	# (mbIndex,iworld) = read (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) EmptyContext iworld
-	= case mbIndex of
-		Ok (ReadingDone index) = checkAll removeIfOutdated index iworld
-		Error e                = (Error e, iworld)
+//removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
+import iTasks.Internal.TaskServer
+removeOutdatedSessions :: Task ()
+removeOutdatedSessions = everyTick \iworld=:{IWorld|options}->
+	case read (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) EmptyContext iworld of
+		(Ok (ReadingDone index), iworld) = checkAll (removeIfOutdated options) index iworld
+		(Error e, iworld)                = (Error e, iworld)
 where
 	checkAll f [] iworld = (Ok (),iworld)
 	checkAll f [x:xs] iworld = case f x iworld of
 		(Ok (),iworld) = checkAll f xs iworld
 		(Error e,iworld) = (Error e,iworld)
 
-    removeIfOutdated (instanceNo,_,_,_) iworld=:{options={appVersion},clock=tNow}
+    removeIfOutdated options (instanceNo,_,_,_) iworld=:{options={appVersion},clock=tNow}
 		# (remove,iworld) = case read (sdsFocus instanceNo taskInstanceIO) EmptyContext iworld of
 			//If there is I/O information, we check that age first
 			(Ok (ReadingDone (Just (client,tInstance))),iworld) //No IO for too long, clean up

Libraries/iTasks/Internal/TaskServer.dcl

@@ -32,4 +32,7 @@ addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException Back
 //Dynamically remove a background task
 removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
 
-ioStateString :: !IOStates -> String
+//ioStateString :: !IOStates -> String
+
+//Ticks every time the server loops once
+tick :: SDSSource () () ()

Libraries/iTasks/Internal/TaskServer.icl

@@ -75,6 +75,9 @@ where
 
 loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld
 loop determineTimeout iworld=:{ioTasks,sdsNotifyRequests}
+	// Write ticker
+	# (merr, iworld=:{ioTasks,sdsNotifyRequests}) = write () tick EmptyContext iworld
+	| isError merr = abort "Error writing ticker"
 	// Also put all done tasks at the end of the todo list, as the previous event handling may have yielded new tasks.
 	# (mbTimeout,iworld=:{IWorld|ioTasks={todo},world}) = determineTimeout {iworld & ioTasks = {done=[], todo = ioTasks.todo ++ (reverse ioTasks.done)}}
 	//Check which mainloop tasks have data available
@@ -578,3 +581,11 @@ where
 	cMapString (IOActive mapje) = concat (map ((\s. s +++ " ") o toString o fst) ('DM'.toList mapje))
 	cMapString (IOException str) = "Exception: " +++ str
 	cMapString _ = "Destroyed"
+
+tick :: SDSSource () () ()
+tick = SDSSource
+	{SDSSourceOptions
+	| name  = "_ticker"
+	, read  = \p iw->(Ok (), iw)
+	, write = \p w iw->(Ok \_ _->True, iw)
+	}