package async_js
A small library that provide Async support for JavaScript platforms
Install
Dune Dependency
Authors
Maintainers
Sources
v0.17.0.tar.gz
sha256=6c8898b69bd5fc0c36d0bbcf5a1a5a2cb0b5deb88504cdaeb532c50b50ac1703
doc/src/async_js/async_js0.ml.html
Source file async_js0.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
open Core module Time_ns = Core.Time_ns module Clock_ns = Async_kernel.Clock_ns module Scheduler = Async_kernel.Async_kernel_scheduler.Private open Js_of_ocaml let sleep d = Clock_ns.after (Time_ns.Span.of_sec d) let yield () = Scheduler.yield (Scheduler.t ()) let rec extract_js_error (exn : exn) : (string list * Js_error.t) option = match exn with | Exn.Reraised (msg, exn) -> (match extract_js_error exn with | Some (messages, js_error) -> Some (msg :: messages, js_error) | None -> None) | exn -> (match Js_error.of_exn exn with | Some js_error -> Some ([], js_error) | None -> None) ;; let pretty_print_exception name exn = let exn = Async_kernel.Monitor.extract_exn exn in let classification = match exn with | Js_error.Exn err -> `Js err | exn -> (match extract_js_error exn with | None -> `Exn exn | Some err -> `Js_and_exn (exn, err)) in match classification with | `Js err -> Firebug.console##error_2 (Js.string name) err | `Exn exn -> Firebug.console##error_2 (Js.string name) (Js.string (Exn.to_string exn)) | `Js_and_exn (exn, (messages, err)) -> (match messages with | [] -> Firebug.console##group (Js.string name) | hd :: rest -> Firebug.console##group (Js.string hd); Firebug.console##log (Js.string name); List.iter rest ~f:(fun message -> Firebug.console##error (Js.string message))); (* We first output the stringified ocaml exception *) Firebug.console##groupCollapsed (Js.string "OCaml Exception"); Firebug.console##log (Js.string (Exn.to_string exn)); Firebug.console##groupEnd; Firebug.console##error err; Firebug.console##groupEnd ;; let run = let module State = struct type t = | Idle | Running | Will_run_soon end in let module Next_wakeup = struct type t = | At of Time_ns.t * float | No_wakeup | Soon end in let state = ref State.Idle in let timeouts = Stack.create () in let run_after ~f ~ms = ignore (Dom_html.setTimeout f ms : Dom_html.timeout_id_safe) in let rec loop () = let t = Scheduler.t () in match !state, Scheduler.uncaught_exn t with | _, Some _ | State.Running, None -> () | (State.Idle | State.Will_run_soon), None -> state := State.Running; Scheduler.run_cycle t; let next_wakeup : Next_wakeup.t = if Scheduler.can_run_a_job t then Soon else ( match Scheduler.next_upcoming_event t with | None -> No_wakeup | Some next -> let now = Time_ns.now () in let d = Time_ns.diff next now in let d_ms = Time_ns.Span.to_ms d in if Float.( <= ) d_ms 0. then Soon else At (next, d_ms)) in Option.iter (Scheduler.uncaught_exn_unwrapped t) ~f:(fun (exn, _sexp) -> match Async_kernel.Monitor.extract_exn exn with | Js_error.Exn err -> Js_error.raise_ err | exn -> (match Js_error.of_exn exn with | None -> raise exn | Some err -> (* Hack to get a better backtrace *) pretty_print_exception "Error:" exn; (* And then raise the embedded javascript error that provides a proper backtrace with good sourcemap support. The name of this javascript error is probably not meaningful which is why we first output the serialization of ocaml exception. *) Js_error.raise_ err)); (match next_wakeup with | No_wakeup -> state := Idle | Soon -> state := Will_run_soon; run_after ~f:loop ~ms:0. | At (at, d_ms) -> state := Idle; if Stack.is_empty timeouts || Time_ns.( < ) at (Stack.top_exn timeouts) then ( Stack.push timeouts at; run_after ~f:run_timeout ~ms:d_ms)) and run_timeout () = (* Each call to [run_timeout] removes exactly one element from [timeouts]. This maintains the invariant that [Stack.length timeouts] is exactly the number of outstanding timeouts we have registered. *) ignore (Stack.pop_exn timeouts : Time_ns.t); loop () in fun () -> match !state with | State.Idle -> run_after ~f:loop ~ms:0.; state := State.Will_run_soon | State.Running | State.Will_run_soon -> () ;; let initialized_ref = ref false let initialization = lazy (let t = Scheduler.t () in initialized_ref := true; Scheduler.set_job_queued_hook t (fun _ -> run ()); Scheduler.set_event_added_hook t (fun _ -> run ()); Scheduler.set_thread_safe_external_job_hook t run; Async_kernel.Monitor.Expert.try_with_log_exn := pretty_print_exception "Async_kernel: Monitor.try_with"; Async_kernel.Monitor.detach_and_iter_errors Async_kernel.Monitor.main ~f:(pretty_print_exception "Async_kernel: Unhandled exception"); run ()) ;; let init () = force initialization let initialized () = !initialized_ref let document_loaded = let js_string_compare s = let compare_using_javascript_triple_equal_for_strings = phys_equal in compare_using_javascript_triple_equal_for_strings (Js.string s) in let ready_state_change = "readystatechange" in let complete = "complete" in let readystatechange_ev = Dom.Event.make ready_state_change in let add_event target evt handler = ignore (Dom_html.addEventListener target evt handler Js._false : Dom.event_listener_id) in fun () -> if js_string_compare complete Dom_html.document##.readyState then Async_kernel.Deferred.unit else ( let loaded = Async_kernel.Ivar.create () in let handler evt = if (not (js_string_compare ready_state_change evt##._type)) || js_string_compare complete Dom_html.document##.readyState then Async_kernel.Ivar.fill_if_empty loaded (); Js._true in add_event Dom_html.document Dom_html.Event.domContentLoaded (Dom.handler handler); add_event Dom_html.document readystatechange_ev (Dom.handler handler); add_event Dom_html.window Dom_html.Event.load (Dom.handler handler); Async_kernel.Ivar.read loaded) ;;
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>