implementation module iTasks.Framework.IWorld from System.FilePath import :: FilePath from Data.Map import :: Map from Data.Maybe import :: Maybe from System.Time import :: Timestamp, time from Text.JSON import :: JSONNode from iTasks.API.Core.Types import :: DateTime, :: User, :: Config, :: InstanceNo, :: TaskNo, :: TaskId, :: TaskListItem, :: ParallelTaskType, :: TaskTime from iTasks.Framework.TaskState import :: TaskListEntry from iTasks.Framework.UIDiff import :: UIUpdate from StdFile import class FileSystem(..) from StdFile import instance FileSystem World from StdFunc import const from Data.List import splitWith from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq import System.Time, StdList, Text.Encodings.Base64, _SystemArray, StdBool, StdTuple, Text.JSON, Data.Error, Data.Map import iTasks.Framework.TaskStore, iTasks.Framework.Util import iTasks.Framework.SerializationGraphCopy import iTasks.Framework.SDS iworldLocalDate :: Shared Date iworldLocalDate = createReadWriteSDS "IWorld" "localDate" read write where read Void iworld=:{IWorld|clocks={localDate}} = (Ok localDate,iworld) write Void localDate iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & localDate=localDate}}) iworldLocalTime :: Shared Time iworldLocalTime = createReadWriteSDS "IWorld" "localTime" read write where read Void iworld=:{IWorld|clocks={localTime}} = (Ok localTime,iworld) write Void localTime iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & localTime=localTime}}) iworldUTCDate :: Shared Date iworldUTCDate = createReadWriteSDS "IWorld" "utcDate" read write where read Void iworld=:{IWorld|clocks={utcDate}} = (Ok utcDate,iworld) write Void utcDate iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & utcDate=utcDate}}) iworldUTCTime :: Shared Time iworldUTCTime = createReadWriteSDS "IWorld" "utcTime" read write where read Void iworld=:{IWorld|clocks={utcTime}} = (Ok utcTime,iworld) write Void utcTime iworld=:{IWorld|clocks} = (Ok (const True), {iworld & clocks = {clocks & utcTime=utcTime}}) updateClocks :: !*IWorld -> *IWorld updateClocks iworld=:{IWorld|clocks,current,world} # (timestamp,world) = time world //Determine current date and time # (DateTime localDate localTime,world) = currentLocalDateTimeWorld world # (DateTime utcDate utcTime,world) = currentUTCDateTimeWorld world # iworld = {IWorld|iworld & current = {current & timestamp = timestamp}, world = world} //Write SDS's if necessary # iworld = if (localDate == clocks.localDate) iworld (snd (write localDate iworldLocalDate iworld)) # iworld = if (localTime == clocks.localTime) iworld (snd (write localTime iworldLocalTime iworld)) # iworld = if (utcDate == clocks.utcDate) iworld (snd (write utcDate iworldUTCDate iworld)) # iworld = if (utcTime == clocks.utcTime) iworld (snd (write utcTime iworldUTCTime iworld)) = iworld //Determine the expiration of request, thereby determining the poll interval of //polling clients REGULAR_EXPIRY :== 10000 FAST_EXPIRY :== 100 IMMEDIATE_EXPIRY :== 0 getResponseExpiry :: !InstanceNo !*IWorld -> (!Maybe Int, !*IWorld) getResponseExpiry instanceNo iworld=:{refreshQueue=[]} = (Just REGULAR_EXPIRY,iworld) getResponseExpiry instanceNo iworld=:{refreshQueue} = (Just FAST_EXPIRY,iworld) addUIUpdates :: !InstanceNo ![UIUpdate] !*IWorld -> *IWorld addUIUpdates instanceNo [] iworld = iworld addUIUpdates instanceNo updates iworld=:{uiUpdates} = {iworld & uiUpdates = put instanceNo (maybe updates (\u -> u ++ updates) (get instanceNo uiUpdates)) uiUpdates} popUIUpdates :: ![InstanceNo] !*IWorld -> (![(!InstanceNo,![UIUpdate])],!*IWorld) popUIUpdates instances iworld=:{uiUpdates} # uiUpdates = toList uiUpdates # outUpdates = [m \\ m=:(instanceNo,updates) <- uiUpdates | isMember instanceNo instances] # uiUpdates = [m \\ m=:(instanceNo,_) <- uiUpdates | not (isMember instanceNo instances)] = (outUpdates, {iworld & uiUpdates = fromList uiUpdates}) clearUIUpdates :: !InstanceNo !*IWorld -> *IWorld clearUIUpdates instanceNo iworld=:{uiUpdates} = {iworld & uiUpdates = del instanceNo uiUpdates} //Wrapper instance for file access instance FileSystem IWorld where fopen filename mode iworld=:{IWorld|world} # (ok,file,world) = fopen filename mode world = (ok,file,{IWorld|iworld & world = world}) fclose file iworld=:{IWorld|world} # (ok,world) = fclose file world = (ok,{IWorld|iworld & world = world}) stdio iworld=:{IWorld|world} # (io,world) = stdio world = (io,{IWorld|iworld & world = world}) sfopen filename mode iworld=:{IWorld|world} # (ok,file,world) = sfopen filename mode world = (ok,file,{IWorld|iworld & world = world})