Commit 56864024 authored by Mart Lubbers's avatar Mart Lubbers

remove removeOutdatedSessions backgroundtask

parent c0a3c282
Pipeline #19933 passed with stage
in 4 minutes and 40 seconds
......@@ -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)
......@@ -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)
......
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
......
......@@ -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 () () ()
......@@ -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)
}
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