Commit 374346f0 authored by Haye Böhm's avatar Haye Böhm

Support asynchronous reading, writing and modifying shares

- Add new share types denoting a share is a remote (SDSRemote)
- Change read/write/modify signatures to be able to return that a
respective operation is queued.
- Change get/set/upd to use and wait for asyn operations
- Change part of the task rewriting to account for waiting for async
operations

An operation on a SDS can now yield either:
    Queued connectionId: An async operation is queued, the task will be
    notified when it is done. The connectionId should be used to
    retrieve the result from the connection states in the world.

    This is only returned when:
	- The operation is done on a RemoteSDS
	- The operation is done in the context of a task

    Result a: Synchronous operation was done, return the result directly
parent cd54966f
AsyncShareTest
instances/
module AsyncShareTest
import iTasks
import iTasks.Internal.Distributed.Instance
import Data.Func
import Data.Tuple
import Data.Maybe
import Data.Functor
import Data.Either
import StdMisc
import Internet.HTTP
derive class iTask TestRecord, OpenWeatherResponse
:: TestRecord = {number :: Int, numbers :: [Int], text :: String, texts :: [String]}
testShare = sharedStore "sharedStoreNamebla" {number = 37, numbers = [1, 2, 3], text = "Test", texts = ["een", "twee", "drie", "vier"]}
remoteTestShare = remoteShare testShare {domain = "TEST", port = 8080}
:: OpenWeatherRequest =
{ apiKey :: String
, type :: OpenWeatherRequestType
}
:: OpenWeatherRequestType = ByCityName String | ByCoordinates Real Real
:: OpenWeatherResponse =
{ id :: Int
, main :: String
, description :: String
, icon :: String }
// api.openweathermap.org/data/2.5/weather?q=London,uk
weatherOptions :: OpenWeatherRequest -> WebServiceShareOptions OpenWeatherResponse
weatherOptions owr = HttpShareOptions (toRequest owr) fromResp
where
toRequest {OpenWeatherRequest|apiKey, type}
# r = newHTTPRequest
= {HTTPRequest|r & server_name = "api.openweathermap.org", server_port = 80, req_path = "/data/2.5/weather", req_query = query type +++ "&APPID=" +++ apiKey}
fromResp response = case jsonQuery "weather/0" (fromString response.rsp_data) of
Nothing = Left "Could not select JSON"
(Just selected) = case fromJSON selected of
Nothing = Left "Could not transform JSON"
(Just v) = Right v
query (ByCityName name) = "?q=" +++ name
query (ByCoordinates lat long) = "?lat=" +++ toString lat +++ "&lon=" +++ toString long
weatherService = remoteService (weatherOptions {apiKey = "1160ac287072c67ae44708dee89f9a8b" , type = ByCityName "Nijmegen"})
Start :: *World -> *World
Start world
= startEngineWithOptions opts maintask world
where
opts [] = \op->(Just {op&distributed=True}, ["Started server on port: " +++ toString op.serverPort])
opts ["-p",p:as] = appFst (fmap (\o->{o & serverPort=toInt p})) o opts as
opts [a:as] = opts as
maintask = viewInformation "Choose your role" [] ()
>>* [OnAction (Action "Domain server") (always domainServer)
,OnAction (Action "Client") (always client)
,OnAction (Action "Weather") (always weather)
]
where
domainServer = updateSharedInformation "This share is shared in the domain" [] testShare
client = updateSharedInformation "This share is stored somewhere else" [] remoteTestShare
weather = viewSharedInformation "This is the current weather in Nijmegen" [] weatherService >>| client
SHELL = /bin/zsh
INSTANCES = 5
build:
cpm make;
rm -rf instances;
for n in {0..${INSTANCES}} ; do \
mkdir -p instances/$$n;\
cp AsyncShareTest instances/$$n/;\
cp -r AsyncShareTest-www instances/$$n/;\
done
clean:
rm -rf instances;
rm -rf Clean\ System\ Files;
rm AsyncShareTest;
rm -rf AsyncShareTest-www;
\ No newline at end of file
......@@ -67,10 +67,13 @@ where
= enterInformation question []
>>= return
myShared :: Shared String
myShared = sharedStore "myShared" ""
:: TestRecord = {number :: Int, numbers :: [Int], text :: String, texts :: [String]}
sharedExample :: Task String
derive class iTask TestRecord
myShared = sharedStore "myShared" {number = 18, numbers = [1,2,3], text = "Hello!", texts = ["lol", "werkt dit?"]}
sharedExample :: Task TestRecord
sharedExample
= enterDomain
>>= \domain -> usersOf domain
......@@ -78,7 +81,7 @@ sharedExample
>>= \user -> ((user @. domain) @: updateMyShared)
||- viewSharedInformation "myShare" [] myShared
updateMyShared :: Task String
updateMyShared :: Task TestRecord
updateMyShared
= enterInformation "New value for shared" []
>>= \val -> set val myShared
......
......@@ -181,7 +181,7 @@ where
published = publishAll publishable
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
publish url task = {url = url, task = WebTaskWrapper task}
publish url task = {PublishedTask|url = url, task = WebTaskWrapper task}
instance Publishable (Task a) | iTask a
where
......
......@@ -3,7 +3,7 @@ definition module iTasks.Extensions.Device.Features
from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from iTasks.SDS.Definition import :: SDS, :: RWShared
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from Data.Maybe import :: Maybe
......
......@@ -6,7 +6,7 @@ from iTasks.WF.Tasks.SDS import get, set
from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor, :: TaskId
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Data.Maybe import :: Maybe
from iTasks.WF.Tasks.Interaction import :: UpdateOption, updateInformation
from iTasks.UI.Prompt import class toPrompt, instance toPrompt String
......
......@@ -4,7 +4,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Data.Maybe import :: Maybe
from iTasks.Extensions.User import class toUserConstraint(..), :: UserConstraint
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from iTasks.Internal.Distributed.Domain import :: Domain
from iTasks.Extensions.User import :: User, :: Username, ::Password
......
......@@ -4,7 +4,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Data.Maybe import :: Maybe
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from iTasks.WF.Tasks.Interaction import :: ViewOption(..)
......
......@@ -4,7 +4,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Data.Maybe import :: Maybe
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
get :: !(ReadWriteShared a w) -> Task a | iTask a & iTask w
......
......@@ -4,7 +4,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Data.Maybe import :: Maybe
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
import qualified iTasks.Extensions.Distributed._SDS as R
......
......@@ -4,7 +4,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Data.Maybe import :: Maybe
from iTasks.Extensions.User import class toUserConstraint(..), :: UserConstraint
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from iTasks.Internal.Distributed.Domain import :: Domain
......
......@@ -7,7 +7,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor, :: TaskAttributes
from Data.Maybe import :: Maybe, maybe
from iTasks.Extensions.User import class toUserConstraint(..), :: UserConstraint, instance toString UserConstraint, instance toUserConstraint User, instance toString UserConstraint
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
import qualified iTasks.Extensions.User as U
import Data.Map
......
......@@ -7,8 +7,8 @@ from iTasks.UI.Definition import :: UI, :: UIAttributeChange, :: UIType
from iTasks.WF.Combinators.Common import @!, @?, whileUnchanged, ||-
from iTasks.UI.Definition import :: UIType(UIEmpty)
from iTasks.Internal.IWorld import :: IWorld
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared
from iTasks.Internal.SDS as SDS import qualified read, readRegister, write
from iTasks.SDS.Definition import :: SDS, :: RWShared, :: ReadWriteShared
import iTasks.Internal.SDS
from iTasks.SDS.Sources.System import currentTaskInstanceNo
from iTasks.UI.Definition import :: UIChange(..), :: UIChildChange(..), ui
from iTasks.Internal.Store import memoryStore, :: StoreName, :: StoreNamespace
......@@ -18,8 +18,8 @@ from iTasks.UI.Editor import :: Editor
from iTasks.UI.Editor.Generic import generic gEditor
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.Internal.Generic.Defaults import generic gDefault
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Generics.GenEq import generic gEq
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.GenEq import generic gEq
from iTasks.WF.Combinators.Overloaded import class TMonad(..), instance TMonad Task, instance Functor Task, instance TApplicative Task, class TApplicative
from Data.Functor import class Functor
......@@ -47,9 +47,9 @@ proxyTask :: (RWShared () (TaskValue a) (TaskValue a)) (*IWorld -> *IWorld) -> (
proxyTask value_share onDestroy = Task eval
where
eval event evalOpts tree=:(TCInit taskId ts) iworld
# (val,iworld) = 'SDS'.readRegister taskId value_share iworld
# (val,iworld) = readRegister taskId value_share iworld
= case val of
Ok val = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} (rep event) tree, iworld)
Ok (Result val) = (ValueResult val {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} (rep event) tree, iworld)
Error e = (ExceptionResult e,iworld)
eval event repAs (TCDestroy _) iworld
# iworld = onDestroy iworld
......@@ -73,7 +73,7 @@ customEval value_share (Task eval) = Task eval`
(DestroyedResult, iworld) -> (DestroyedResult, iworld)
storeValue (ValueResult task_value info rep tree, iworld)
# (res, iworld) = 'SDS'.write task_value value_share iworld
# (res, iworld) = write task_value value_share EmptyContext iworld
= case res of
Ok _ = (ValueResult task_value info rep tree, iworld)
Error _ = (ValueResult task_value info rep tree, iworld)
......
......@@ -12,8 +12,18 @@ deserializeFromBase64 input symbols
(Just data) # (x, y, z) = deserializeFromString data
= fst (copy_from_string_with_names x y z symbols)
// We evaluate the argument to normal form due to some unknown laziness which creates dependency on the whole iTasks library.
eval :: !a -> Bool
eval a = code {
.d 1 0
jsr _eval_to_nf
.o 0 0
pushB TRUE
}
serializeToBase64 :: a -> String
serializeToBase64 item = base64Encode (toString (toJSON (serializeToString (copy_to_string_with_names (item)))))
serializeToBase64 item
| eval item = base64Encode (toString (toJSON (serializeToString (copy_to_string_with_names item))))
json :: String -> Maybe [String]
json x = fromJSON (fromString x)
......
......@@ -9,9 +9,9 @@ from iTasks.UI.Editor import :: Editor
from iTasks.UI.Editor.Generic import generic gEditor
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.Internal.Generic.Defaults import generic gDefault
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Map import :: Map
from Data.Generics.GenEq import generic gEq
from Data.GenEq import generic gEq
from Data.Maybe import :: Maybe
:: Remote_Task = E. a: Remote_Task (Task a) TaskAttributes Int & iTask a | Remote_Taks_NotUsed
......
......@@ -9,7 +9,7 @@ from iTasks.UI.Editor import :: Editor
from iTasks.UI.Editor.Generic import generic gEditor
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.Internal.Generic.Defaults import generic gDefault
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Map import :: Map
from Data.Generics.GenEq import generic gEq
from Data.GenEq import generic gEq
from Data.Maybe import :: Maybe
......@@ -14,7 +14,7 @@ from iTasks.WF.Definition import class iTask
from iTasks.Internal.Task import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor, :: TaskAttributes
from Data.Maybe import :: Maybe
from iTasks.Extensions.User import class toUserConstraint(..), :: UserConstraint, instance toString UserConstraint, instance toUserConstraint User, instance toString UserConstraint, instance toString User
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
import qualified iTasks.Extensions.User as U
from iTasks.WF.Combinators.Common import -&&-, >>-
......@@ -42,7 +42,6 @@ import iTasks.Extensions.Distributed.Task
import iTasks.Extensions.Distributed.SDS
from iTasks.Extensions.Distributed.Authentication import domainAuthServer, usersOf, remoteAuthenticateUser, startAuthEngine, enterDomain, currentDistributedUser, currentDomain
import Text
import Graphics.Scalable
import iTasks.Extensions.Distributed.InteractionTasks
from StdList import ++
import iTasks.WF.Combinators.Overloaded
......@@ -58,7 +57,7 @@ from iTasks.Extensions.Picture.JPEG import :: JPEGPicture(..)
from iTasks.Extensions.Device.Camera import takePicture
from iTasks.Extensions.Device.Location import :: Coordinates(..), getLocation
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode, jsonQuery, :: JSONNode(JSONNull), instance toString JSONNode, instance fromString JSONNode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode, jsonQuery, :: JSONNode(JSONNull), instance toString JSONNode, instance fromString JSONNode
from StdList import isEmpty
from StdOverloaded import class toReal
......
definition module iTasks.Extensions.Picture.JPEG
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from Data.Maybe import :: Maybe
from Data.Map import :: Map
......
......@@ -5,7 +5,7 @@ import StdString
from iTasks.Internal.IWorld import :: IWorld
from Data.Maybe import :: Maybe(..)
from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor, :: TaskId
from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Internal.Generic.Visualization import :: TextFormat(..)
from Data.Maybe import :: Maybe
from Data.Map import :: Map, newMap
......
definition module iTasks.Internal.AsyncSDS
import iTasks.SDS.Definition
from iTasks.WF.Definition import :: TaskId
from iTasks.Internal.IWorld import :: IOState, :: IOStates
from iTasks.Internal.SDS import :: SDSIdentity, :: SDSNotifyRequest
:: SDSRequest r w sds = SDSReadRequest (sds () r w) (Maybe (TaskId, Int)) & TC r & RWShared sds
| SDSWriteRequest (sds () r w) w & TC r & TC w & RWShared sds
| SDSModifyRequest (sds () r w) (r -> w) & TC r & TC w & RWShared sds
| SDSRefreshRequest TaskId SDSIdentity
queueRead :: !(sds p r w) !TaskId Bool !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r & RWShared sds
queueRemoteRefresh :: !SDSIdentity [SDSNotifyRequest] !*IWorld -> *IWorld
queueWrite :: !w !(sds p r w) !TaskId !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r & TC w & RWShared sds
queueModify :: !(r -> w) !(sds p r w) !TaskId !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r & TC w & RWShared sds
getAsyncReadValue :: !(sds p r w) !TaskId !Int IOStates -> Either String (Maybe r) | TC r & RWShared sds
getAsyncWriteValue :: !(sds p r w) !TaskId !Int IOStates -> Either String (Maybe w) | TC w & RWShared sds
\ No newline at end of file
implementation module iTasks.Internal.AsyncSDS
import Data.Maybe, Data.Either, Data.List
import Text, Text.GenJSON
import StdMisc
import Internet.HTTP
import iTasks.Engine
import iTasks.Internal.Distributed.Symbols
import iTasks.Internal.IWorld
import iTasks.Internal.SDS
import iTasks.Internal.Task
import iTasks.SDS.Definition
import iTasks.WF.Tasks.IO
import iTasks.Extensions.Distributed._Formatter
from iTasks.Internal.TaskServer import addConnection
from iTasks.SDS.Sources.Core import unitShare
import qualified Data.Map as DM
derive JSONEncode SDSNotifyRequest, RemoteNotifyOptions
queueSDSRequest :: !(SDSRequest r w) !String !Int !TaskId !{#Symbol} !*IWorld -> (!MaybeError TaskException ConnectionId, !*IWorld) | TC r
queueSDSRequest req host port taskId symbols env = case addConnection taskId host port connectionTask env of
(Error e, env) = (Error e, env)
(Ok (id, _), env) = (Ok id, env)
where
connectionTask = wrapConnectionTask (handlers req) unitShare
handlers :: (SDSRequest r w) -> ConnectionHandlers (Either [String] r) () ()
handlers _ = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
headers = 'DM'.fromList [("Connection", "Close")]
request = toString {newHTTPRequest & server_name = host, server_port = port, req_path = "/sds/", req_version = "HTTP/1.1", req_data = serializeToBase64 req, req_headers = headers}
onConnect _ _ = (Ok (Left []), Nothing, [request], False)
onData data (Left acc) _ = (Ok (Left (acc ++ [data])), Nothing, [], False)
onShareChange acc _ = (Ok acc, Nothing, [], False)
onDisconnect (Left acc) _
# rawResponse = concat acc
= case parseResponse rawResponse of
Nothing = (Error ("Unable to parse HTTP response, got: " +++ rawResponse), Nothing)
(Just parsed) = (Ok (Right (deserializeFromBase64 parsed.rsp_data symbols)), Nothing)
// TODO: What about TCP services?
queueServiceRequest :: !(RWShared () r w) !TaskId !*IWorld -> (!MaybeError TaskException ConnectionId, !*IWorld) | TC r
queueServiceRequest (SDSRemoteService (HttpShareOptions req parse)) taskId env = case addConnection taskId req.server_name req.server_port connectionTask env of
(Error e, env) = (Error e, env)
(Ok (id, _), env) = (Ok id, env)
where
connectionTask = wrapConnectionTask handlers unitShare
handlers = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
onConnect _ _ = (Ok (Left []), Nothing, [toString {HTTPRequest|req & req_headers = 'DM'.put "Connection" "Close" req.HTTPRequest.req_headers}], False)
onData data (Left acc) _ = (Ok (Left (acc ++ [data])), Nothing, [], False)
onShareChange acc _ = (Ok acc, Nothing, [], False)
onDisconnect (Left acc) _
# rawResponse = concat acc
= case parseResponse rawResponse of
Nothing = (Error ("Unable to parse HTTP response, got: " +++ rawResponse), Nothing)
(Just parsed) = case parse parsed of
(Left error) = (Error error, Nothing)
(Right a) = (Ok (Right a), Nothing)
queueRead :: !(RWShared () r w) !TaskId Bool !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r
queueRead rsds=:(SDSRemoteSource share=:{SDSShareOptions|domain, port} sds) taskId register env
# (symbols, env) = case read symbolsShare EmptyContext env of
(Ok (Result r), env) = (readSymbols r, env)
_ = abort "Reading symbols failed!"
# (notifyOptions, env) = buildOptions register env
# request = SDSReadRequest sds notifyOptions
= queueSDSRequest request domain port taskId symbols env
where
buildOptions False env = (Nothing, env)
buildOptions True env=:{options} = (Just (taskId, options.serverPort), env)
queueRead rservice=:(SDSRemoteService req) taskId _ env = queueServiceRequest rservice taskId env
queueRemoteRefresh :: !SDSIdentity [SDSNotifyRequest] !*IWorld -> *IWorld
queueRemoteRefresh _ [] iworld = iworld
queueRemoteRefresh sdsId [notifyRequest : reqs] iworld
# (symbols, iworld) = case read symbolsShare EmptyContext iworld of
(Ok (Result r), iworld) = (readSymbols r, iworld)
# request = reqq notifyRequest.reqTaskId sdsId
# (host, port) = case notifyRequest.remoteOptions of
(Just (RemoteNotifyOptions host port)) = (host, port)
= case queueSDSRequest request host port notifyRequest.reqTaskId symbols iworld of
(_, iworld) = queueRemoteRefresh sdsId reqs iworld
where
reqq :: TaskId SDSIdentity -> SDSRequest () ()
reqq taskId sdsId = SDSRefreshRequest taskId sdsId
queueWrite :: !w !(RWShared () r w) !TaskId !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r & TC w
queueWrite w rsds=:(SDSRemoteSource share=:{SDSShareOptions|domain, port} sds) taskId env
# (symbols, env) = case read symbolsShare EmptyContext env of
(Ok (Result r), env) = (readSymbols r, env)
# request = SDSWriteRequest sds w
= queueSDSRequest request domain port taskId symbols env
queueModify :: !(r -> w) !(RWShared () r w) !TaskId !*IWorld -> (!MaybeError TaskException Int, !*IWorld) | TC r & TC w
queueModify f rsds=:(SDSRemoteSource share=:{SDSShareOptions|domain, port} sds) taskId env
# (symbols, env) = case read symbolsShare EmptyContext env of
(Ok (Result r), env) = (readSymbols r, env)
# request = SDSModifyRequest sds f
= queueSDSRequest request domain port taskId symbols env
getAsyncReadValue :: !(SDS () r w) !TaskId !Int IOStates -> Either String (Maybe r) | TC r
getAsyncReadValue _ taskId connectionId ioStates = case 'DM'.get taskId ioStates of
Nothing = Left "No iostate for this task"
(Just ioState) = case ioState of
(IOException exc) = Left exc
(IOActive connectionMap) = getValue connectionId connectionMap
(IODestroyed connectionMap) = getValue connectionId connectionMap
where
getValue connectionId connectionMap = case 'DM'.get connectionId connectionMap of
(Just (value :: Either [String] r^, _)) = case value of
(Left _) = Right Nothing
(Right val) = (Right (Just val))
(Just _)= Left "Dynamic not of the correct type"
getAsyncWriteValue :: !(SDS () r w) !TaskId !Int IOStates -> Either String (Maybe w) | TC w
getAsyncWriteValue _ taskId connectionId ioStates = case 'DM'.get taskId ioStates of
Nothing = Left "No iostate for this task"
(Just ioState) = case ioState of
(IOException exc) = Left exc
(IOActive connectionMap) = getValue connectionId connectionMap
(IODestroyed connectionMap) = getValue connectionId connectionMap
where
getValue connectionId connectionMap = case 'DM'.get connectionId connectionMap of
(Just (value :: Either [String] w^, _)) = case value of
(Left _) = Right Nothing
(Right val) = (Right (Just val))
(Just _)= Left "Dynamic not of the correct type"
\ No newline at end of file
......@@ -101,12 +101,12 @@ newWorld = undef
getUIUpdates :: !*IWorld -> (!Maybe [(InstanceNo, [String])], *IWorld)
getUIUpdates iworld
= case 'SDS'.read taskOutput iworld of
(Ok output,iworld)
= case 'SDS'.read taskOutput EmptyContext iworld of
(Ok (Result output),iworld)
= case 'Data.Map'.toList output of
[] = (Nothing,iworld)
output
# (_,iworld) = 'SDS'.write 'Data.Map'.newMap taskOutput iworld