Created
October 30, 2022 13:08
-
-
Save dbuenzli/0cbad35b9d0a828b17d15aa026e230f2 to your computer and use it in GitHub Desktop.
Webworker work queue
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(*--------------------------------------------------------------------------- | |
Copyright (c) 2022 The brr programmers. All rights reserved. | |
Distributed under the ISC license, see terms at the end of the file. | |
---------------------------------------------------------------------------*) | |
open Brr | |
open Brr_webworkers | |
open Brr_io | |
module type WORK = sig | |
type 'a t | |
val perform : 'a t -> 'a Fut.t | |
end | |
module type T = sig | |
type 'a work | |
type t | |
val make : unit -> (t, Jv.Error.t) Fut.result | |
val main : unit -> unit | |
val send : t -> 'a work -> 'a Fut.t | |
end | |
module Make (Work : WORK) = struct | |
type 'a work = 'a Work.t | |
type setter = Set : ('a -> unit) -> setter | |
type t = { w : Worker.t; results : setter Queue.t } | |
let recv_result q e = match Queue.pop q.results with | |
| Set set -> set (Message.Ev.data (Ev.as_type e)) | |
let make () = | |
(* The circonvolutions are needed to work over the file:// protocol. *) | |
let open Fut.Result_syntax in | |
let script = Jv.get (Document.to_jv G.document) "currentScript" in | |
let script = Jv.to_jstr (Jv.get script "text") in | |
let blob_init = Blob.init ~type':(Jstr.v "text/javascript") () in | |
let blob = Blob.of_jstr ~init:blob_init script in | |
let* url = Blob.data_uri blob in | |
try | |
let q = { w = Worker.create url; results = Queue.create () } in | |
let target = Worker.as_target q.w in | |
let () = Ev.listen Message.Ev.message (recv_result q) target in | |
Fut.ok q | |
with Jv.Error e -> Fut.error e | |
let send q work = | |
let f, set = Fut.create () in | |
Queue.add (Set set) q.results; | |
let t = Jstr.v "Posting" in | |
Console.time t; Console.(log ["Posting werk!"]); | |
Worker.post q.w work; | |
Console.(time_log t ["Sent!"]); | |
f | |
let recv_work e = | |
let w = (Message.Ev.data (Ev.as_type e) : 'a Work.t) in | |
let t = Jstr.v "worker" in | |
Console.time t; Console.(log ["Receiving werk!"]); | |
Fut.await (Work.perform w) (fun v -> | |
Console.(time_log t ["Werked sending back result!"]); | |
Worker.G.post v; | |
Console.(time_log t ["Sent!"])) | |
let main () = Ev.listen Message.Ev.message recv_work G.target | |
end | |
(*--------------------------------------------------------------------------- | |
Copyright (c) 2022 The brr programmers | |
Permission to use, copy, modify, and/or distribute this software for any | |
purpose with or without fee is hereby granted, provided that the above | |
copyright notice and this permission notice appear in all copies. | |
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES | |
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF | |
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR | |
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES | |
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN | |
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF | |
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. | |
---------------------------------------------------------------------------*) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(*--------------------------------------------------------------------------- | |
Copyright (c) 2022 The brr programmers. All rights reserved. | |
Distributed under the ISC license, see terms at the end of the file. | |
---------------------------------------------------------------------------*) | |
(** WebWorker work queue. *) | |
(** The type for work. *) | |
module type WORK = sig | |
type 'a t | |
(** The type for work returning values of type ['a]. *) | |
val perform : 'a t -> 'a Fut.t | |
(** [perform w] determines to the result of [w]. *) | |
end | |
(** The type for work queue. *) | |
module type T = sig | |
type 'a work | |
(** The type for work returning values of type ['a]. *) | |
type t | |
(** The type for work queues. *) | |
val make : unit -> (t, Jv.Error.t) Fut.result | |
(** [make ()] is the function to invoke to create a work queue. *) | |
val main : unit -> unit | |
(** [main ()] is the main function of the work queue. Typically invoked | |
when {!Brr_webworkers.Worker.ami} is [true]. *) | |
val send : t -> 'a work -> 'a Fut.t | |
(** [send q w] is a future that determines when the work [w] on queue [q] | |
as been performed. *) | |
end | |
(** Make (Work) is a work queue for [Work]. *) | |
module Make (Work : WORK) : T with type 'a work := 'a Work.t | |
(*--------------------------------------------------------------------------- | |
Copyright (c) 2022 The brr programmers | |
Permission to use, copy, modify, and/or distribute this software for any | |
purpose with or without fee is hereby granted, provided that the above | |
copyright notice and this permission notice appear in all copies. | |
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES | |
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF | |
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR | |
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES | |
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN | |
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF | |
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. | |
---------------------------------------------------------------------------*) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment