Commit ce9be5db authored by Bas Lijnse's avatar Bas Lijnse

Merge branch '110-waitfortimer-waits-one-hour-longer-than-specified' into 'master'

Resolve "waitForTimer waits one hour longer than specified"

Closes #110

See merge request !84
parents 1fd727ce f32a5e19
......@@ -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]
......
......@@ -56,10 +56,42 @@ derive gText Date, Time, DateTime
derive gEditor Date, Time, DateTime
//Util
timestampToGmDateTime :: !Timestamp -> DateTime
dateToTimestamp :: !Date -> Timestamp
datetimeToTimestamp :: !DateTime -> Timestamp
/*** Time & Date Conversion ***/
/**
* Converts a timestamp to UTC DateTime.
*
* @param Timestamp: The timestamp to convert.
*
* @return The resulting UTC DateTime
*/
timestampToGmDateTime :: !Timestamp -> DateTime
/**
* Converts a timestamp to local DateTime.
* This is a task, as the local time zone has to be detected.
*
* @param Timestamp: The timestamp to convert.
*
* @return The resulting local DateTime
*/
timestampToLocalDateTime :: !Timestamp -> Task DateTime
/**
* Converts a local Date to a timestamp.
* This is a task, as the local time zone has to be detected.
*
* @param Date: The date to convert
*
* @return The resulting timestamp
*/
localDateToTimestamp :: !Date -> Task Timestamp
/**
* Converts a local DateTime to a timestamp.
* This is a task, as the local time zone has to be detected.
*
* @param Date: The date & time to convert
*
* @return The resulting timestamp
*/
localDateTimeToTimestamp :: !DateTime -> Task Timestamp
/*** Special wait tasks ***/
......
......@@ -7,7 +7,8 @@ import iTasks.WF.Combinators.Core
import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.Overloaded
import iTasks.SDS.Sources.System
from iTasks.Internal.Task import mkInstantTask
import iTasks.Internal.IWorld
import iTasks.UI.Definition
import iTasks.UI.Prompt
import iTasks.UI.Editor
......@@ -21,6 +22,7 @@ import Data.Maybe, Data.Error
import qualified Data.Map as DM
from iTasks.Extensions.Form.Pikaday import pikadayDateField
from iTasks.Internal.Util import tmToDateTime
//* (Local) date and time
toTime :: DateTime -> Time
......@@ -184,19 +186,24 @@ derive gEq DateTime
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
,hour = tm.Tm.hour, min = tm.Tm.min, sec= tm.Tm.sec}
dateToTimestamp :: !Date -> Timestamp
dateToTimestamp {Date|day,mon,year}
= mkTime {Tm|sec = 0, min = 0, hour = 0, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}
timestampToLocalDateTime :: !Timestamp -> Task DateTime
timestampToLocalDateTime ts = mkInstantTask timestampToLocalDateTime`
where
timestampToLocalDateTime` _ iworld=:{world}
# (tm, world) = toLocalTime ts world
= (Ok (tmToDateTime tm), {iworld & world = world})
datetimeToTimestamp :: !DateTime -> Timestamp
datetimeToTimestamp {DateTime|day,mon,year,hour,min,sec}
= mkTime {Tm|sec = sec, min = min, hour = hour, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}
localDateToTimestamp :: !Date -> Task Timestamp
localDateToTimestamp {Date|day,mon,year} = mkInstantTask localDateToTimestamp`
where
localDateToTimestamp` _ iworld =
(Ok (mkTime {Tm|sec = 0, min = 0, hour = 0, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}), iworld)
localDateTimeToTimestamp :: !DateTime -> Task Timestamp
localDateTimeToTimestamp {DateTime|day,mon,year,hour,min,sec} = mkInstantTask localDateTimeToTimestamp`
where
localDateTimeToTimestamp` _ iworld =
(Ok (mkTime {Tm|sec = sec, min = min, hour = hour, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}), iworld)
waitForTime :: !Time -> Task Time
waitForTime time =
......@@ -210,13 +217,9 @@ waitForDateTime :: !DateTime -> Task DateTime
waitForDateTime datetime =
viewSharedInformation ("Wait for date and time", ("Wait until " +++ toString datetime)) [] currentDateTime >>* [OnValue (ifValue (\now -> datetime < now) return)]
waitForUTCDateTime :: !DateTime -> Task DateTime
waitForUTCDateTime datetime =
viewSharedInformation ("Wait for date and time", ("Wait until " +++ toString datetime)) [] currentUTCDateTime >>* [OnValue (ifValue (\now -> datetime < now) return)]
waitForTimer :: !Int -> Task DateTime
waitForTimer interval = get currentDateTime >>- \now -> waitForUTCDateTime (endTime interval now)
where
endTime interval now = let (Timestamp ts) = datetimeToTimestamp now in timestampToGmDateTime (Timestamp (ts + interval))
waitForTimer interval =
get currentTimestamp >>- \(Timestamp now) ->
timestampToLocalDateTime (Timestamp (now + interval)) >>- \endTime ->
waitForDateTime endTime
......@@ -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
......
......@@ -14,7 +14,7 @@ toStubIWorld world
= {IWorld
|options = {EngineOptions|appName="STUB",appPath="./",appVersion="STUB",serverPort=80,serverUrl="/127.0.0.1:80/",keepaliveTime=0,sessionTime=0
,persistTasks=False,autoLayout=False,webDirPath="./STUB/",storeDirPath="./STUB/",tempDirPath="./STUB/",saplDirPath="./STUB"}
,clocks = {SystemClocks |timestamp = Timestamp 0,localDate=defaultValue,localTime=defaultValue,utcDate=defaultValue,utcTime=defaultValue}
,clock = Timestamp 0
,current ={TaskEvalState|taskTime= 0,taskInstance= 0,sessionInstance = Nothing,attachmentChain = [] ,nextTaskNo = 0}
,sdsNotifyRequests = [], memoryShares = 'DM'.newMap, readCache = 'DM'.newMap, writeCache = 'DM'.newMap, exposedShares = 'DM'.newMap
,jsCompilerState = Nothing ,shutdown = Nothing ,ioTasks = {done = [], todo = []},ioStates = 'DM'.newMap
......
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
......
......@@ -7,6 +7,7 @@ from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from iTasks.Extensions.DateTime import :: DateTime
from StdOverloaded import class <
from System.Time import :: Tm
show :: ![String] !*World -> *World
......@@ -15,8 +16,7 @@ list2mb :: ![a] -> (Maybe [a])
instance toString (Maybe a) | toString a
currentLocalDateTimeWorld :: !*World -> (!DateTime,!*World)
currentUTCDateTimeWorld :: !*World -> (!DateTime,!*World)
tmToDateTime :: !Tm -> DateTime
//Path conversion
toCanonicalPath :: !FilePath !*World -> (!FilePath,!*World)
......
......@@ -22,29 +22,11 @@ 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
,hour = tm.Tm.hour, min = tm.Tm.min, sec= tm.Tm.sec}
dateToTimestamp :: !Date -> Timestamp
dateToTimestamp {Date|day,mon,year}
= mkTime {Tm|sec = 0, min = 0, hour = 0, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}
datetimeToTimestamp :: !DateTime -> Timestamp
datetimeToTimestamp {DateTime|day,mon,year,hour,min,sec}
= mkTime {Tm|sec = sec, min = min, hour = hour, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday =