Commit 71ec7f2c authored by Guillaume Melquiond's avatar Guillaume Melquiond

Use the Fetch API instead of XmlHttpRequest.

parent 069268fe
......@@ -48,6 +48,49 @@ module Url = struct
end
module Promise = struct
(* opaque, as it would not be a regular tree otherwise, because of _then *)
type 'a promise
(* the various signatures for _then are needed,
because promises of promises do not really exist *)
class type ['a] inner_promise =
object
method _then : 'b. ('a -> 'b promise) callback -> 'b promise meth
method _then_value : 'b. ('a -> 'b t) callback -> 'b t promise meth
method _then_unit : ('a -> unit) callback -> unit promise meth
method _then_int : ('a -> int) callback -> int promise meth
method _then_float : ('a -> float) callback -> float promise meth
method catch : (Unsafe.any -> 'a) callback -> 'a promise meth
end
external unwrap : 'a promise -> 'a inner_promise t = "%identity"
external wrap : 'a inner_promise t -> 'a promise = "%identity"
let bind (x : 'a promise) (f : 'a -> 'b promise) : 'b promise =
(unwrap x) ## _then (wrap_callback (fun v -> f v))
let bind_unit (x : 'a promise) (f : 'a -> unit) : unit promise =
(unwrap x) ## _then_unit (wrap_callback (fun v -> f v))
let catch (x : unit promise) (f : Unsafe.any -> unit) : unit =
ignore ((unwrap x) ## catch (wrap_callback f))
end
module Fetch = struct
class type response =
object
method ok : bool prop
method text : js_string t Promise.promise meth
end
let fetch : js_string t -> response t Promise.promise = get_global "fetch"
end
module Ace () = struct
type marker
......
......@@ -26,43 +26,6 @@ let (!!) = Js.string
let int_of_js_string = Js.parseInt
let js_string_of_int n = (Js.number_of_float (float_of_int n)) ## toString
module XHR =
struct
include XmlHttpRequest
let update_file ?(date=0.) cb url =
let xhr = create () in
xhr ##. onreadystatechange :=
Js.wrap_callback
(fun () ->
if xhr ##. readyState == DONE then
if xhr ##. status = 200 then
let date_str = Js.Opt.get (xhr ## getResponseHeader !!"Last-Modified")
(fun () -> !!"01/01/2100") (* far into the future *)
in
let document_date = Js.date ## parse (date_str) in
if document_date < date then
cb `UpToDate
else
let () = xhr ##. onreadystatechange :=
Js.wrap_callback
(fun () ->
if xhr ##. readyState == DONE then
if xhr ##. status = 200 then
cb (`New xhr ##. responseText)
else
cb `NotFound)
in
let () = xhr ## _open !!"GET" url Js._true in
xhr ## send (Js.null)
else
cb `NotFound
);
xhr ## _open !!"HEAD" url Js._true;
xhr ## send (Js.null)
end
module AsHtml =
struct
include Dom_html.CoerceTo
......@@ -470,10 +433,12 @@ module ExampleList =
set_loading_label false
in
set_loading_label true;
XHR.update_file (function
| `New mlw -> Js.Opt.iter mlw upd
| _ -> set_loading_label false
) url
Promise.catch
(Promise.bind_unit
(Promise.bind (Fetch.fetch url)
(fun r -> r ## text))
(fun s -> upd s))
(fun _ -> set_loading_label false)
end
let handle _ =
......@@ -1139,10 +1104,12 @@ let () =
done;
ExampleList.set_loading_label false in
ExampleList.set_loading_label true;
XHR.update_file (function
| `New content -> Js.Opt.iter content upd
| _ -> ExampleList.set_loading_label false
) !!"examples/index.txt"
Promise.catch
(Promise.bind_unit
(Promise.bind (Fetch.fetch !!"examples/index.txt")
(fun r -> r ## text))
(fun s -> upd s))
(fun _ -> ExampleList.set_loading_label false)
let () =
let url = new%js Url._URL (Dom_html.window ##. location ##. href) in
......
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