Skip to content

Instantly share code, notes, and snippets.

@dbuenzli

dbuenzli/work_queue.ml

Created October 30, 2022 13:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dbuenzli/0cbad35b9d0a828b17d15aa026e230f2 to your computer and use it in GitHub Desktop.
Save dbuenzli/0cbad35b9d0a828b17d15aa026e230f2 to your computer and use it in GitHub Desktop.
Download ZIP
Webworker work queue
Raw
work_queue.ml
(*---------------------------------------------------------------------------
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.
---------------------------------------------------------------------------*)
Raw
work_queue.mli
(*---------------------------------------------------------------------------
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