Commit a324c52a authored by Mart Lubbers's avatar Mart Lubbers

Move ticker write so that there is no feedback loop

parent 56864024
Pipeline #19934 passed with stage
in 4 minutes and 42 seconds
......@@ -12,7 +12,6 @@ timeout :: !(Maybe Timeout) !*IWorld -> (!Maybe Timeout,!*IWorld)
updateClock :: !*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 Data.Functor, Data.Func
import Data.List
import qualified Data.Map as DM
import Data.Queue
import qualified Data.Set as DS
import Data.List
import Data.Functor, Data.Func
import StdBool, StdOverloaded, StdList, StdOrdList
import System.Time
import Text
import Text.GenJSON
import iTasks.Engine
import iTasks.Extensions.DateTime
import iTasks.Internal.IWorld
import iTasks.WF.Definition
import iTasks.Internal.Util
import iTasks.Internal.SDS
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskServer
import iTasks.Internal.TaskStore
import iTasks.SDS.Definition
import iTasks.Internal.Util
import iTasks.SDS.Combinators.Common
from iTasks.Extensions.DateTime import toDate, toTime, instance == Date, instance == Time
from System.Time import time
import Text.GenJSON
import iTasks.SDS.Definition
import iTasks.WF.Definition
from TCPIP import :: Timeout
import Data.Queue
import Text
timeout :: !(Maybe Timeout) !*IWorld -> (!Maybe Timeout,!*IWorld)
timeout mt iworld = case read taskEvents EmptyContext iworld of
//No events
......@@ -74,13 +73,8 @@ where
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)
import iTasks.Internal.TaskServer
removeOutdatedSessions :: Task ()
removeOutdatedSessions = everyTick \iworld=:{IWorld|options}->
case read (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) EmptyContext iworld of
......@@ -143,5 +137,3 @@ where
allStable instances = all (\v -> v =: Stable || v =: (Exception _)) (values instances)
exceptionOccurred instances = any (\v -> v =: (Exception _)) (values instances)
values instances = [value \\ (_,_,Just {InstanceProgress|value},_) <- instances]
......@@ -75,15 +75,15 @@ 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
# (todo,chList,world) = select mbTimeout todo world
# (merr, iworld) = updateClock {iworld & ioTasks = {done=[],todo=todo}, world = world}
| merr=:(Error _) = abort "Error updating clock"
// Write ticker
# (merr, iworld) = write () tick EmptyContext iworld
| isError merr = abort "Error writing ticker"
//Process the select result
# iworld =:{shutdown,ioTasks={done}} = process 0 chList iworld
//Move everything from the done list back to the todo list
......
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