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

Add withServerShare

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