Commit d4f259ba authored by Haye Böhm's avatar Haye Böhm

Fix asynchronous web services

parent ba750593
Pipeline #15109 passed with stage
in 10 minutes and 45 seconds
......@@ -25,7 +25,7 @@ where
serviceTask = get weatherService >>= viewInformation "Current weather" []
// api.openweathermap.org/data/2.5/weather?q=London,uk
weatherOptions :: OpenWeatherRequest -> WebServiceShareOptions OpenWeatherResponse
weatherOptions :: OpenWeatherRequest -> WebServiceShareOptions (Either String OpenWeatherResponse)
weatherOptions owr = HttpShareOptions (toRequest owr) fromResp
where
toRequest {OpenWeatherRequest|apiKey, type}
......@@ -33,12 +33,13 @@ where
= {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"
Nothing = Right (Left ("Could not select JSON"))
(Just selected) = case fromJSON selected of
Nothing = Left "Could not transform JSON"
(Just v) = Right v
Nothing = Right (Left ("Could not transform JSON"))
(Just v) = Right (Right v)
query (ByCityName name) = "?q=" +++ name
query (ByCoordinates lat long) = "?lat=" +++ toString lat +++ "&lon=" +++ toString long
weatherService :: SDSRemoteService () (Either String OpenWeatherResponse) ()
weatherService = remoteService (weatherOptions {apiKey = "1160ac287072c67ae44708dee89f9a8b" , type = ByCityName "Nijmegen"})
\ No newline at end of file
......@@ -15,7 +15,7 @@ from Data.Queue import :: Queue(..)
from Data.Set import :: Set, newSet
import qualified Data.Map as DM
from System.OS import IF_POSIX_OR_WINDOWS, OS_NEWLINE
from System.OS import IF_POSIX_OR_WINDOWS, OS_NEWLINE, IF_WINDOWS
import Data.List, Data.Error, Data.Func, Data.Tuple, Math.Random, Text
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
......@@ -68,7 +68,7 @@ where
hasWebTasks = not (webTasks =: [])
initSymbolsShare False _ iworld = (Ok (), iworld)
initSymbolsShare True appName iworld = case storeSymbols appName iworld of
initSymbolsShare True appName iworld = case storeSymbols (IF_WINDOWS (appName +++ ".exe") appName) iworld of
(Error (e, s), iworld) = (Error s, iworld)
(Ok noSymbols, iworld) = (Ok (), {iworld & world = show ["Read number of symbols: " +++ toString noSymbols] iworld.world})
......
......@@ -75,6 +75,8 @@ queueModify :: !(r -> MaybeError TaskException w) !(SDSRemoteSource p r w) p !Ta
*/
getAsyncReadValue :: !(sds p r w) !TaskId !ConnectionId IOStates -> MaybeError TaskException (Maybe r) | TC r
getAsyncServiceValue :: !(SDSRemoteService p r w) !TaskId !ConnectionId IOStates -> MaybeError TaskException (Maybe r) | TC r & TC w & TC p
/**
* Queries IOStates to see whether a write operation has yielded a result.
* @param the share, required for typing reasons.
......
......@@ -69,13 +69,13 @@ where
= (Ok $ Right $ deserializeFromBase64 textResponse symbols, Nothing)
queueServiceRequest :: !(SDSRemoteService p r w) p !TaskId !*IWorld -> (!MaybeError TaskException ConnectionId, !*IWorld) | gText{|*|} p & TC p & TC r
queueServiceRequest (SDSRemoteService (HttpShareOptions req parse)) p taskId env = case addConnection taskId req.server_name req.server_port connectionTask env of
queueServiceRequest service=:(SDSRemoteService (HttpShareOptions req parse)) p 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
connectionTask = wrapConnectionTask (handlers service) unitShare
handlers = {ConnectionHandlers| onConnect = onConnect,
handlers req = {ConnectionHandlers| onConnect = onConnect,
onData = onData,
onShareChange = onShareChange,
onDisconnect = onDisconnect}
......@@ -135,6 +135,22 @@ queueModify f rsds=:(SDSRemoteSource sds share=:{SDSShareOptions|domain, port})
# request = SDSModifyRequest sds p f
= queueModifyRequest request domain port taskId symbols env
getAsyncServiceValue :: !(SDSRemoteService p r w) !TaskId !ConnectionId IOStates -> MaybeError TaskException (Maybe r) | TC r & TC w & TC p
getAsyncServiceValue service taskId connectionId ioStates
= case 'DM'.get taskId ioStates of
Nothing = Error (exception "No iostate for this task")
(Just ioState) = case ioState of
(IOException exc) = Error (exception 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 _) = Ok Nothing
(Right val) = Ok (Just val)
(Just (dyn, _)) = Error (exception ("Dynamic not of the correct service type, got: " +++ toString (typeCodeOfDynamic dyn) +++ ", required: " +++ toString (typeCodeOfDynamic (dynamic service))))
Nothing = Ok Nothing
getAsyncReadValue :: !(sds p r w) !TaskId !ConnectionId IOStates -> MaybeError TaskException (Maybe r) | TC r
getAsyncReadValue _ taskId connectionId ioStates
= case 'DM'.get taskId ioStates of
......@@ -149,7 +165,7 @@ where
(Left _) = Ok Nothing
(Right (Ok val)) = Ok (Just val)
(Right (Error e)) = Error e
(Just (dyn, _)) = Error (exception ("Dynamic not of the correct write type, got" +++ toString (typeCodeOfDynamic dyn)))
(Just (dyn, _)) = Error (exception ("Dynamic not of the correct read type, got" +++ toString (typeCodeOfDynamic dyn)))
Nothing = Ok Nothing
getAsyncWriteValue :: !(sds p r w) !TaskId !ConnectionId IOStates -> MaybeError TaskException (Maybe w) | TC w
......
......@@ -749,7 +749,7 @@ instance Identifiable SDSRemoteService where
instance Readable SDSRemoteService where
readSDS _ _ EmptyContext _ _ iworld = (Error (exception "Cannot read remote service without task id"), iworld)
readSDS sds=:(SDSRemoteServiceQueued connectionId rsds opts) p (TaskContext taskId) _ _ iworld=:{ioStates} = case getAsyncReadValue sds taskId connectionId ioStates of
readSDS sds=:(SDSRemoteServiceQueued connectionId rsds opts) p (TaskContext taskId) _ _ iworld=:{ioStates} = case getAsyncServiceValue sds taskId connectionId ioStates of
Error (_, error)
# errorString = "Remote service queued error<br>Service " +++ toString opts +++ ": " +++ error
= (Error (exception errorString), 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