Commit 5578633c authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into...

Merge branch 'master' into 224-older-applications-are-not-working-with-the-new-api-incidone-shipadventure
parents ed882256 815c8f7e
Pipeline #12435 passed with stage
in 3 minutes and 24 seconds
...@@ -37,6 +37,8 @@ from System.OS import IF_POSIX_OR_WINDOWS ...@@ -37,6 +37,8 @@ from System.OS import IF_POSIX_OR_WINDOWS
import System.GetOpt import System.GetOpt
import Data.Functor import Data.Functor
MAX_EVENTS :== 5
defaultEngineOptions :: !*World -> (!EngineOptions,!*World) defaultEngineOptions :: !*World -> (!EngineOptions,!*World)
defaultEngineOptions world defaultEngineOptions world
# (appPath,world) = determineAppPath world # (appPath,world) = determineAppPath world
...@@ -118,10 +120,15 @@ startEngineWithOptions initFun publishable world ...@@ -118,10 +120,15 @@ startEngineWithOptions initFun publishable world
# iworld = createIWorld (fromJust mbOptions) world # iworld = createIWorld (fromJust mbOptions) world
# (res,iworld) = initJSCompilerState iworld # (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld) | res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve [TaskWrapper removeOutdatedSessions] (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld # iworld = serve [] (tcpTasks options.serverPort options.keepaliveTime) engineTasks (timeout options.timeout) iworld
= destroyIWorld iworld = destroyIWorld iworld
where where
tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)] tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) taskOutput)]
engineTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle]
runTasks :: a !*World -> *World | Runnable a runTasks :: a !*World -> *World | Runnable a
runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world runTasks tasks world = runTasksWithOptions (\c o -> (Just o,[])) tasks world
...@@ -137,8 +144,13 @@ runTasksWithOptions initFun runnable world ...@@ -137,8 +144,13 @@ runTasksWithOptions initFun runnable world
# iworld = createIWorld options world # iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld # (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld) | res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld)
# iworld = serve (toRunnable runnable) [] (timeout options.timeout) iworld # iworld = serve (toRunnable runnable) [] systemTasks (timeout options.timeout) iworld
= destroyIWorld iworld = destroyIWorld iworld
where
systemTasks =
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask stopOnStable]
show :: ![String] !*World -> *World show :: ![String] !*World -> *World
show lines world show lines world
......
...@@ -143,7 +143,7 @@ createClientIWorld serverURL currentInstance ...@@ -143,7 +143,7 @@ createClientIWorld serverURL currentInstance
,attachmentChain = [] ,attachmentChain = []
,nextTaskNo = 6666 ,nextTaskNo = 6666
} }
,sdsNotifyRequests = [] ,sdsNotifyRequests = 'Data.Map'.newMap
,memoryShares = 'Data.Map'.newMap ,memoryShares = 'Data.Map'.newMap
,readCache = 'Data.Map'.newMap ,readCache = 'Data.Map'.newMap
,writeCache = 'Data.Map'.newMap ,writeCache = 'Data.Map'.newMap
......
...@@ -7,10 +7,13 @@ from iTasks.WF.Definition import :: TaskException ...@@ -7,10 +7,13 @@ from iTasks.WF.Definition import :: TaskException
from Data.Error import :: MaybeError from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe from Data.Maybe import :: Maybe
from TCPIP import :: Timeout from TCPIP import :: Timeout
from iTasks.WF.Definition import :: Task
timeout :: !(Maybe Timeout) !*IWorld -> (!Maybe Timeout,!*IWorld) timeout :: !(Maybe Timeout) !*IWorld -> (!Maybe Timeout,!*IWorld)
removeOutdatedSessions :: Task () updateClock :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
stopOnStable :: Task () removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
flushWritesWhenIdle:: !*IWorld -> (!MaybeError TaskException (), !*IWorld)
stopOnStable :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
implementation module iTasks.Internal.EngineTasks implementation module iTasks.Internal.EngineTasks
import StdBool, StdOverloaded, StdList, StdOrdList import StdBool, StdOverloaded, StdList, StdOrdList
import qualified Data.Map as DM
import qualified Data.Set as DS
import Data.List
import Data.Functor, Data.Func
import iTasks.Engine import iTasks.Engine
import iTasks.Internal.IWorld import iTasks.Internal.IWorld
import iTasks.WF.Definition import iTasks.WF.Definition
...@@ -9,7 +13,6 @@ import iTasks.Internal.SDS ...@@ -9,7 +13,6 @@ import iTasks.Internal.SDS
import iTasks.Internal.TaskStore import iTasks.Internal.TaskStore
import iTasks.SDS.Definition import iTasks.SDS.Definition
import iTasks.SDS.Combinators.Common import iTasks.SDS.Combinators.Common
import iTasks
from iTasks.Extensions.DateTime import toDate, toTime, instance == Date, instance == Time from iTasks.Extensions.DateTime import toDate, toTime, instance == Date, instance == Time
from System.Time import time from System.Time import time
...@@ -24,8 +27,7 @@ timeout mt iworld = case read taskEvents iworld of ...@@ -24,8 +27,7 @@ timeout mt iworld = case read taskEvents iworld of
//No events //No events
(Ok (Queue [] []),iworld=:{sdsNotifyRequests,world}) (Ok (Queue [] []),iworld=:{sdsNotifyRequests,world})
# (ts, world) = nsTime world # (ts, world) = nsTime world
# to = minListBy lesser [mt:map (getTimoutFromClock ts) sdsNotifyRequests] = ( minListBy lesser [mt:flatten $ map (getTimeoutFromClock ts) $ 'DM'.elems sdsNotifyRequests]
= ( minListBy lesser [mt:map (getTimoutFromClock ts) sdsNotifyRequests]
, {iworld & world = world}) , {iworld & world = world})
(Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait (Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait
(Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast (Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast
...@@ -34,38 +36,53 @@ where ...@@ -34,38 +36,53 @@ where
lesser (Just _) Nothing = True lesser (Just _) Nothing = True
lesser Nothing Nothing = False lesser Nothing Nothing = False
getTimoutFromClock :: Timespec SDSNotifyRequest -> Maybe Int getTimeoutFromClock :: Timespec (Map SDSNotifyRequest Timespec) -> [Maybe Timeout]
getTimoutFromClock now snr=:{cmpParam=(ts :: ClockParameter Timespec)} getTimeoutFromClock now requests = getTimeoutFromClock` <$> 'DM'.toList requests
| startsWith "$IWorld:timespec$" snr.reqSDSId && ts.interval <> zero where
# fire = iworldTimespecNextFire now snr.reqTimespec ts getTimeoutFromClock` :: (!SDSNotifyRequest, !Timespec) -> Maybe Timeout
= Just (max 0 (toMs fire - toMs now)) getTimeoutFromClock` (snr=:{cmpParam=(ts :: ClockParameter Timespec)}, reqTimespec)
= mt | startsWith "$IWorld:timespec$" snr.reqSDSId && ts.interval <> zero
getTimoutFromClock _ _ = mt # fire = iworldTimespecNextFire now reqTimespec ts
= Just (max 0 (toMs fire - toMs now))
= mt
getTimeoutFromClock` _ = mt
toMs x = x.tv_sec * 1000 + x.tv_nsec / 1000000 toMs x = x.tv_sec * 1000 + x.tv_nsec / 1000000
updateClock :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateClock iworld=:{IWorld|clock,world}
//Determine current date and time
# (timespec,world) = nsTime world
# iworld = {iworld & world = world}
//Write SDS if necessary
# (mbe,iworld) = write timespec (sdsFocus {start=zero,interval=zero} iworldTimespec) iworld
| mbe =:(Error _) = (mbe,iworld)
= (Ok (),iworld)
//When we run the built-in HTTP server we need to do active garbage collection of instances that were created for sessions //When we run the built-in HTTP server we need to do active garbage collection of instances that were created for sessions
removeOutdatedSessions :: Task () removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
removeOutdatedSessions = whileUnchanged (sdsFocus {start=Timestamp 0,interval=Timestamp 1} iworldTimestamp) removeOutdatedSessions iworld=:{IWorld|options}
\_->get (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) # (mbIndex,iworld) = read (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) iworld
>>- mkInstantTask o const o checkAll removeIfOutdated = case mbIndex of
Ok index = checkAll removeIfOutdated index iworld
Error e = (Error e, iworld)
where where
checkAll f [] iworld = (Ok (),iworld) checkAll f [] iworld = (Ok (),iworld)
checkAll f [x:xs] iworld = case f x iworld of checkAll f [x:xs] iworld = case f x iworld of
(Ok (),iworld) = checkAll f xs iworld (Ok (),iworld) = checkAll f xs iworld
(Error e,iworld) = (Error e,iworld) (Error e,iworld) = (Error e,iworld)
removeIfOutdated (instanceNo,_,_,_) iworld=:{options={appVersion,sessionTime},clock=tNow} removeIfOutdated (instanceNo,_,_,_) iworld=:{options={appVersion},clock=tNow}
# (remove,iworld) = case read (sdsFocus instanceNo taskInstanceIO) iworld of # (remove,iworld) = case read (sdsFocus instanceNo taskInstanceIO) iworld of
//If there is I/O information, we check that age first //If there is I/O information, we check that age first
(Ok (Just (client,tInstance)),iworld) //No IO for too long, clean up (Ok (Just (client,tInstance)),iworld) //No IO for too long, clean up
= (Ok ((tNow - tInstance) > sessionTime),iworld) = (Ok ((tNow - tInstance) > options.EngineOptions.sessionTime),iworld)
//If there is no I/O information, get meta-data and check builtId and creation date //If there is no I/O information, get meta-data and check builtId and creation date
(Ok Nothing,iworld) (Ok Nothing,iworld)
= case read (sdsFocus instanceNo taskInstanceConstants) iworld of = case read (sdsFocus instanceNo taskInstanceConstants) iworld of
(Ok {InstanceConstants|build,issuedAt=tInstance},iworld) (Ok {InstanceConstants|build,issuedAt=tInstance},iworld)
| build <> appVersion = (Ok True,iworld) | build <> appVersion = (Ok True,iworld)
| (tNow - tInstance) > sessionTime = (Ok True,iworld) | (tNow - tInstance) > options.EngineOptions.sessionTime = (Ok True,iworld)
= (Ok False,iworld) = (Ok False,iworld)
(Error e,iworld) (Error e,iworld)
= (Error e,iworld) = (Error e,iworld)
...@@ -92,15 +109,19 @@ flushWritesWhenIdle iworld = case read taskEvents iworld of ...@@ -92,15 +109,19 @@ flushWritesWhenIdle iworld = case read taskEvents iworld of
//When we don't run the built-in HTTP server we don't want to loop forever so we stop the loop //When we don't run the built-in HTTP server we don't want to loop forever so we stop the loop
//once all tasks are stable //once all tasks are stable
stopOnStable :: Task () stopOnStable :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
stopOnStable = get (sdsFocus {InstanceFilter|defaultValue & includeProgress=True} filteredInstanceIndex) stopOnStable iworld=:{IWorld|shutdown}
>>- \index->mkInstantTask \tid iworld=:{shutdown}->case shutdown of # (mbIndex,iworld) = read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True} filteredInstanceIndex) iworld
Just _ = (Ok (), iworld) = case mbIndex of
_ = (Ok (), {iworld & shutdown= Ok index
if (allStable index) # shutdown = case shutdown of
(Just (if (exceptionOccurred index) 1 0)) Nothing = if (allStable index) (Just (if (exceptionOccurred index) 1 0)) Nothing
Nothing}) _ = shutdown
= (Ok (), {IWorld|iworld & shutdown = shutdown})
Error e = (Error e, iworld)
where where
allStable instances = all (\v -> v =: Stable || v =: (Exception _)) (values instances) allStable instances = all (\v -> v =: Stable || v =: (Exception _)) (values instances)
exceptionOccurred instances = any (\v -> v =: (Exception _)) (values instances) exceptionOccurred instances = any (\v -> v =: (Exception _)) (values instances)
values instances = [value \\ (_,_,Just {InstanceProgress|value},_) <- instances] values instances = [value \\ (_,_,Just {InstanceProgress|value},_) <- instances]
...@@ -18,7 +18,7 @@ from iTasks.Internal.TaskEval import :: TaskTime ...@@ -18,7 +18,7 @@ from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.WF.Definition import :: TaskValue, :: Event, :: TaskId, :: InstanceNo, :: TaskNo from iTasks.WF.Definition import :: TaskValue, :: Event, :: TaskId, :: InstanceNo, :: TaskNo
from iTasks.WF.Combinators.Core import :: ParallelTaskType, :: TaskListItem from iTasks.WF.Combinators.Core import :: ParallelTaskType, :: TaskListItem
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared, :: Shared, :: ReadOnlyShared from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared, :: Shared, :: ReadOnlyShared
from iTasks.Internal.SDS import :: SDSNotifyRequest, :: JSONShared, :: DeferredWrite from iTasks.Internal.SDS import :: SDSNotifyRequest, :: JSONShared, :: DeferredWrite, :: SDSIdentity
from iTasks.Extensions.DateTime import :: Time, :: Date, :: DateTime from iTasks.Extensions.DateTime import :: Time, :: Date, :: DateTime
from Sapl.Linker.LazyLinker import :: LoaderState from Sapl.Linker.LazyLinker import :: LoaderState
...@@ -29,23 +29,23 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC ...@@ -29,23 +29,23 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC
CLEAN_HOME_VAR :== "CLEAN_HOME" CLEAN_HOME_VAR :== "CLEAN_HOME"
:: *IWorld = { options :: !EngineOptions // Engine configuration :: *IWorld = { options :: !EngineOptions // Engine configuration
, clock :: !Timespec // Server side clock , clock :: !Timespec // Server side clock
, current :: !TaskEvalState // Shared state during task evaluation , current :: !TaskEvalState // Shared state during task evaluation
, random :: [Int] // Infinite random stream , random :: [Int] // Infinite random stream
, sdsNotifyRequests :: ![SDSNotifyRequest] // Notification requests from previously read sds's , sdsNotifyRequests :: !Map SDSIdentity (Map SDSNotifyRequest Timespec) // Notification requests from previously read sds's
, memoryShares :: !Map String Dynamic // Run-time memory shares , memoryShares :: !Map String Dynamic // Run-time memory shares
, readCache :: !Map (String,String) Dynamic // Cached share reads , readCache :: !Map (String,String) Dynamic // Cached share reads
, writeCache :: !Map (String,String) (Dynamic,DeferredWrite) // Cached deferred writes , writeCache :: !Map (String,String) (Dynamic,DeferredWrite) // Cached deferred writes
, exposedShares :: !Map String (Dynamic, JSONShared) // Shared source , exposedShares :: !Map String (Dynamic, JSONShared) // Shared source
, jsCompilerState :: !Maybe JSCompilerState // Sapl to Javascript compiler state , jsCompilerState :: !Maybe JSCompilerState // Sapl to Javascript compiler state
, ioTasks :: !*IOTasks // The low-level input/output tasks , ioTasks :: !*IOTasks // The low-level input/output tasks
, ioStates :: !IOStates // Results of low-level io tasks, indexed by the high-level taskid that it is linked to , ioStates :: !IOStates // Results of low-level io tasks, indexed by the high-level taskid that it is linked to
, world :: !*World // The outside world , world :: !*World // The outside world
//Experimental database connection cache //Experimental database connection cache
, resources :: *[*Resource] , resources :: *[*Resource]
...@@ -77,10 +77,11 @@ CLEAN_HOME_VAR :== "CLEAN_HOME" ...@@ -77,10 +77,11 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: *IOTaskInstance :: *IOTaskInstance
= ListenerInstance !ListenerInstanceOpts !*TCP_Listener = ListenerInstance !ListenerInstanceOpts !*TCP_Listener
| ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel | ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel
| BackgroundInstance !BackgroundInstanceOpts !BackgroundTask
:: ListenerInstanceOpts = :: ListenerInstanceOpts =
{ taskId :: !TaskId //Reference to the task that created the listener { taskId :: !TaskId //Reference to the task that created the listener
, nextConnectionId :: !ConnectionId , nextConnectionId :: !ConnectionId
, port :: !Int , port :: !Int
, connectionTask :: !ConnectionTask , connectionTask :: !ConnectionTask
, removeOnClose :: !Bool //If this flag is set, states of connections accepted by this listener are removed when the connection is closed , removeOnClose :: !Bool //If this flag is set, states of connections accepted by this listener are removed when the connection is closed
...@@ -96,6 +97,12 @@ CLEAN_HOME_VAR :== "CLEAN_HOME" ...@@ -96,6 +97,12 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: ConnectionId :== Int :: ConnectionId :== Int
:: BackgroundInstanceOpts =
{ bgInstId :: !BackgroundTaskId
}
:: BackgroundTaskId :== Int
:: IOStates :== Map TaskId IOState :: IOStates :== Map TaskId IOState
:: IOState :: IOState
= IOActive !(Map ConnectionId (!Dynamic,!Bool)) // Bool: stability = IOActive !(Map ConnectionId (!Dynamic,!Bool)) // Bool: stability
...@@ -138,8 +145,6 @@ destroyIWorld :: !*IWorld -> *World ...@@ -138,8 +145,6 @@ destroyIWorld :: !*IWorld -> *World
} }
iworldTimespec :: SDS (ClockParameter Timespec) Timespec Timespec iworldTimespec :: SDS (ClockParameter Timespec) Timespec Timespec
iworldTimestamp :: SDS (ClockParameter Timestamp) Timestamp Timestamp
/* /*
* Calculate the next fire for the given timespec * Calculate the next fire for the given timespec
* *
...@@ -149,7 +154,7 @@ iworldTimestamp :: SDS (ClockParameter Timestamp) Timestamp Timestamp ...@@ -149,7 +154,7 @@ iworldTimestamp :: SDS (ClockParameter Timestamp) Timestamp Timestamp
* @result time to fire next * @result time to fire next
*/ */
iworldTimespecNextFire :: Timespec Timespec (ClockParameter Timespec) -> Timespec iworldTimespecNextFire :: Timespec Timespec (ClockParameter Timespec) -> Timespec
iworldTimestamp :: SDS (ClockParameter Timestamp) Timestamp Timestamp
iworldLocalDateTime :: ReadOnlyShared DateTime iworldLocalDateTime :: ReadOnlyShared DateTime
iworldLocalDateTime` :: !*IWorld -> (!DateTime, !*IWorld) iworldLocalDateTime` :: !*IWorld -> (!DateTime, !*IWorld)
......
...@@ -71,7 +71,7 @@ createIWorld options world ...@@ -71,7 +71,7 @@ createIWorld options world
,attachmentChain = [] ,attachmentChain = []
,nextTaskNo = 0 ,nextTaskNo = 0
} }
,sdsNotifyRequests = [] ,sdsNotifyRequests = 'DM'.newMap
,memoryShares = 'DM'.newMap ,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap ,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap ,writeCache = 'DM'.newMap
......
...@@ -13,16 +13,16 @@ import iTasks.SDS.Definition ...@@ -13,16 +13,16 @@ import iTasks.SDS.Definition
//Notification requests are stored in the IWorld //Notification requests are stored in the IWorld
:: SDSNotifyRequest = :: SDSNotifyRequest =
{ reqTaskId :: TaskId //Id of the task that read the SDS. This Id also connects a chain of notify requests that were registered together { reqTaskId :: !TaskId //Id of the task that read the SDS. This Id also connects a chain of notify requests that were registered together
, reqSDSId :: SDSIdentity //Id of the actual SDS used to create this request (may be a derived one) , reqSDSId :: !SDSIdentity //Id of the actual SDS used to create this request (may be a derived one)
, reqTimespec :: Timespec
, cmpSDSId :: SDSIdentity //Id of the SDS we are saving for comparison , cmpParam :: !Dynamic //Parameter we are saving for comparison
, cmpParam :: Dynamic //Parameter we are saving for comparison , cmpParamText :: !String //String version of comparison parameter for tracing
, cmpParamText :: String //String version of comparison parameter for tracing
} }
:: SDSIdentity :== String :: SDSIdentity :== String
instance < SDSNotifyRequest
:: DeferredWrite = E. p r w: DeferredWrite !p !w !(SDS p r w) & iTask p & TC r & TC w :: DeferredWrite = E. p r w: DeferredWrite !p !w !(SDS p r w) & iTask p & TC r & TC w
//Internal creation functions: //Internal creation functions:
......
implementation module iTasks.Internal.SDS implementation module iTasks.Internal.SDS
from StdFunc import const from StdFunc import const
import StdString, StdTuple, StdMisc, StdList, StdBool import StdString, StdTuple, StdMisc, StdList, StdBool, StdFunc
from Data.Map import :: Map from Data.Map import :: Map
import qualified Data.Map as DM import qualified Data.Map as DM
import Data.Error, Data.Func, Data.Tuple, System.OS, System.Time, Text, Text.GenJSON import Data.Error, Data.Func, Data.Tuple, System.OS, System.Time, Text, Text.GenJSON
...@@ -77,8 +77,13 @@ mbRegister :: !p !(RWShared p r w) !(Maybe TaskId) !SDSIdentity !*IWorld -> *IWo ...@@ -77,8 +77,13 @@ mbRegister :: !p !(RWShared p r w) !(Maybe TaskId) !SDSIdentity !*IWorld -> *IWo
mbRegister p sds Nothing reqSDSId iworld = iworld mbRegister p sds Nothing reqSDSId iworld = iworld
mbRegister p sds (Just taskId) reqSDSId iworld=:{IWorld|sdsNotifyRequests,world} mbRegister p sds (Just taskId) reqSDSId iworld=:{IWorld|sdsNotifyRequests,world}
# (ts, world) = nsTime world # (ts, world) = nsTime world
# req = {SDSNotifyRequest|reqTimespec=ts,reqTaskId=taskId,reqSDSId=reqSDSId,cmpSDSId=sdsIdentity sds,cmpParam=dynamic p,cmpParamText=toSingleLineText p} # req = {SDSNotifyRequest|reqTaskId=taskId,reqSDSId=reqSDSId,cmpParam=dynamic p,cmpParamText=toSingleLineText p}
= {iworld & world=world, sdsNotifyRequests = [req:sdsNotifyRequests]} = { iworld
& world = world
, sdsNotifyRequests = 'DM'.alter (Just o maybe ('DM'.singleton req ts) ('DM'.put req ts))
(sdsIdentity sds)
sdsNotifyRequests
}
read` :: !p !(Maybe TaskId) !SDSIdentity !(RWShared p r w) !*IWorld -> (!MaybeError TaskException r, !*IWorld) | iTask p & TC r read` :: !p !(Maybe TaskId) !SDSIdentity !(RWShared p r w) !*IWorld -> (!MaybeError TaskException r, !*IWorld) | iTask p & TC r
read` p mbNotify reqSDSId sds=:(SDSSource {SDSSource|read}) env read` p mbNotify reqSDSId sds=:(SDSSource {SDSSource|read}) env
...@@ -340,13 +345,14 @@ checkRegistrations sdsId pred iworld ...@@ -340,13 +345,14 @@ checkRegistrations sdsId pred iworld
= (match,nomatch,iworld) = (match,nomatch,iworld)
where where
//Find all notify requests for the given share id //Find all notify requests for the given share id
lookupRegistrations sdsId iworld=:{sdsNotifyRequests} lookupRegistrations :: String !*IWorld -> (![(!SDSNotifyRequest, !Timespec)], !*IWorld)
= ([reg \\ reg=:{SDSNotifyRequest|cmpSDSId} <- sdsNotifyRequests | cmpSDSId == sdsId],iworld) lookupRegistrations sdsId iworld=:{sdsNotifyRequests} =
('DM'.toList $ 'DM'.findWithDefault 'DM'.newMap sdsId sdsNotifyRequests, iworld)
//Match the notify requests against the predicate to determine two sets: //Match the notify requests against the predicate to determine two sets:
//The registrations that matched the predicate, and those that did not match the predicate //The registrations that matched the predicate, and those that did not match the predicate
matchRegistrations pred [] = ('Set'.newSet,'Set'.newSet) matchRegistrations pred [] = ('Set'.newSet,'Set'.newSet)
matchRegistrations pred [{SDSNotifyRequest|reqTimespec,reqTaskId,cmpParam}:regs] matchRegistrations pred [({SDSNotifyRequest|reqTaskId,cmpParam}, reqTimespec):regs]
# (match,nomatch) = matchRegistrations pred regs # (match,nomatch) = matchRegistrations pred regs
= case cmpParam of = case cmpParam of
(p :: p^) = if (pred reqTimespec p) (p :: p^) = if (pred reqTimespec p)
...@@ -371,13 +377,25 @@ queueNotifyEvents sdsId notify iworld ...@@ -371,13 +377,25 @@ queueNotifyEvents sdsId notify iworld
clearTaskSDSRegistrations :: !(Set TaskId) !*IWorld -> *IWorld clearTaskSDSRegistrations :: !(Set TaskId) !*IWorld -> *IWorld
clearTaskSDSRegistrations taskIds iworld=:{IWorld|sdsNotifyRequests} clearTaskSDSRegistrations taskIds iworld=:{IWorld|sdsNotifyRequests}
= {iworld & sdsNotifyRequests = [r \\ r=:{SDSNotifyRequest|reqTaskId} <- sdsNotifyRequests | not ('Set'.member reqTaskId taskIds)]} = {iworld & sdsNotifyRequests = 'DM'.foldlWithKey clearRegistrationRequests 'DM'.newMap sdsNotifyRequests}
where
clearRegistrationRequests :: (Map SDSIdentity (Map SDSNotifyRequest Timespec))
SDSIdentity
(Map SDSNotifyRequest Timespec)
-> Map SDSIdentity (Map SDSNotifyRequest Timespec)
clearRegistrationRequests notifyRequests sdsIdentity requests
| 'DM'.null filteredRequests = notifyRequests
| otherwise = 'DM'.put sdsIdentity filteredRequests notifyRequests
where
filteredRequests = 'DM'.filterWithKey (\req _ -> not $ 'Set'.member req.reqTaskId taskIds) requests
listAllSDSRegistrations :: *IWorld -> (![(InstanceNo,[(TaskId,SDSIdentity)])],!*IWorld) listAllSDSRegistrations :: *IWorld -> (![(InstanceNo,[(TaskId,SDSIdentity)])],!*IWorld)
listAllSDSRegistrations iworld=:{IWorld|sdsNotifyRequests} = ('DM'.toList (foldr addReg 'DM'.newMap sdsNotifyRequests),iworld) listAllSDSRegistrations iworld=:{IWorld|sdsNotifyRequests} = ('DM'.toList ('DM'.foldrWithKey addRegs 'DM'.newMap sdsNotifyRequests),iworld)
where where
addReg {SDSNotifyRequest|reqTaskId=reqTaskId=:(TaskId taskInstance _),cmpSDSId} list addRegs cmpSDSId reqs list = 'DM'.foldlWithKey addReg list reqs
= 'DM'.put taskInstance [(reqTaskId,cmpSDSId):fromMaybe [] ('DM'.get taskInstance list)] list where
addReg list {SDSNotifyRequest|reqTaskId=reqTaskId=:(TaskId taskInstance _)} _
= 'DM'.put taskInstance [(reqTaskId,cmpSDSId):fromMaybe [] ('DM'.get taskInstance list)] list
formatSDSRegistrationsList :: [(InstanceNo,[(TaskId,SDSIdentity)])] -> String formatSDSRegistrationsList :: [(InstanceNo,[(TaskId,SDSIdentity)])] -> String
formatSDSRegistrationsList list formatSDSRegistrationsList list
...@@ -433,5 +451,8 @@ newURL iworld=:{IWorld|options={serverUrl},random} ...@@ -433,5 +451,8 @@ newURL iworld=:{IWorld|options={serverUrl},random}
// TODO: different URL for clients // TODO: different URL for clients
getURLbyId :: !String !*IWorld -> (!String, !*IWorld) getURLbyId :: !String !*IWorld -> (!String, !*IWorld)
getURLbyId sdsId iworld=:{IWorld|options={serverUrl},random} getURLbyId sdsId iworld=:{IWorld|options={serverUrl},random}
= ("sds:" +++ serverUrl +++ "/" +++ sdsId, iworld) = ("sds:" +++ serverUrl +++ "/" +++ sdsId, iworld)
// some efficient order to be able to put notify requests in sets
instance < SDSNotifyRequest where
< x y = (x.reqTaskId, x.reqSDSId, x.cmpParamText) < (y.reqTaskId, y.reqSDSId, y.cmpParamText)
...@@ -10,13 +10,21 @@ from Data.Error import :: MaybeError ...@@ -10,13 +10,21 @@ from Data.Error import :: MaybeError
from iTasks.WF.Definition import :: TaskId from iTasks.WF.Definition import :: TaskId
from iTasks.Internal.Task import :: ConnectionTask, :: TaskException from iTasks.Internal.Task import :: ConnectionTask, :: TaskException
from iTasks.Internal.IWorld import :: IWorld from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.IWorld import :: IWorld, :: BackgroundTaskId
from iTasks.Internal.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException
from iTasks.Engine import :: TaskWrapper from iTasks.Engine import :: TaskWrapper
//Core task server loop //Core task server loop
serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
//Dynamically add a listener //Dynamically add a listener
addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld) addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically add a connection //Dynamically add a connection
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException Dynamic,!*IWorld) addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException Dynamic,!*IWorld)
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
//Dynamically remove a background task
removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld)
...@@ -18,28 +18,27 @@ from iTasks.Internal.TaskStore import queueRefresh ...@@ -18,28 +18,27 @@ from iTasks.Internal.TaskStore import queueRefresh
import iTasks.WF.Tasks.IO