[websockets] send job progress data directly in WS message

This avoids polling
parent 1b27aad9
...@@ -82,7 +82,8 @@ instance JSON.WriteForeign WSRequest where ...@@ -82,7 +82,8 @@ instance JSON.WriteForeign WSRequest where
data Message = data Message =
-- TODO -- TODO
-- MJobProgress GT.AsyncProgress -- MJobProgress GT.AsyncProgress
MJobProgress GT.AsyncTaskLog -- MJobProgress GT.AsyncTaskLog
MJobProgress GT.AsyncProgress
| MEmpty | MEmpty
derive instance Generic Message _ derive instance Generic Message _
instance JSON.ReadForeign Message where instance JSON.ReadForeign Message where
...@@ -92,8 +93,9 @@ instance JSON.ReadForeign Message where ...@@ -92,8 +93,9 @@ instance JSON.ReadForeign Message where
"MJobProgress" -> do "MJobProgress" -> do
-- TODO -- TODO
-- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncProgress } -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncProgress }
{ job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncTaskLog } -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncTaskLog }
pure $ MJobProgress job_progress { job_status } <- JSON.readImpl f :: F.F { job_status :: GT.AsyncProgress }
pure $ MJobProgress job_status
"MEmpty" -> do "MEmpty" -> do
pure MEmpty pure MEmpty
s -> do F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Message type: " <> s s -> do F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Message type: " <> s
......
...@@ -119,10 +119,7 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where ...@@ -119,10 +119,7 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
let cb msg = do let cb msg = do
-- here.log2 "callback! for job update" taskId -- here.log2 "callback! for job update" taskId
case msg of case msg of
NotificationsT.MJobProgress _jobProgress -> do NotificationsT.MJobProgress jobProgress -> launchAff_ $ onProgress jobProgress
-- TODO With jobProgress we could avoid polling here
-- onJobProgress jobProgress
fetchJobProgress
NotificationsT.MEmpty -> fetchJobProgress NotificationsT.MEmpty -> fetchJobProgress
resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
......
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