Verified Commit d4848ad9 authored by Camil Staps's avatar Camil Staps 🚀

Add withServerShare

parent 29e56416
......@@ -3,10 +3,14 @@ definition module Electron.App
from StdMaybe import :: Maybe
from ABC.Interpreter.JavaScript import :: JSVal, :: JSFun, :: JSWorld
from ABC.Interpreter.JavaScript.Monad import :: JS
from Data.GenEq import generic gEq
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from iTasks.Engine import :: EngineOptions
from iTasks.SDS.Definition import :: SimpleSDSLens, :: SDSLens
from iTasks.WF.Definition import :: Task
from iTasks.Internal.Generic.Visualization import :: TextFormat, generic gText
from iTasks.SDS.Definition import :: SimpleSDSLens, :: SDSLens,
class Identifiable, class Readable, class Registrable
from iTasks.UI.Editor.Generic import :: Editor, generic gEditor
from iTasks.WF.Definition import :: Task, class iTask
:: ElectronProcess
= MainProcess
......@@ -56,11 +60,12 @@ runInElectron :: !ElectronProcess !(JSVal *JSWorld -> *JSWorld) -> Task ()
* The client continuation will only be run once the server task has reached a
* stable value.
*
* @param The component to work with.
* @param The task to perform on the server.
* @param The continuation on the client, executed when the task has reached a
* stable value.
* @result The result value is always `jsNull`; it is not `()` to make it
* easier to integrate this function in a monad chain.
*/
runOnServer :: !JSVal !(Task a) (a -> JS st b) -> JS st JSVal | TC, JSONEncode{|*|} a
runOnServer :: !(Task a) (a -> JS st b) -> JS st JSVal | TC, JSONEncode{|*|} a
withServerShare :: !(sds () r w) (r -> JS st a) -> JS st () | Registrable sds & iTask r & TC w
......@@ -265,19 +265,20 @@ parseBaseOptions cli opts = (cli,opts)
runInElectron :: !ElectronProcess !(JSVal *JSWorld -> *JSWorld) -> Task ()
runInElectron processId f = sendSerializedTCPMsg processId "run" [] (wrapInitFunction f)
runOnServer :: !JSVal !(Task a) (a -> JS st b) -> JS st JSVal | TC, JSONEncode{|*|} a
runOnServer comp task cont =
runOnServer :: !(Task a) (a -> JS st b) -> JS st JSVal | TC, JSONEncode{|*|} a
runOnServer task cont =
gets id >>= \{component=comp} ->
accJS ((.?) (comp .# "request_id")) >>= \jsval ->
let request_id = jsValToInt` 0 jsval in
appJS (comp .# "request_id" .= request_id+1) >>|
gets id >>= \{JSState | state} ->
accJS (jsWrapFun (wrapped_cont request_id state) comp) >>= \cont ->
accJS (jsWrapFun (wrapped_cont comp request_id state) comp) >>= \cont ->
appJS (comp .# "response_handlers" .# "set" .$! (request_id, cont)) >>|
accJS (jsSerializeOnClient (\cont -> task >>- cont)) >>= \task ->
appJS (comp .# "send" .$! ("request", task, jsRecord ["id" :> request_id])) >>|
pure jsNull
where
wrapped_cont request_id state {[0]=result} w
wrapped_cont comp request_id state {[0]=result} w
# (handler,w) = (comp .# "response_handlers" .# "get" .$ request_id) w
# w = jsFreeCleanReference handler w
# w = (comp .# "response_handlers" .# "delete" .$! request_id) w
......@@ -285,6 +286,34 @@ where
# (_,w) = runJS state comp (cont result) w
= w
withServerShare :: !(sds () r w) (r -> JS st a) -> JS st () | Registrable sds & iTask r & TC w
withServerShare sds onChange =
gets id >>= \{component=comp} ->
accJS ((.?) (comp .# "request_id")) >>= \jsval ->
let request_id = jsValToInt` 0 jsval in
appJS (comp .# "request_id" .= request_id+1) >>|
gets id >>= \{JSState | state} ->
accJS (jsWrapFun (wrapped_onChange comp request_id state) comp) >>= \onChange ->
appJS (comp .# "response_handlers" .# "set" .$! (request_id, onChange)) >>|
accJS (jsSerializeOnClient (task sds)) >>= \task ->
appJS (comp .# "send" .$! ("request", task, jsRecord ["id" :> request_id])) $>
()
where
wrapped_onChange comp request_id state {[0]=val} w
# (handler,w) = (comp .# "response_handlers" .# "get" .$ request_id) w
# (val,w) = jsDeserializeGraph {c \\ c <-: jsValToString` "" val} w
# (_,w) = runJS state comp (onChange val) w
= w
task :: !(sds () r w) !(r -> Task ()) -> Task TaskId | Registrable sds & iTask r & TC w
task sds cont =
appendTopLevelTask 'Data.Map'.newMap True
(whileUnchanged sds \v -> cont v @? toUnstable)
where
toUnstable (Value v _) = Value v False
toUnstable v = v
// NB: the result type of this task is hard-coded in withServerShare!
sendSerializedTCPMsg :: !ElectronProcess !String ![(String, JSONNode)] a -> Task ()
sendSerializedTCPMsg processId type extra val =
serialize val >>- \serialized ->
......
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