_Util.icl 1.66 KB
Newer Older
1
implementation module iTasks.Extensions.Distributed._Util
2 3

import iTasks
4
from iTasks.Internal.Store import memoryStore, :: StoreName, :: StoreNamespace
5
from System.Time import :: Timestamp(..)
6 7
from iTasks.Extensions.DateTime import :: DateTime, instance < DateTime, instance toString DateTime, timestampToGmDateTime, localDateTimeToTimestamp
from Data.Maybe import fromMaybe, isNothing, fromJust, maybe, instance Functor Maybe, isJust
8

9
memoryShare_ :: String a -> SimpleSDSLens a | iTask a
10
memoryShare_ name default = sdsFocus name (memoryStore name (Just default))
11 12 13 14

repeatClient :: (Task (Maybe a)) -> Task (Maybe a) | iTask a
repeatClient task
	= (try task) <! isJust
15
where
16 17 18 19
	try :: (Task (Maybe a)) -> Task (Maybe a) | iTask a
	try task
		= catchAll task (\_ -> return Nothing)
		>>- \result -> if (isNothing result) tryAgain (return result)
20

21 22 23
	tryAgain :: Task (Maybe a) | iTask a
	tryAgain
		= waitForTimer` timeout @! Nothing
24
	where
25
		timeout = 60
26

27
waitForTimer` :: !Int -> Task DateTime
28 29
waitForTimer` interval
	= get currentDateTime
30 31
	>>- \now -> endTime interval now
	>>- \later -> waitForDateTime` later
32
where
33
	endTime interval now = localDateTimeToTimestamp now >>- \(Timestamp ts) -> return (timestampToGmDateTime (Timestamp (ts + interval)))
34 35 36

waitForDateTime` :: !DateTime -> Task DateTime
waitForDateTime` datetime
37 38 39
	= Title "Connection interrupted" @>>
	  Hint ("The connection with the other controller is interrupted, next attempt: " +++ toString datetime) @>>
		viewSharedInformation [] currentUTCDateTime >>* [OnValue (ifValue (\now -> datetime < now) return)]
40 41 42
	>>* [ OnValue (ifValue (\now -> datetime < now) return)
	    , OnAction (Action "Reconnect") (always (return datetime))
	    ]