We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit bbce32a9 authored by Steffen Michels's avatar Steffen Michels

keep only single timestamp in IWorld, instead of a collection of SystemClocks

parent 79f68fdb
......@@ -137,7 +137,7 @@ startEngineWithOptions initFun publishable world
where
tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) allUIChanges)]
engineTasks =
[BackgroundTask updateClocks
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle]
......@@ -159,7 +159,7 @@ runTasksWithOptions initFun runnable world
= destroyIWorld iworld
where
systemTasks =
[BackgroundTask updateClocks
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask stopOnStable]
......
......@@ -135,13 +135,7 @@ createClientIWorld serverURL currentInstance
, storeDirPath = locundef "dataDirectory"
, tempDirPath = locundef "tempDirectory"
, saplDirPath = locundef "saplDirectory"}
,clocks =
{ timestamp = timestamp
, localDate = {Date|day = 1, mon = 1, year = 1977}
, localTime = {Time|hour = 0, min = 0, sec = 0}
, utcDate = {Date|day = 1, mon = 1, year = 1977}
, utcTime = {Time|hour = 0, min = 0, sec = 0}
}
,clock = timestamp
,current =
{taskTime = 0
,taskInstance = currentInstance
......
......@@ -10,7 +10,7 @@ from TCPIP import :: Timeout
timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld)
updateClocks :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateClock :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
removeOutdatedSessions :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
......
......@@ -23,27 +23,13 @@ timeout iworld = case read taskEvents iworld of //Check if there are events in t
(Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait
(Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast
updateClocks :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateClocks iworld=:{IWorld|clocks,world}
updateClock :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateClock iworld=:{IWorld|clock,world}
//Determine current date and time
# (timestamp,world) = time world
# (local,world) = currentLocalDateTimeWorld world
# localDate = toDate local
localTime = toTime local
# (utc,world) = currentUTCDateTimeWorld world
# utcDate = toDate utc
utcTime = toTime utc
# iworld = {iworld & world = world}
//Write SDS's if necessary
# (mbe,iworld) = if (localDate == clocks.localDate) (Ok (),iworld) (write localDate iworldLocalDate iworld)
| mbe =:(Error _) = (mbe,iworld)
# (mbe,iworld) = if (localTime == clocks.localTime) (Ok (),iworld) (write localTime iworldLocalTime iworld)
| mbe =:(Error _) = (mbe,iworld)
# (mbe,iworld) = if (utcDate == clocks.utcDate) (Ok (),iworld) (write utcDate iworldUTCDate iworld)
| mbe =:(Error _) = (mbe,iworld)
# (mbe,iworld) = if (utcTime == clocks.utcTime) (Ok (),iworld) (write utcTime iworldUTCTime iworld)
| mbe =:(Error _) = (mbe,iworld)
# (mbe,iworld) = if (timestamp == clocks.timestamp) (Ok (),iworld) (write timestamp iworldTimestamp iworld)
//Write SDS if necessary
# (mbe,iworld) = if (timestamp == clock) (Ok (),iworld) (write timestamp iworldTimestamp iworld)
| mbe =:(Error _) = (mbe,iworld)
= (Ok (),iworld)
......@@ -60,7 +46,7 @@ where
(Ok (),iworld) = checkAll f xs iworld
(Error e,iworld) = (Error e,iworld)
removeIfOutdated (instanceNo,_,_,_) iworld=:{options={appVersion},clocks={timestamp}}
removeIfOutdated (instanceNo,_,_,_) iworld=:{options={appVersion},clock}
# (remove,iworld) = case read (sdsFocus instanceNo taskInstanceIO) iworld of
//If there is I/O information, we check that age first
(Ok (Just (client,Timestamp tInstance)),iworld) //No IO for too long, clean up
......@@ -89,7 +75,7 @@ where
(Error e)
= (Error e,iworld)
where
(Timestamp tNow) = timestamp
(Timestamp tNow) = clock
//When the event queue is empty, write deferred SDS's
flushWritesWhenIdle:: !*IWorld -> (!MaybeError TaskException (), !*IWorld)
......
......@@ -18,7 +18,7 @@ from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.WF.Definition import :: TaskValue, :: Event, :: TaskId, :: InstanceNo, :: TaskNo
from iTasks.WF.Combinators.Core import :: ParallelTaskType, :: TaskListItem
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared, :: Shared
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared, :: Shared, :: ReadOnlyShared
from iTasks.Internal.SDS import :: SDSNotifyRequest, :: JSONShared, :: DeferredWrite
from iTasks.Extensions.DateTime import :: Time, :: Date, :: DateTime
......@@ -31,7 +31,7 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC
CLEAN_HOME_VAR :== "CLEAN_HOME"
:: *IWorld = { options :: !EngineOptions // Engine configuration
, clocks :: !SystemClocks // Server side clocks
, clock :: !Timestamp // Server side clock
, current :: !TaskEvalState // Shared state during task evaluation
, random :: [Int] // Infinite random stream
......@@ -54,14 +54,6 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
, shutdown :: !Maybe Int // Signals the server function to shut down, the int will be set as exit code
}
:: SystemClocks =
{ timestamp :: !Timestamp
, localDate :: !Date
, localTime :: !Time
, utcDate :: !Date
, utcTime :: !Time
}
:: JSCompilerState =
{ loaderState :: !LoaderState // State of the lazy loader
, functionMap :: !FuncTypeMap // Function name -> source code mapping
......@@ -153,12 +145,12 @@ initJSCompilerState :: *IWorld -> *(!MaybeErrorString (), !*IWorld)
*/
destroyIWorld :: !*IWorld -> *World
//Internally used clock shares
iworldTimestamp :: Shared Timestamp
iworldLocalDate :: Shared Date
iworldLocalTime :: Shared Time
iworldUTCDate :: Shared Date
iworldUTCTime :: Shared Time
//Internally used clock share
// (UTC time can be derived from timestamp, local time requires *World to determine time zone)
iworldTimestamp :: Shared Timestamp
iworldLocalDateTime :: ReadOnlyShared DateTime
iworldLocalDateTime` :: !*IWorld -> (!DateTime, !*IWorld)
/*
* Gives you possibly a matching resource while adhering to the uniqueness
......
......@@ -26,7 +26,7 @@ import iTasks.Internal.TaskStore, iTasks.Internal.Util
import iTasks.Internal.Serialization
import iTasks.Internal.SDS
import qualified Data.Map as DM
import Data.Func, Data.Tuple, Data.List
import Data.Func, Data.Tuple, Data.List, iTasks.SDS.Definition
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
......@@ -57,19 +57,10 @@ JS_COMPILER_EXCLUDES :==
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld options world
# (local,world) = currentLocalDateTimeWorld world
# (utc,world) = currentUTCDateTimeWorld world
# (timestamp=:(Timestamp seed), world) = time world
= {IWorld
|options = options
,clocks =
{SystemClocks
|timestamp=timestamp
,localDate=toDate local
,localTime=toTime local
,utcDate=toDate utc
,utcTime=toTime utc
}
,clock = timestamp
,current =
{TaskEvalState
|taskTime = 0
......@@ -122,35 +113,28 @@ determineAppPath world
destroyIWorld :: !*IWorld -> *World
destroyIWorld iworld=:{IWorld|world} = world
iworldLocalDate :: Shared Date
iworldLocalDate = createReadWriteSDS "IWorld" "localDate" read write
where
read _ iworld=:{IWorld|clocks={localDate}} = (Ok localDate,iworld)
write _ localDate iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & localDate=localDate}})
iworldLocalTime :: Shared Time
iworldLocalTime = createReadWriteSDS "IWorld" "localTime" read write
where
read _ iworld=:{IWorld|clocks={localTime}} = (Ok localTime,iworld)
write _ localTime iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & localTime=localTime}})
iworldUTCDate :: Shared Date
iworldUTCDate = createReadWriteSDS "IWorld" "utcDate" read write
where
read _ iworld=:{IWorld|clocks={utcDate}} = (Ok utcDate,iworld)
write _ utcDate iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & utcDate=utcDate}})
iworldUTCTime :: Shared Time
iworldUTCTime = createReadWriteSDS "IWorld" "utcTime" read write
where
read _ iworld=:{IWorld|clocks={utcTime}} = (Ok utcTime,iworld)
write _ utcTime iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & utcTime=utcTime}})
iworldTimestamp :: Shared Timestamp
iworldTimestamp = createReadWriteSDS "IWorld" "timestamp" read write
where
read _ iworld=:{IWorld|clocks={timestamp}} = (Ok timestamp,iworld)
write _ timestamp iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & timestamp=timestamp}})
read _ iworld=:{IWorld|clock} = (Ok clock,iworld)
write _ timestamp iworld = (Ok (const True), {iworld & clock = timestamp})
iworldLocalDateTime :: ReadOnlyShared DateTime
iworldLocalDateTime = SDSParallel (createReadOnlySDS \_ -> iworldLocalDateTime`) iworldTimestamp sdsPar
where
// ignore value, but use notifications for 'iworldTimestamp'
sdsPar = { SDSParallel
| name = "iworldLocalDateTime"
, param = \p -> (p,p)
, read = fst
, writel = SDSWriteConst \_ _ -> Ok Nothing
, writer = SDSWriteConst \_ _ -> Ok Nothing
}
iworldLocalDateTime` :: !*IWorld -> (!DateTime, !*IWorld)
iworldLocalDateTime` iworld=:{clock, world}
# (tm, world) = toLocalTime clock world
= (tmToDateTime tm, {iworld & world = world})
iworldResource :: (*Resource -> (Bool, *Resource)) *IWorld -> (*[*Resource], *IWorld)
iworldResource f iworld=:{IWorld|resources}
......
......@@ -75,7 +75,7 @@ evalTaskInstance instanceNo event iworld
# (res,iworld) = evalTaskInstance` instanceNo event iworld
= (res,iworld)
where
evalTaskInstance` instanceNo event iworld=:{clocks={timestamp,localDate,localTime},current}
evalTaskInstance` instanceNo event iworld=:{clock,current}
# (constants, iworld) = 'SDS'.read (sdsFocus instanceNo taskInstanceConstants) iworld
| isError constants = ((\(Error (e,msg)) -> Error msg) constants, iworld)
# constants=:{InstanceConstants|session,listId} = fromOk constants
......@@ -116,9 +116,9 @@ where
// Check if instance was deleted by trying to reread the instance constants share
# (deleted,iworld) = appFst isError ('SDS'.read (sdsFocus instanceNo taskInstanceConstants) iworld)
// Write the updated progress
# (mbErr,iworld) = if (updateProgress timestamp newResult oldProgress === oldProgress)
# (mbErr,iworld) = if (updateProgress clock newResult oldProgress === oldProgress)
(Ok (),iworld) //Only update progress when something changed
('SDS'.modify (\p -> ((),updateProgress timestamp newResult p)) (sdsFocus instanceNo taskInstanceProgress) iworld)
('SDS'.modify (\p -> ((),updateProgress clock newResult p)) (sdsFocus instanceNo taskInstanceProgress) iworld)
= case mbErr of
Error (e,msg) = (Error msg,iworld)
Ok _
......@@ -178,22 +178,22 @@ where
updateInstanceLastIO ::![InstanceNo] !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateInstanceLastIO [] iworld = (Ok (),iworld)
updateInstanceLastIO [instanceNo:instanceNos] iworld=:{IWorld|clocks={timestamp}}
= case 'SDS'.modify (\io -> ((),fmap (appSnd (const timestamp)) io)) (sdsFocus instanceNo taskInstanceIO) iworld of
updateInstanceLastIO [instanceNo:instanceNos] iworld=:{IWorld|clock}
= case 'SDS'.modify (\io -> ((),fmap (appSnd (const clock)) io)) (sdsFocus instanceNo taskInstanceIO) iworld of
(Ok (),iworld) = updateInstanceLastIO instanceNos iworld
(Error e,iworld) = (Error e,iworld)
updateInstanceConnect :: !String ![InstanceNo] !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateInstanceConnect client [] iworld = (Ok (),iworld)
updateInstanceConnect client [instanceNo:instanceNos] iworld=:{IWorld|clocks={timestamp}}
= case 'SDS'.write (Just (client,timestamp)) (sdsFocus instanceNo taskInstanceIO) iworld of
updateInstanceConnect client [instanceNo:instanceNos] iworld=:{IWorld|clock}
= case 'SDS'.write (Just (client,clock)) (sdsFocus instanceNo taskInstanceIO) iworld of
(Ok (),iworld) = updateInstanceConnect client instanceNos iworld
(Error e,iworld) = (Error e,iworld)
updateInstanceDisconnect :: ![InstanceNo] !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
updateInstanceDisconnect [] iworld = (Ok (),iworld)
updateInstanceDisconnect [instanceNo:instanceNos] iworld=:{IWorld|clocks={timestamp}}
= case 'SDS'.modify (\io -> ((),fmap (appSnd (const timestamp)) io)) (sdsFocus instanceNo taskInstanceIO) iworld of
updateInstanceDisconnect [instanceNo:instanceNos] iworld=:{IWorld|clock}
= case 'SDS'.modify (\io -> ((),fmap (appSnd (const clock)) io)) (sdsFocus instanceNo taskInstanceIO) iworld of
(Ok (),iworld) = updateInstanceDisconnect instanceNos iworld
(Error e,iworld) = (Error e,iworld)
......
......@@ -125,23 +125,23 @@ newDocumentId iworld=:{IWorld|random}
= (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- random]) , {IWorld|iworld & random = drop 32 random})
createClientTaskInstance :: !(Task a) !String !InstanceNo !*IWorld -> *(!MaybeError TaskException TaskId, !*IWorld) | iTask a
createClientTaskInstance task sessionId instanceNo iworld=:{options={appVersion},current={taskTime},clocks={timestamp,localDate,localTime}}
createClientTaskInstance task sessionId instanceNo iworld=:{options={appVersion},current={taskTime},clock}
//Create the initial instance data in the store
# progress = {InstanceProgress|value=None,instanceKey="client",attachedTo=[],firstEvent=Nothing,lastEvent=Nothing}
# constants = {InstanceConstants|session=True,listId=TaskId 0 0,build=appVersion,issuedAt=timestamp}
# constants = {InstanceConstants|session=True,listId=TaskId 0 0,build=appVersion,issuedAt=clock}
= 'SDS'.write (instanceNo, Just constants,Just progress,Just defaultValue) (sdsFocus instanceNo taskInstance) iworld
`b` \iworld -> 'SDS'.write (createReduct defaultTonicOpts instanceNo task taskTime) (sdsFocus instanceNo taskInstanceReduct) iworld
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) iworld
`b` \iworld -> (Ok (TaskId instanceNo 0), iworld)
createTaskInstance :: !(Task a) !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
createTaskInstance task iworld=:{options={appVersion,autoLayout},current={taskTime},clocks={timestamp,localDate,localTime}}
createTaskInstance task iworld=:{options={appVersion,autoLayout},current={taskTime},clock}
# task = if autoLayout (tune (ApplyLayout defaultSessionLayout) task) task
# (mbInstanceNo,iworld) = newInstanceNo iworld
# instanceNo = fromOk mbInstanceNo
# (instanceKey,iworld) = newInstanceKey iworld
# progress = {InstanceProgress|value=None,instanceKey=instanceKey,attachedTo=[],firstEvent=Nothing,lastEvent=Nothing}
# constants = {InstanceConstants|session=True,listId=TaskId 0 0,build=appVersion,issuedAt=timestamp}
# constants = {InstanceConstants|session=True,listId=TaskId 0 0,build=appVersion,issuedAt=clock}
= 'SDS'.write (instanceNo, Just constants,Just progress,Just defaultValue) (sdsFocus instanceNo taskInstance) iworld
`b` \iworld -> 'SDS'.write (createReduct defaultTonicOpts instanceNo task taskTime) (sdsFocus instanceNo taskInstanceReduct) iworld
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) iworld
......@@ -152,11 +152,11 @@ createTaskInstance task iworld=:{options={appVersion,autoLayout},current={taskTi
(`b`) (Error e, st) _ = (Error e, st)
createDetachedTaskInstance :: !(Task a) !Bool !TaskEvalOpts !InstanceNo !TaskAttributes !TaskId !Bool !*IWorld -> (!MaybeError TaskException TaskId, !*IWorld) | iTask a
createDetachedTaskInstance task isTopLevel evalOpts instanceNo attributes listId refreshImmediate iworld=:{options={appVersion,autoLayout},current={taskTime},clocks={timestamp,localDate,localTime}}
createDetachedTaskInstance task isTopLevel evalOpts instanceNo attributes listId refreshImmediate iworld=:{options={appVersion,autoLayout},current={taskTime},clock}
# task = if autoLayout (tune (ApplyLayout defaultSessionLayout) task) task
# (instanceKey,iworld) = newInstanceKey iworld
# progress = {InstanceProgress|value=None,instanceKey=instanceKey,attachedTo=[],firstEvent=Nothing,lastEvent=Nothing}
# constants = {InstanceConstants|session=False,listId=listId,build=appVersion,issuedAt=timestamp}
# constants = {InstanceConstants|session=False,listId=listId,build=appVersion,issuedAt=clock}
= 'SDS'.write (instanceNo,Just constants,Just progress,Just attributes) (sdsFocus instanceNo taskInstance) iworld
`b` \iworld -> 'SDS'.write (createReduct (if isTopLevel defaultTonicOpts evalOpts.tonicOpts) instanceNo task taskTime) (sdsFocus instanceNo taskInstanceReduct) iworld
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) iworld
......
definition module iTasks.Internal.Tonic
from iTasks.Internal.SDS import :: Shared, :: ReadWriteShared, :: RWShared
from iTasks.Internal.IWorld import :: IWorld, :: SystemClocks
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Engine import :: PublishedTask
from iTasks.Internal.Task import :: TaskEvalOpts, :: TaskResult
from iTasks.WF.Definition import :: Task, :: InstanceNo, class iTask
......
......@@ -24,7 +24,7 @@ import iTasks.Extensions.DateTime
import System.File
from StdFunc import o
from System.FilePath import </>
from StdMisc import undef, abort
from StdMisc import abort
from StdFile import instance FileSystem World
import StdArray
import System.Directory, System.FilePath, Data.Func, Data.Functor, Data.List
......@@ -291,12 +291,12 @@ tonicWrapTaskBody` mn tn args cases t=:(Task eval)
case getTonicFunc mod tn of
Just bprep
# (curr, iworld) = iworld!current
# (clocks, iworld) = iworld!clocks
# (currDateTime, iworld) = iworldLocalDateTime` iworld
# (muser, iworld) = 'DSDS'.read (sdsFocus instanceNo taskInstanceUser) iworld
# bpinst = { BlueprintInstance
| bpi_taskId = currTaskId
, bpi_startTime = toDateTime clocks.localDate clocks.localTime
, bpi_lastUpdated = toDateTime clocks.localDate clocks.localTime
, bpi_startTime = currDateTime
, bpi_lastUpdated = currDateTime
, bpi_endTime = Nothing
, bpi_activeNodes = 'DM'.newMap
, bpi_previouslyActive = 'DM'.newMap
......@@ -324,11 +324,11 @@ tonicWrapTaskBody` mn tn args cases t=:(Task eval)
# (mbpref, iworld) = 'DSDS'.read (sdsFocus (currTaskId, mn, tn) tonicInstances) iworld
= case mbpref of
Ok (Just bpi)
# (clocks, iworld) = iworld!clocks
# (currDateTime, iworld) = iworldLocalDateTime` iworld
# oldActive = 'DM'.union ('DM'.fromList [(nid, tid) \\ (tid, nid) <- concatMap 'DIS'.elems ('DM'.elems bpi.bpi_activeNodes)])
bpi.bpi_previouslyActive
# (_, iworld) = 'DSDS'.write { bpi
& bpi_endTime = Just (toDateTime clocks.localDate clocks.localTime)
& bpi_endTime = Just currDateTime
, bpi_previouslyActive = oldActive
, bpi_activeNodes = 'DM'.newMap
} (sdsFocus (currTaskId, mn, tn) tonicInstances) iworld
......@@ -367,9 +367,8 @@ markStable currTaskId currBlueprintModuleName currBlueprintFuncName iworld
Ok (Just {bpi_endTime = Just _}) // Already marked as stable, don't do extra work
= iworld
Ok (Just bpi)
# (curr, iworld) = iworld!current
# (clocks, iworld) = iworld!clocks
# currDateTime = toDateTime clocks.localDate clocks.localTime
# (curr, iworld) = iworld!current
# (currDateTime, iworld) = iworldLocalDateTime` iworld
# oldActive = 'DM'.union ('DM'.fromList [(nid, tid) \\ (tid, nid) <- concatMap 'DIS'.elems ('DM'.elems bpi.bpi_activeNodes)])
bpi.bpi_previouslyActive
# (_, iworld) = 'DSDS'.write { bpi
......
......@@ -16,9 +16,7 @@ list2mb :: ![a] -> (Maybe [a])
instance toString (Maybe a) | toString a
currentLocalDateTimeWorld :: !*World -> (!DateTime,!*World)
currentUTCDateTimeWorld :: !*World -> (!DateTime,!*World)
tmToDateTime :: !Tm -> DateTime
tmToDateTime :: !Tm -> DateTime
//Path conversion
toCanonicalPath :: !FilePath !*World -> (!FilePath,!*World)
......
......@@ -22,16 +22,6 @@ list2mb :: ![a] -> (Maybe [a])
list2mb [] = Nothing
list2mb a = (Just a)
currentLocalDateTimeWorld :: !*World -> (!DateTime,!*World)
currentLocalDateTimeWorld world = appFst tmToDateTime (localTime world)
currentUTCDateTimeWorld :: !*World -> (!DateTime,!*World)
currentUTCDateTimeWorld world = appFst tmToDateTime (gmTime world)
timestampToGmDateTime :: !Timestamp -> DateTime
timestampToGmDateTime timestamp = tmToDateTime (toGmTime timestamp)
tmToDateTime :: !Tm -> DateTime
tmToDateTime tm
= {DateTime| day = tm.Tm.mday, mon = 1 + tm.Tm.mon, year = 1900 + tm.Tm.year
......
......@@ -133,21 +133,21 @@ httpServer :: !Int !Int ![WebService r w] (RWShared () r w) -> ConnectionTask |
httpServer port keepAliveTime requestProcessHandlers sds
= wrapIWorldConnectionTask {ConnectionHandlersIWorld|onConnect=onConnect, onData=onData, onShareChange=onShareChange, onTick=onTick, onDisconnect=onDisconnect} sds
where
onConnect host r iworld=:{IWorld|world,clocks}
= (Ok (NTIdle host clocks.timestamp),Nothing,[],False,{IWorld|iworld & world = world})
onConnect host r iworld=:{IWorld|world,clock}
= (Ok (NTIdle host clock),Nothing,[],False,{IWorld|iworld & world = world})
onData data connState=:(NTProcessingRequest request localState) r env
//Select handler based on request path
= case selectHandler request requestProcessHandlers of
Just {WebService | onData}
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = onData request r data localState env
# (mbData,done,localState,mbW,env=:{IWorld|world,clock}) = onData request r data localState env
| done && isKeepAlive request //Don't close the connection if we are done, but keepalive is enabled
= (Ok (NTIdle request.client_name clocks.timestamp), mbW, mbData, False,{IWorld|env & world = world})
= (Ok (NTIdle request.client_name clock), mbW, mbData, False,{IWorld|env & world = world})
| otherwise
= (Ok (NTProcessingRequest request localState), mbW, mbData,done,{IWorld|env & world = world})
Nothing
= (Ok connState, Nothing, ["HTTP/1.1 400 Bad Request\r\n\r\n"], True, env)
onData data connState r iworld=:{IWorld|clocks}
onData data connState r iworld=:{IWorld|clock}
//(connState is either Idle or ReadingRequest)
# rstate = case connState of
(NTIdle client_name _)
......@@ -186,7 +186,7 @@ where
Nothing
# reply = encodeResponse True response
| keepalive
= (Ok (NTIdle rstate.HttpReqState.request.client_name clocks.timestamp), mbW, [reply], False, iworld)
= (Ok (NTIdle rstate.HttpReqState.request.client_name clock), mbW, [reply], False, iworld)
| otherwise
= (Ok connState, mbW, [reply], True, iworld)
Just localState
......@@ -195,16 +195,16 @@ where
= (Ok (NTReadingRequest rstate), Nothing, [], False, iworld)
//Close idle connections if the keepalive time has passed
onTick connState=:(NTIdle ip (Timestamp t)) r iworld=:{IWorld|clocks={timestamp=Timestamp now}}
onTick connState=:(NTIdle ip (Timestamp t)) r iworld=:{IWorld|clock=Timestamp now}
= (Ok connState, Nothing, [], now >= t + keepAliveTime, iworld)
onTick connState=:(NTProcessingRequest request localState) r env
//Select handler based on request path
= case selectHandler request requestProcessHandlers of
Just {WebService | onTick}
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = onTick request r localState env
# (mbData,done,localState,mbW,env=:{IWorld|world,clock}) = onTick request r localState env
| done && isKeepAlive request //Don't close the connection if we are done, but keepalive is enabled
= (Ok (NTIdle request.client_name clocks.timestamp), mbW, mbData, False,{IWorld|env & world = world})
= (Ok (NTIdle request.client_name clock), mbW, mbData, False,{IWorld|env & world = world})
| otherwise
= (Ok (NTProcessingRequest request localState), mbW, mbData,done,{IWorld|env & world = world})
Nothing
......@@ -215,9 +215,9 @@ where
//Select handler based on request path
= case selectHandler request requestProcessHandlers of
Just {WebService | onShareChange}
# (mbData,done,localState,mbW,env=:{IWorld|world,clocks}) = onShareChange request r localState env
# (mbData,done,localState,mbW,env=:{IWorld|world,clock}) = onShareChange request r localState env
| done && isKeepAlive request //Don't close the connection if we are done, but keepalive is enabled
= (Ok (NTIdle request.client_name clocks.timestamp), mbW, mbData, False,{IWorld|env & world = world})
= (Ok (NTIdle request.client_name clock), mbW, mbData, False,{IWorld|env & world = world})
| otherwise
= (Ok (NTProcessingRequest request localState), mbW, mbData,done,{IWorld|env & world = world})
Nothing
......
......@@ -14,27 +14,27 @@ import iTasks.Internal.Util
import iTasks.Internal.TaskStore
import StdTuple
from iTasks.Internal.TaskEval import currentInstanceShare
from StdFunc import id
from StdFunc import id, o
NS_SYSTEM_DATA :== "SystemData"
currentDateTime :: SDS () DateTime ()
currentDateTime = mapRead (\(d,t) -> toDateTime d t) (iworldLocalDate |+| iworldLocalTime)
currentDateTime = iworldLocalDateTime
currentTime :: SDS () Time ()
currentTime = toReadOnly iworldLocalTime
currentTime = mapRead toTime iworldLocalDateTime
currentDate :: SDS () Date ()
currentDate = toReadOnly iworldLocalDate
currentDate = mapRead toDate iworldLocalDateTime
currentUTCDateTime :: SDS () DateTime ()
currentUTCDateTime = mapRead (\(d,t) -> toDateTime d t) (iworldUTCDate |+| iworldUTCTime)
currentUTCDateTime = mapRead timestampToGmDateTime currentTimestamp
currentUTCTime :: SDS () Time ()
currentUTCTime = toReadOnly iworldUTCTime
currentUTCTime = mapRead (toTime o timestampToGmDateTime) currentTimestamp
currentUTCDate :: SDS () Date ()
currentUTCDate = toReadOnly iworldUTCDate
currentUTCDate = mapRead (toDate o timestampToGmDateTime) currentTimestamp
currentTimestamp :: SDS () Timestamp ()
currentTimestamp = toReadOnly iworldTimestamp
......
......@@ -336,7 +336,7 @@ initParallelTask ::
,Maybe (TaskId,Task a))
,!*IWorld)
| iTask a
initParallelTask evalOpts=:{tonicOpts = {callTrace}} listId index parType parTask iworld=:{current={taskTime},clocks={localDate,localTime}}
initParallelTask evalOpts=:{tonicOpts = {callTrace}} listId index parType parTask iworld=:{current={taskTime}}
# (mbTaskStuff,iworld) = case parType of
Embedded = mkEmbedded 'DM'.newMap iworld
NamedEmbedded name = mkEmbedded ('DM'.singleton "name" name) iworld
......
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