diff --git a/Makefile.options b/Makefile.options index f598b5c5..2bf713ae 100644 --- a/Makefile.options +++ b/Makefile.options @@ -43,7 +43,7 @@ TEMPLATE_NAME := none.pgocaml SERVER_PACKAGES := calendar SERVER_PPX_PACKAGES := js_of_ocaml-ppx_deriving_json # OCamlfind packages for the client -CLIENT_PACKAGES := calendar js_of_ocaml js_of_ocaml-lwt +CLIENT_PACKAGES := calendar js_of_ocaml js_of_ocaml-eio CLIENT_PPX_PACKAGES := js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json # Debug package (yes/no): Debugging info in compilation diff --git a/src/widgets/ot_buttons.eliom b/src/widgets/ot_buttons.eliom index f7aca625..a93ee786 100644 --- a/src/widgets/ot_buttons.eliom +++ b/src/widgets/ot_buttons.eliom @@ -2,8 +2,7 @@ open Eliom_content.Html open Eliom_content.Html.F - -[%%client open Js_of_ocaml_lwt] +open%client Js_of_ocaml_eio let%shared dropdown ?(a = []) ~menu content = let dropdown = @@ -16,8 +15,7 @@ let%shared dropdown ?(a = []) ~menu content = (* the following does nothing, but still fixes hover anomalies on iPad *) ignore [%client - (Lwt.async @@ fun () -> - Lwt_js_events.clicks (To_dom.of_element ~%dropdown) (fun ev _ -> - Lwt.return_unit) + (Eliom_lib.fork @@ fun () -> + Eio_js_events.clicks (To_dom.of_element ~%dropdown) (fun ev -> ()) : _)]; dropdown diff --git a/src/widgets/ot_calendar.eliom b/src/widgets/ot_calendar.eliom index 4f0efde3..674836a9 100644 --- a/src/widgets/ot_calendar.eliom +++ b/src/widgets/ot_calendar.eliom @@ -33,9 +33,8 @@ type button_labels = [%%client.start] -open Lwt.Syntax open Js_of_ocaml -open Js_of_ocaml_lwt +open Js_of_ocaml_eio let default_intl = { i_days = ["S"; "M"; "T"; "W"; "T"; "F"; "S"] @@ -178,12 +177,20 @@ let zeroth_displayed_day ~intl d = then o else CalendarLib.Date.prev o `Week -let select_action ?(size = 1) selector action = +let select_action + ?(size = 1) + selector + (action : + ?cancel_handler:bool + -> ?use_capture:bool + -> ?passive:bool + -> 'a + -> ('b -> unit) + -> unit) + = let dom_select = Eliom_content.Html.To_dom.of_select selector in - Lwt.async (fun () -> - action dom_select (fun _ _ -> - dom_select##.size := size; - Lwt.return_unit)) + Eliom_lib.fork (fun () -> + action dom_select (fun _ -> dom_select##.size := size)) let rec build_calendar ?prehilight @@ -227,7 +234,7 @@ let rec build_calendar else option ~a:[a_value y] (txt y))) in let () = - let open Lwt_js_events in + let open Eio_js_events in let size = 10 in select_action select_year mousedowns ~size; select_action select_year changes; @@ -356,19 +363,15 @@ let attach_events and y = CalendarLib.Calendar.Date.year d in let action = match action with - | Some action -> - fun _ r -> - update_classes cal zero d; - let* _ = action y m dom in - Lwt.return_unit - | None -> fun _ r -> update_classes cal zero d; Lwt.return_unit + | Some action -> fun _ -> update_classes cal zero d; action y m dom + | None -> fun _ -> update_classes cal zero d in let set_onclick () = if in_period d ~begin_p:period.begin_p ~end_p:period.end_p then - let f () = Lwt_js_events.clicks c action in - Lwt.async f - else Lwt.async (fun () -> Lwt.return_unit) + let f () = Eio_js_events.clicks c action in + Eliom_lib.fork f + else () in if List.exists (( = ) dom) highlight then ( @@ -378,7 +381,7 @@ let attach_events then set_onclick () else () -let attach_events_lwt +let attach_events_async ?action ?click_non_highlighted ~intl @@ -390,11 +393,10 @@ let attach_events_lwt let f () = let m = CalendarLib.Date.(month d |> int_of_month) and y = CalendarLib.Date.year d in - let* highlight = highlight y m in - attach_events ?action ?click_non_highlighted ~intl ~period d cal highlight; - Lwt.return_unit + let highlight = highlight y m in + attach_events ?action ?click_non_highlighted ~intl ~period d cal highlight in - Lwt.async f + Eliom_lib.fork f let make_span_handler selector @@ -444,7 +446,7 @@ let attach_behavior = (match highlight with | Some highlight -> - attach_events_lwt ?click_non_highlighted ?action ~intl ~period d cal + attach_events_async ?click_non_highlighted ?action ~intl ~period d cal highlight | None -> attach_events ?click_non_highlighted ?action ~intl ~period d cal []); let s_y = To_dom.of_select select_year in @@ -503,10 +505,10 @@ let attach_behavior let make : ?init:int * int * int - -> ?highlight:(int -> int -> int list Lwt.t) + -> ?highlight:(int -> int -> int list) -> ?click_non_highlighted:bool -> ?update:(int * int * int) React.E.t - -> ?action:(int -> int -> int -> unit Lwt.t) + -> ?action:(int -> int -> int -> unit) -> ?period: CalendarLib.Date.field CalendarLib.Date.date * CalendarLib.Date.field CalendarLib.Date.date @@ -551,7 +553,7 @@ let make : let f (y, m, d) = CalendarLib.Date.make_year_month y m |> f_d_ym; match action with - | Some action -> Lwt.async (fun () -> action y m d) + | Some action -> Eliom_lib.fork (fun () -> action y m d) | None -> () in Eliom_lib.Dom_reference.retain (To_dom.of_element elt) @@ -561,10 +563,10 @@ let make : let%server make : ?init:int * int * int - -> ?highlight:(int -> int -> int list Lwt.t) Eliom_client_value.t + -> ?highlight:(int -> int -> int list) Eliom_client_value.t -> ?click_non_highlighted:bool -> ?update:(int * int * int) React.E.t Eliom_client_value.t - -> ?action:(int -> int -> int -> unit Lwt.t) Eliom_client_value.t + -> ?action:(int -> int -> int -> unit) Eliom_client_value.t -> ?period: CalendarLib.Date.field CalendarLib.Date.date * CalendarLib.Date.field CalendarLib.Date.date @@ -599,11 +601,7 @@ let%shared make_date_picker ?init ?update ?button_labels ?intl ?period () = CalendarLib.Date.(year d, month d |> int_of_month, day_of_month d) in let v, f = Eliom_shared.React.S.create init in - let action = - [%client - fun y m d -> - ~%f (y, m, d); - Lwt.return_unit] + let action = [%client fun y m d -> ~%f (y, m, d)] and click_non_highlighted = true in let d = make ~init ~click_non_highlighted ?update ?button_labels ?intl ?period diff --git a/src/widgets/ot_calendar.eliomi b/src/widgets/ot_calendar.eliomi index 6e72fd32..2f56cc5f 100644 --- a/src/widgets/ot_calendar.eliomi +++ b/src/widgets/ot_calendar.eliomi @@ -41,10 +41,10 @@ type button_labels = val make : ?init:int * int * int - -> ?highlight:(int -> int -> int list Lwt.t) Eliom_client_value.t + -> ?highlight:(int -> int -> int list) Eliom_client_value.t -> ?click_non_highlighted:bool -> ?update:(int * int * int) React.E.t Eliom_client_value.t - -> ?action:(int -> int -> int -> unit Lwt.t) Eliom_client_value.t + -> ?action:(int -> int -> int -> unit) Eliom_client_value.t -> ?period: CalendarLib.Date.field CalendarLib.Date.date * CalendarLib.Date.field CalendarLib.Date.date diff --git a/src/widgets/ot_carousel.eliom b/src/widgets/ot_carousel.eliom index fd76dc66..95286288 100644 --- a/src/widgets/ot_carousel.eliom +++ b/src/widgets/ot_carousel.eliom @@ -35,11 +35,9 @@ *) open%client Js_of_ocaml - -[%%client open Js_of_ocaml_lwt] -[%%shared open Eliom_content.Html] -[%%shared open Eliom_content.Html.F] -[%%shared open Lwt.Syntax] +open%client Js_of_ocaml_eio +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F let%client clX = Ot_swipe.clX let%client clY = Ot_swipe.clY @@ -191,10 +189,9 @@ let%shared (for example if we want margins between elements) *) max 1 (truncate (float (width_carousel + 1) /. float width_element)) in - Lwt.async (fun () -> - let* () = Ot_nodeready.nodeready d2' in - ~%set_nb_visible_elements (comp_nb_visible_elements ()); - Lwt.return_unit); + Eliom_lib.fork (fun () -> + let () = Ot_nodeready.nodeready d2' in + ~%set_nb_visible_elements (comp_nb_visible_elements ())); let maxi () = ~%maxi - React.S.value ~%nb_visible_elements + 1 in let pos_signal = ~%pos_signal in let pos_set = ~%pos_set in @@ -304,20 +301,13 @@ let%shared ~%swipe_pos_set ~step 0.; React.Step.execute step; set_active (); - Lwt.async (fun () -> - let* () = - if move - then - let* _ = Lwt_js_events.transitionend d2' in - Lwt.return_unit - else Lwt.return_unit - in + Eliom_lib.fork (fun () -> + if move then ignore (Eio_js_events.transitionend d2'); Eliom_lib.Option.iter (fun f -> f ()) transitionend; Manip.Class.remove ~%d2 ot_swiping; - ~%pos_post_set pos; + ~%pos_post_set pos (* Remove swiping after calling f, - because f will possibly change the scrolling position of the page *) - Lwt.return_unit) + because f will possibly change the scrolling position of the page *)) in (*VVV I recompute the size everytime we touch the carousel and when the window is resized (?). @@ -328,27 +318,26 @@ let%shared (React.S.map (fun _ -> ~%set_nb_visible_elements (comp_nb_visible_elements ())) (if vertical then Ot_size.height else Ot_size.width)); - Lwt.async (fun () -> - let* () = Ot_nodeready.nodeready d2' in - set_position ~%position; add_transition d2'; Lwt.return_unit); + Eliom_lib.fork (fun () -> + Ot_nodeready.nodeready d2'; set_position ~%position; add_transition d2'); let perform_animation a = ~%set_nb_visible_elements (comp_nb_visible_elements ()); if not (React.S.value ~%disabled) - then ( + then match !action, a with | `Change _, _ -> (* We received both a panend and a swipe. The panend can be a `Goback and the swipe a `Change. We ignore the `Goback. *) - Lwt.return_unit + () | _ -> action := a; if not !animation_frame_requested then ( animation_frame_requested := true; - let* () = Lwt_js_events.request_animation_frame () in + Eio_js_events.request_animation_frame (); animation_frame_requested := false; - (match !action with + match !action with | `Move (delta, width_element) -> let delta = if ~%allow_overswipe @@ -373,10 +362,7 @@ let%shared Manip.Class.add ~%d2 ot_swiping; set_top_margin (); action := `Move (0., 0); - set_position ~transitionend:unset_top_margin position); - Lwt.return_unit) - else Lwt.return_unit) - else Lwt.return_unit + set_position ~transitionend:unset_top_margin position) in let status = ref Stopped in let compute_speed prev_speed prev_delta prev_timestamp delta = @@ -396,7 +382,7 @@ let%shared in timestamp, speed in - let onpan ev _ = + let onpan ev = (match !status with | Start (startx, starty, prev_timestamp) -> let move = @@ -425,7 +411,7 @@ let%shared (startx, starty, width_element (), speed, move, timestamp)) else !status | _ -> ()); - (match !status with + match !status with | Ongoing ( startx , starty @@ -445,10 +431,9 @@ let%shared in status := Ongoing (startx, starty, width_element, speed, delta, timestamp); - Lwt.async (fun () -> + Eliom_lib.fork (fun () -> perform_animation (`Move (delta, width_element))) - | _ -> ()); - Lwt.return_unit + | _ -> () in (* let hammer = Hammer.make_hammer d2 in *) let do_end ev startx starty prev_speed prev_delta prev_timestamp = @@ -488,32 +473,31 @@ let%shared then perform_animation (`Change newpos) else perform_animation (`Goback newpos) in - let touchend ev _ = + let touchend ev = match !status with | Start (startx, starty, timestamp) -> do_end ev startx starty 0. 0. timestamp | Ongoing (startx, starty, _width, speed, delta, timestamp) -> do_end ev startx starty speed delta timestamp - | _ -> Lwt.return_unit + | _ -> () in - let touchcancel ev _ = + let touchcancel ev = match !status with | Start (startx, starty, _) | Ongoing (startx, starty, _, _, _, _) -> add_transition d2'; status := Stopped; let pos = Eliom_shared.React.S.value pos_signal in perform_animation (`Goback pos) - | _ -> Lwt.return_unit + | _ -> () in if ~%swipeable then ( - Lwt.async (fun () -> - Lwt_js_events.touchstarts d (fun ev aa -> - status := Start (clX ev, clY ev, now ()); - Lwt.return_unit)); - Lwt.async (fun () -> Lwt_js_events.touchmoves d onpan); - Lwt.async (fun () -> Lwt_js_events.touchends d touchend); - Lwt.async (fun () -> Lwt_js_events.touchcancels d touchcancel)); + Eliom_lib.fork (fun () -> + Eio_js_events.touchstarts d (fun ev -> + status := Start (clX ev, clY ev, now ()))); + Eliom_lib.fork (fun () -> Eio_js_events.touchmoves d onpan); + Eliom_lib.fork (fun () -> Eio_js_events.touchends d touchend); + Eliom_lib.fork (fun () -> Eio_js_events.touchcancels d touchcancel)); ignore (Eliom_lib.Option.map (fun update -> @@ -538,14 +522,12 @@ let%shared in if curpos < maxi then perform_animation (`Change (curpos + 1)) - else Lwt.return_unit | `Prev -> let curpos = Eliom_shared.React.S.value pos_signal in if curpos > 0 - then perform_animation (`Change (curpos - 1)) - else Lwt.return_unit) + then perform_animation (`Change (curpos - 1))) update)) ~%update) : unit)] @@ -587,27 +569,24 @@ let%client set_default_fail f = :> exn -> Html_types.div_content Eliom_content.Html.elt) let%shared generate_content generator = - Lwt.catch - (fun () -> Eliom_shared.Value.local generator ()) - (fun e -> Lwt.return (default_fail e)) + try Eliom_shared.Value.local generator () with e -> default_fail e (* on the client side we generate the contents of the initially visible page asynchronously so the tabs will be rendered right away *) let%client generate_initial_contents ~spinner sleeper gen = let s = spinner () in - ( Lwt.async @@ fun () -> - let* contents = generate_content gen in + ( Eliom_lib.fork @@ fun () -> + let contents = generate_content gen in (* wait until DOM elements are created before attempting to replace them *) - let* parent = sleeper in + let parent = Eio.Promise.await sleeper in ignore @@ To_dom.of_element parent; - Manip.replaceSelf s contents; - Lwt.return () ); - Lwt.return (s, ref @@ None) + Manip.replaceSelf s contents ); + s, ref @@ None (* on the server side we generate all the visible contents right away *) let%server generate_initial_contents ~spinner:_ _ gen = - let* contents = generate_content gen in - Lwt.return (contents, ref @@ None) + let contents = generate_content gen in + contents, ref @@ None let%shared make_lazy @@ -628,30 +607,30 @@ let%shared = let gen_contents = (gen_contents - :> (unit -> Html_types.div_content elt Lwt.t) Eliom_shared.Value.t list) + :> (unit -> Html_types.div_content elt) Eliom_shared.Value.t list) in - let sleeper, wakener = Lwt.wait () in - let mk_contents : int -> 'gen -> ('a elt * ('a elt * 'gen) option ref) Lwt.t = + let sleeper, wakener = + Eio.Promise.create + (* TODO: ciao-lwt: Translation is incomplete, [Promise.await] must be called on the promise when it's part of control-flow. *) + () + in + let mk_contents : int -> 'gen -> 'a elt * ('a elt * 'gen) option ref = fun i gen -> if i = position then generate_initial_contents ~spinner sleeper gen else - Lwt.return - @@ let s = spinner () in s, ref @@ Some (s, gen) in - let* contents, spinners_and_generators = - Lwt.map List.split - @@ Lwt_list.map_s (fun x -> x) - @@ List.mapi mk_contents gen_contents + let contents, spinners_and_generators = + List.split (List.map (fun x -> x) (List.mapi mk_contents gen_contents)) in let carousel = make ?a ?vertical ~position ?transition_duration ?inertia ?swipeable ?allow_overswipe ?update ?disabled ?full_height ?make_transform ?make_page_attribute contents in - Lwt.wakeup wakener carousel.elt; + Eio.Promise.resolve wakener carousel.elt; (* generate initial content (client-side) *) (* replace spinners with content when switched to for the first time *) let _ = @@ -667,17 +646,16 @@ let%shared let spinner_and_generator = List.nth ~%spinners_and_generators i in - Lwt.async @@ fun () -> + Eliom_lib.fork @@ fun () -> match !spinner_and_generator with | Some (spinner, gen_content) -> spinner_and_generator := None; - let* content = generate_content gen_content in - Manip.replaceSelf spinner content; - Lwt.return_unit - | None -> Lwt.return ()) + let content = generate_content gen_content in + Manip.replaceSelf spinner content + | None -> ()) : unit)] in - Lwt.return carousel + carousel let%shared bullet_class i pos size = Eliom_shared.React.S.l2 @@ -773,8 +751,8 @@ let%shared React.S.create container'##.offsetWidth in let curleft, set_curleft = React.S.create initial_gap in - Lwt.async (fun () -> - let* () = Ot_nodeready.nodeready container' in + Eliom_lib.fork (fun () -> + Ot_nodeready.nodeready container'; (* Ribbon position: *) set_containerwidth container'##.offsetWidth; Ot_noderesize.noderesize (Ot_noderesize.attach container') (fun () -> @@ -794,10 +772,9 @@ let%shared noderesize but there is also a race condition with this code here that runs on window resizing. So we make sure the ribbon code runs AFTER it has been placed into the fixed container by Ot_sticky. *) - Lwt.async @@ fun () -> - let* _ = Lwt_js.sleep 0.05 in - set_containerwidth container'##.offsetWidth; - Lwt.return_unit); + Eliom_lib.fork @@ fun () -> + Eio_js.sleep 0.05; + set_containerwidth container'##.offsetWidth); (* Changing the position of the ribbon when the carousel position changes or when the size of the window changes: *) Eliom_lib.Dom_reference.retain container' @@ -844,7 +821,7 @@ let%shared | _ -> ()) ~%pos ~%size containerwidth); (* Cursor: *) - (match ~%cursor_elt, ~%cursor with + match ~%cursor_elt, ~%cursor with | Some cursor_elt, Some cursor -> let moving = ref false in Eliom_lib.Dom_reference.retain container' @@ -924,13 +901,11 @@ let%shared | _ -> ()) ~%pos cursor ~%size curleft containerwidth) | _ -> ()); - Lwt.return_unit); - Lwt.async (fun () -> - let* () = Ot_nodeready.nodeready container' in - let* () = Lwt_js_events.request_animation_frame () in + Eliom_lib.fork (fun () -> + Ot_nodeready.nodeready container'; + Eio_js_events.request_animation_frame (); add_transition the_ul'; - Eliom_lib.Option.iter add_transition cursor_elt'; - Lwt.return_unit); + Eliom_lib.Option.iter add_transition cursor_elt'); (* Moving the ribbon with fingers: *) let fmax () = initial_gap in let fmin () = @@ -957,8 +932,7 @@ let%shared ~onstart:(fun _ _ -> Eliom_lib.Option.iter remove_transition cursor_elt') ~onend:(fun ev _ -> Eliom_lib.Option.iter add_transition cursor_elt') - the_ul; - Lwt.return_unit + the_ul : _)]; container @@ -1033,7 +1007,7 @@ let%shared (* D.div ~a:(a_class ["ot-car-nav"]::a) [prev; menu; next] *) let%client bind_arrow_keys ?use_capture ?(vertical = false) ~change elt = - Lwt_js_events.keydowns ?use_capture elt (fun ev _ -> + Eio_js_events.keydowns ?use_capture elt (fun ev -> let change d = Dom_html.stopPropagation ev; Dom.preventDefault ev; @@ -1061,8 +1035,7 @@ let%client bind_arrow_keys ?use_capture ?(vertical = false) ~change elt = else if key = 39 (* right *) then change `Next else if key = 37 (* left *) - then change `Prev; - Lwt.return_unit) + then change `Prev) let%shared wheel_compute_angle pos faces swipe_pos = (float pos +. swipe_pos) *. (360. /. float faces) @@ -1142,8 +1115,8 @@ let%shared (* {client{ *) (* let _ = *) -(* Lwt.async (fun () -> *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Elio_lib.fork (fun () -> *) +(* Eio_js.sleep 1.; *) (* let ev, send_ev = React.E.create () in *) (* let d, _ = make *) (* ~position:2 *) @@ -1155,27 +1128,27 @@ let%shared (* ] *) (* in *) (* Manip.appendToBody d; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev `Next; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev `Next; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev `Prev; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev `Next; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev `Prev; *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev (`Goto 0); *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev (`Goto 3); *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev (`Goto 1); *) -(* lwt () = Lwt_js.sleep 1. in *) +(* Eio_js.sleep 1.; *) (* send_ev (`Goto 0); *) -(* lwt () = Lwt_js.sleep 1. in *) -(* send_ev (`Goto 3); *) -(* Lwt.return_unit *) +(* Eio_js.sleep 1.; *) +(* send_ev (`Goto 3) *) +(* *) (* ) *) (* }} *) diff --git a/src/widgets/ot_carousel.eliomi b/src/widgets/ot_carousel.eliomi index d2424bf7..48a84c09 100644 --- a/src/widgets/ot_carousel.eliomi +++ b/src/widgets/ot_carousel.eliomi @@ -19,9 +19,8 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -[%%client.start] - -open Js_of_ocaml +open%client Js_of_ocaml +open%client Js_of_ocaml_eio [%%shared.start] @@ -148,10 +147,10 @@ val make_lazy : -> Html_types.div_attrib Eliom_content.Html.D.attrib list) Eliom_shared.Value.t -> ?spinner:(unit -> Html_types.div_content Eliom_content.Html.elt) - -> (unit -> [< Html_types.div_content] Eliom_content.Html.elt Lwt.t) + -> (unit -> [< Html_types.div_content] Eliom_content.Html.elt) Eliom_shared.Value.t list - -> [> `Div] t Lwt.t + -> [> `Div] t (** same as [make] except for the last argument. Instead of supplying the contents for each page directly, supply a for each page a shared content generator function. Contents will be generated and filled lazily, i.e. when @@ -274,13 +273,13 @@ val next : [%%client.start] (* Make arrow keys cause event change. - Returns a thread that never stops until you call [Lwt.cancel] on it. *) + Never returns unless you cancel the switch in which is runs. *) val bind_arrow_keys : ?use_capture:bool -> ?vertical:bool -> change:([> `Goto of int | `Next | `Prev] -> unit) -> #Dom_html.eventTarget Js.t - -> unit Lwt.t + -> unit val set_default_fail : (exn -> [< Html_types.div_content] Eliom_content.Html.elt) diff --git a/src/widgets/ot_drawer.eliom b/src/widgets/ot_drawer.eliom index 6703b24e..76feca83 100644 --- a/src/widgets/ot_drawer.eliom +++ b/src/widgets/ot_drawer.eliom @@ -1,4 +1,3 @@ -[%%shared (* Ocsigen * http://www.ocsigen.org * @@ -19,14 +18,11 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Eliom_content.Html] - -[%%shared open Eliom_content.Html.F] - +open%shared Eio.Std +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F open%client Js_of_ocaml -open%client Lwt.Syntax - -[%%client open Js_of_ocaml_lwt] +open%client Js_of_ocaml_eio type%client status = Stopped | Start | Aborted | In_progress @@ -43,15 +39,13 @@ let%client clY ev = (fun a -> Js.to_float a##.clientY) let%client bind_click_outside bckgrnd elt close = - Lwt.async (fun () -> - let* ev = - Ot_lib.click_outside ~use_capture:true + Eliom_lib.fork (fun () -> + let ev = + Ot_lib.click_outside ~use_capture:true (To_dom.of_element elt) ~inside:(To_dom.of_element bckgrnd) - (To_dom.of_element elt) in Dom_html.stopPropagation ev; - close (); - Lwt.return_unit) + close ()) let%client html () = Js.Opt.to_option @@ -113,11 +107,11 @@ let%shared D.div ~a:(a_class ("ot-drawer-bckgrnd" :: bckgrnd_init_class) :: a) [d] in let bind_touch : - ((unit -> unit) Lwt.t * (unit -> unit) Lwt.u) Eliom_client_value.t + ((unit -> unit) Promise.t * (unit -> unit) Promise.u) Eliom_client_value.t = - [%client Lwt.wait ()] + [%client Promise.create ()] in - let touch_thread = [%client (ref Lwt.return_unit : unit Lwt.t ref)] in + let cancel_touch = [%client (ref (fun () -> ()) : (unit -> unit) ref)] in let reset_scroll_pos = [%client (fun () -> @@ -139,12 +133,11 @@ let%shared remove_class ~%bckgrnd "open"; ~%reset_scroll_pos (); add_class ~%bckgrnd "closing"; - Lwt.cancel !(~%touch_thread); - Lwt_js_events.async (fun () -> - let* _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in + !(~%cancel_touch) (); + Eio_js_events.async (fun () -> + ignore (Eio_js_events.transitionend (To_dom.of_element ~%d)); remove_class ~%bckgrnd "closing"; - Eliom_lib.Option.iter (fun f -> f ()) ~%onclose; - Lwt.return_unit) + Eliom_lib.Option.iter (fun f -> f ()) ~%onclose) : unit -> unit)] in let close = wrap_close close in @@ -157,17 +150,16 @@ let%shared Dom_html.document##.body##.style##.top := Js.string (Printf.sprintf "%.2fpx" (-. !(~%scroll_pos))); add_class ~%bckgrnd "opening"; - Lwt.cancel !(~%touch_thread); - Lwt.async (fun () -> - let* bind_touch = fst ~%bind_touch in - bind_touch (); Lwt.return_unit); + !(~%cancel_touch) (); + Eliom_lib.fork (fun () -> + let bind_touch = Eio.Promise.await (fst ~%bind_touch) in + bind_touch ()); bind_click_outside ~%bckgrnd ~%d ~%close; Eliom_client.Page_status.onactive ~stop:(fst ~%stop_open_event) (fun () -> html_ManipClass_add "ot-drawer-open"); - Lwt_js_events.async (fun () -> - let* _ = Lwt_js_events.transitionend (To_dom.of_element ~%d) in - remove_class ~%bckgrnd "opening"; - Lwt.return_unit) + Eio_js_events.async (fun () -> + ignore (Eio_js_events.transitionend (To_dom.of_element ~%d)); + remove_class ~%bckgrnd "opening") : unit -> unit)] in let open_ = wrap_open open_ in @@ -177,9 +169,8 @@ let%shared ~%reset_scroll_pos (); html_ManipClass_remove "ot-drawer-opening"; html_ManipClass_remove "ot-drawer-open"; - html_ManipClass_remove "ot-drawer-closing"); - Lwt.return_unit - : unit Lwt.t)] + html_ManipClass_remove "ot-drawer-closing") + : unit)] in let _ = [%client @@ -188,12 +179,11 @@ let%shared then ~%close () else ~%open_ () in - Lwt_js_events.async (fun () -> - Lwt_js_events.clicks (To_dom.of_element ~%toggle_button) (fun ev _ -> + Eio_js_events.async (fun () -> + Eio_js_events.clicks (To_dom.of_element ~%toggle_button) (fun ev -> Dom.preventDefault ev; Dom_html.stopPropagation ev; - toggle (); - Lwt.return_unit)) + toggle ())) : unit)] in let _ = @@ -207,18 +197,17 @@ let%shared let animation_frame_requested = ref false in let action = ref (`Move 0.) in let perform_animation a = - if !action = `Close && a = `Open - then - (* We received a panend after a swipeleft. We ignore it. *) - Lwt.return_unit - else ( + if + not (!action = `Close && a = `Open) + (* if we received a panend after a swipeleft. We ignore it. *) + then ( action := a; if not !animation_frame_requested then ( animation_frame_requested := true; - let* () = Lwt_js_events.request_animation_frame () in + Eio_js_events.request_animation_frame (); animation_frame_requested := false; - (match !action with + match !action with | `Move delta -> let s = (match ~%position with @@ -235,26 +224,22 @@ let%shared (Js.Unsafe.coerce dr##.style)##.transform := Js.string ""; (Js.Unsafe.coerce dr##.style)##.webkitTransform := Js.string ""; - Lwt.async (fun () -> - let* _ = Lwt_js_events.transitionend dr in - Manip.Class.remove ~%bckgrnd "ot-swiping"; - Lwt.return_unit); + Eliom_lib.fork (fun () -> + ignore @@ Eio_js_events.transitionend dr; + Manip.Class.remove ~%bckgrnd "ot-swiping"); cl () | `Open -> (Js.Unsafe.coerce dr##.style)##.transform := Js.string ""; (Js.Unsafe.coerce dr##.style)##.webkitTransform := Js.string ""; - Lwt.async (fun () -> - let* _ = Lwt_js_events.transitionend dr in - Manip.Class.remove ~%bckgrnd "ot-swiping"; - Lwt.return_unit) + Eliom_lib.fork (fun () -> + ignore @@ Eio_js_events.transitionend dr; + Manip.Class.remove ~%bckgrnd "ot-swiping") | `Abort -> (Js.Unsafe.coerce dr##.style)##.transform := Js.string ""; (Js.Unsafe.coerce dr##.style)##.webkitTransform := Js.string ""; - Manip.Class.remove ~%bckgrnd "ot-swiping"); - Lwt.return_unit) - else Lwt.return_unit) + Manip.Class.remove ~%bckgrnd "ot-swiping")) in (* let hammer = Hammer.make_hammer bckgrnd in *) let startx = @@ -266,7 +251,7 @@ let%shared (* position when touch starts *) in let status = ref Stopped in - let onpan ev _ = + let onpan ev = let left = clX ev -. !startx in let top = clY ev -. !starty in if !status = Start @@ -312,9 +297,7 @@ let%shared && (move := left; true) - then perform_animation (`Move !move) - else Lwt.return_unit) - else Lwt.return_unit + then perform_animation (`Move !move)) in let onpanend ev _ = if !status = In_progress @@ -338,60 +321,52 @@ let%shared || (~%position = `Left && deltaX >= 0.) then perform_animation `Abort else perform_animation `Open) - else ( - status := Stopped; - Lwt.return_unit) + else status := Stopped in - let onpanstart ev _ = + let onpanstart ev = status := Start; startx := clX ev; starty := clY ev; - let* () = onpan ev a in + ignore @@ onpan ev; (* Lwt.pick and Lwt_js_events.touch*** seem to behave oddly. This wrapping is an attempt to understand why. *) - let a = - Lwt.catch - (fun () -> Lwt_js_events.touchmoves bckgrnd' onpan) - (function - | Lwt.Canceled -> Lwt.return_unit - | e -> - let s = Printexc.to_string e in - Printf.printf "Ot_drawer>touchmoves>exception: %s\n%!" s; - Lwt.fail e) - and b = - Lwt.catch - (fun () -> - let* ev = Lwt_js_events.touchend bckgrnd' in - onpanend ev ()) - (function - | Lwt.Canceled -> Lwt.return_unit - | e -> - let s = Printexc.to_string e in - Printf.printf "Ot_drawer>touchend>exception: %s\n%!" s; - Lwt.fail e) - and c = - Lwt.catch - (fun () -> - let* ev = Lwt_js_events.touchcancel bckgrnd' in - onpanend ev ()) - (function - | Lwt.Canceled -> Lwt.return_unit - | e -> - let s = Printexc.to_string e in - Printf.printf "Ot_drawer>touchcancel>exception: %s\n%!" s; - Lwt.fail e) + let f1 () = + try Eio_js_events.touchmoves bckgrnd' onpan + with e -> + let s = Printexc.to_string e in + Printf.printf "Ot_drawer>touchmoves>exception: %s\n%!" s; + raise e + and f2 () = + try + let ev = Eio_js_events.touchend bckgrnd' in + onpanend ev () + with e -> + let s = Printexc.to_string e in + Printf.printf "Ot_drawer>touchend>exception: %s\n%!" s; + raise e + and f3 () = + try + let ev = Eio_js_events.touchcancel bckgrnd' in + onpanend ev () + with e -> + let s = Printexc.to_string e in + Printf.printf "Ot_drawer>touchcancel>exception: %s\n%!" s; + raise e in - Lwt.pick [a; b; c] + Eio.Fiber.any [f1; f2; f3] in - Lwt.wakeup (snd ~%bind_touch) (fun () -> - let t = Lwt_js_events.touchstarts bckgrnd' onpanstart in - ~%touch_thread := t) + Eio.Promise.resolve (snd ~%bind_touch) (fun () -> + Eio.Switch.run (fun sw -> + (~%cancel_touch := + fun () -> Eio.Switch.fail sw Eio_js_events.Cancelled); + Eio.Fiber.fork ~sw (fun () -> + Eio_js_events.touchstarts bckgrnd' onpanstart))) (* Hammer.bind_callback hammer "panstart" onpanstart; *) (* Hammer.bind_callback hammer "panmove" onpan; *) (* Hammer.bind_callback hammer "panend" onpanend; *) (* Hammer.bind_callback hammer *) (* (if ~%position = `Left then "swipeleft" else "swiperight") *) - (* (fun _ -> Lwt.async (fun () -> perform_animation `Close)) *) + (* (fun _ -> Eliom_lib.fork (fun () -> perform_animation `Close)) *) : unit)] else [%client ()] in diff --git a/src/widgets/ot_form.eliom b/src/widgets/ot_form.eliom index 6ed7e66d..d65a0821 100644 --- a/src/widgets/ot_form.eliom +++ b/src/widgets/ot_form.eliom @@ -20,7 +20,7 @@ open Js_of_ocaml -[%%client open Js_of_ocaml_lwt] +[%%client open Js_of_ocaml_eio] open Eliom_content.Html open Eliom_content.Html.F @@ -61,16 +61,12 @@ let setup_tabcycle (elts : #tabbable Js.t list) : unit = let rec fn n = function | [x] -> x##.tabIndex := n; - (let open Lwt_js_events in + (let open Eio_js_events in async @@ fun () -> - focuses x @@ fun _ _ -> - x##.tabIndex := 1; - Lwt.return_unit); - let open Lwt_js_events in + focuses x @@ fun _ -> x##.tabIndex := 1); + let open Eio_js_events in async @@ fun () -> - blurs x @@ fun _ _ -> - x##.tabIndex := n; - Lwt.return_unit + blurs x @@ fun _ -> x##.tabIndex := n | hd :: tl -> hd##.tabIndex := n; fn (n + 1) tl diff --git a/src/widgets/ot_lib.eliom b/src/widgets/ot_lib.eliom index 6b29287d..2388904c 100644 --- a/src/widgets/ot_lib.eliom +++ b/src/widgets/ot_lib.eliom @@ -1,4 +1,3 @@ -[%%client (* Ocsigen * http://www.ocsigen.org * @@ -19,10 +18,8 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Js_of_ocaml -open Lwt.Syntax] - -[%%client open Js_of_ocaml_lwt] +open%client Js_of_ocaml +open%client Js_of_ocaml_eio let%client onloads handler = let rec loop () = Eliom_client.onload @@ fun () -> handler (); loop () in @@ -31,55 +28,37 @@ let%client onloads handler = let%client onresizes handler = let stop, stop_thread = React.E.create () in Eliom_client.Page_status.while_active ~stop (fun () -> - Lwt_js_events.onresizes handler); - Lwt.finalize - (fun () -> fst @@ Lwt.wait ()) - (fun () -> stop_thread (); Lwt.return_unit) + Eio_js_events.onresizes handler); + try Eio.Fiber.await_cancel () with Eio.Cancel.Cancelled _ -> stop_thread () let%client window_scroll ?use_capture () = - Lwt_js_events.make_event Dom_html.Event.scroll ?use_capture Dom_html.window + Eio_js_events.make_event Dom_html.Event.scroll ?use_capture Dom_html.window let%client window_scrolls ?(ios_html_scroll_hack = false) ?use_capture handler = let stop, stop_thread = React.E.create () in - let cur = ref Lwt.return_unit in Eliom_client.Page_status.while_active ~stop (fun () -> - cur := - if ios_html_scroll_hack - then - let rec loop () = - let* e = - Lwt.pick - (List.map - (* We listen to several elements because scroll events are + if ios_html_scroll_hack + then + let rec loop () = + let e = + Eio.Fiber.any + (List.map + (* We listen to several elements because scroll events are not happening on the same element on every platform. *) - (fun element -> Lwt_js_events.scroll ?use_capture element) - [ (Dom_html.window :> Dom_html.eventTarget Js.t) - ; (Dom_html.document##.documentElement - :> Dom_html.eventTarget Js.t) - ; (Dom_html.document##.body :> Dom_html.eventTarget Js.t) ]) - in - let continue = ref true in - let w = - Lwt.catch - (fun () -> fst (Lwt.task ())) - (function - | Lwt.Canceled -> - continue := false; - Lwt.return_unit - | exc -> Lwt.reraise exc) - in - let* () = handler e w in - if !continue then loop () else Lwt.return_unit + (fun element () -> Eio_js_events.scroll ?use_capture element) + [ (Dom_html.window :> Dom_html.eventTarget Js.t) + ; (Dom_html.document##.documentElement + :> Dom_html.eventTarget Js.t) + ; (Dom_html.document##.body :> Dom_html.eventTarget Js.t) ]) in - loop () - else - Lwt_js_events.seq_loop - (Lwt_js_events.make_event Dom_html.Event.scroll) - ?use_capture Dom_html.window handler; - !cur); - Lwt.finalize - (fun () -> fst @@ Lwt.task ()) - (fun () -> stop_thread (); Lwt.cancel !cur; Lwt.return_unit) + handler e; loop () + in + loop () + else + Eio_js_events.seq_loop + (Eio_js_events.make_event Dom_html.Event.scroll) + ?use_capture Dom_html.window handler); + try Eio.Fiber.await_cancel () with Eio.Cancel.Cancelled _ -> stop_thread () let%client rec in_ancestors ~elt ~ancestor = Js.strict_equals elt (ancestor : Dom_html.element Js.t) @@ -98,13 +77,13 @@ let%client rec ?(inside = (Dom_html.document##.body :> Dom_html.element Js.t)) elt = - let* ev = Lwt_js_events.click ?use_capture inside in + let ev = Eio_js_events.click ?use_capture inside in Js.Opt.case ev##.target (fun () -> click_outside ?use_capture elt) (fun target -> if in_ancestors ~elt:target ~ancestor:(elt :> Dom_html.element Js.t) then click_outside ?use_capture ~inside elt - else Lwt.return ev) + else ev) [%%shared module List = struct diff --git a/src/widgets/ot_lib.eliomi b/src/widgets/ot_lib.eliomi index da997e5d..d636ba18 100644 --- a/src/widgets/ot_lib.eliomi +++ b/src/widgets/ot_lib.eliomi @@ -22,6 +22,7 @@ [%%client.start] open Js_of_ocaml +open Js_of_ocaml_eio val in_ancestors : elt:Dom_html.element Js.t @@ -30,22 +31,21 @@ val in_ancestors : val onloads : (unit -> unit) -> unit -val onresizes : (Dom_html.event Js.t -> unit Lwt.t -> unit Lwt.t) -> unit Lwt.t +val onresizes : (Dom_html.event Js.t -> unit) -> unit (** NOTE: be careful when using the functions [onresizes], [window_scroll], and [window_scrolls]. They may be called before the new document is displayed (and thus the new window is there) and therefore may be attached to the window that is about to be replaced. In most use-cases you should have a line as follows - before: let%lwt () = Ot_nodeready.nodeready @@ To_dom.of_element - some_elt in *) + before: Ot_nodeready.nodeready @@ To_dom.of_element some_elt; *) -val window_scroll : ?use_capture:bool -> unit -> Dom_html.event Js.t Lwt.t +val window_scroll : ?use_capture:bool -> unit -> Dom_html.event Js.t val window_scrolls : ?ios_html_scroll_hack:bool -> ?use_capture:bool - -> (Dom_html.event Js.t -> unit Lwt.t -> unit Lwt.t) - -> unit Lwt.t + -> (Dom_html.event Js.t -> unit) + -> unit (** If [ios_html_scroll_hack] then listen on window + html + body instead of only window. On iOS (8 and 9), in WkWebView and in Safari, some CSS properties (e.g. html{overflow:scroll; @@ -77,11 +77,13 @@ val click_outside : ?use_capture:bool -> ?inside:Dom_html.element Js.t -> #Dom_html.element Js.t - -> Dom_html.mouseEvent Js.t Lwt.t + -> Dom_html.mouseEvent Js.t (** [click_outside e] returns when user clicks outside element [e]. Will only catch clicks inside the element given as optional parameter [?inside] (default is [Dom_html.document##.body]). *) +(**/**) + [%%shared.start] module List : sig diff --git a/src/widgets/ot_nodeready.eliom b/src/widgets/ot_nodeready.eliom index 2a422c6a..7ea64e41 100644 --- a/src/widgets/ot_nodeready.eliom +++ b/src/widgets/ot_nodeready.eliom @@ -30,8 +30,8 @@ let rec node_in_document node = type t = { node : Dom.node Js.t - ; thread : unit Lwt.t - ; resolver : unit Lwt.u + ; promise : unit Eio.Promise.t + ; resolver : unit Eio.Promise.u ; stop_ondead : unit -> unit } let watched = ref [] @@ -61,7 +61,8 @@ let handler records observer = if not_ready = [] then observer##disconnect; ready |> List.iter (fun {resolver; stop_ondead} -> - stop_ondead (); Lwt.wakeup resolver ())) + stop_ondead (); + Eio.Promise.resolve resolver ())) let observer = new%js MutationObserver.mutationObserver (Js.wrap_callback handler) @@ -75,19 +76,17 @@ let config = let nodeready n = let n = (n :> Dom.node Js.t) in if node_in_document n - then ( - log ~n "already in document"; - Lwt.return_unit) + then log ~n "already in document" else ( if !watched = [] then observer##observe Dom_html.document config; try - let {thread} = + let {promise} = List.find (fun {node} -> Js.strict_equals n node) !watched in log ~n "already being watched"; - thread + Eio.Promise.await promise with Not_found -> - let t, s = Lwt.wait () in + let t, s = Eio.Promise.create () in let stop, stop_ondead = React.E.create () in let stop_ondead () = log ~n "put node in document"; @@ -100,7 +99,8 @@ let nodeready n = watched := rest; instances_of_node |> List.iter (fun {resolver} -> - log ~n "deinstalled"; Lwt.wakeup resolver ())); - watched := {node = n; thread = t; resolver = s; stop_ondead} :: !watched; + log ~n "deinstalled"; + Eio.Promise.resolve resolver ())); + watched := {node = n; promise = t; resolver = s; stop_ondead} :: !watched; log ~n "installed"; - t) + Eio.Promise.await t) diff --git a/src/widgets/ot_nodeready.eliomi b/src/widgets/ot_nodeready.eliomi index a825ff81..60ec6a71 100644 --- a/src/widgets/ot_nodeready.eliomi +++ b/src/widgets/ot_nodeready.eliomi @@ -22,12 +22,12 @@ open Js_of_ocaml -val nodeready : #Dom.node Js.t -> unit Lwt.t +val nodeready : #Dom.node Js.t -> unit (** Wait for a node to be inserted in the DOM. {3 Example} - [let _ = nodeready node in Console.console##debug node] + [Eio.Fiber.fork ~sw (fun () -> nodeready node; Console.console##debug node)] {3 Known issues} diff --git a/src/widgets/ot_noderesize.eliomi b/src/widgets/ot_noderesize.eliomi index 80993cd6..aab27c8e 100644 --- a/src/widgets/ot_noderesize.eliomi +++ b/src/widgets/ot_noderesize.eliomi @@ -45,9 +45,9 @@ open Js_of_ocaml {3 Example} - {[Lwt.async (fun () -> + {[Eio.Fiber.fork ~sw (fun () -> let div' = (To_dom.of_element div) in - let%lwt () = Ot_nodeready.nodeready div' in + Ot_nodeready.nodeready div'; Ot_noderesize.noderesize (ot_noderesize.attach div) (fun () -> Console.console##log (Js.string "Resized") ) )]} *) diff --git a/src/widgets/ot_page_transition.eliom b/src/widgets/ot_page_transition.eliom index 97222cc4..a3f0d708 100644 --- a/src/widgets/ot_page_transition.eliom +++ b/src/widgets/ot_page_transition.eliom @@ -1,11 +1,10 @@ [%%client.start] open Js_of_ocaml -open Js_of_ocaml_lwt +open Js_of_ocaml_eio open Eliom_content open Html open Html.D -open Lwt.Syntax type animation = Nil | Forward | Backward @@ -71,31 +70,29 @@ module Make (Conf : PAGE_TRANSITION_CONF) = struct Eliom_client.lock_request_handling (); Option.may Manip.appendToBody screenshot_wrapper; Manip.Class.add body cl_body_pre_forward; - let* () = Lwt_js_events.request_animation_frame () in - let* () = Lwt_js_events.request_animation_frame () in + Eio_js_events.request_animation_frame (); + Eio_js_events.request_animation_frame (); set_transition_duration body transition_duration; Option.may (fun sc -> Manip.Class.add sc cl_screenshot_post_forward) screenshot_container; Manip.Class.remove body cl_body_pre_forward; - let* () = Lwt_js.sleep transition_duration in + Eio_js.sleep transition_duration; Option.may Manip.removeSelf screenshot_wrapper; style##.transitionDuration := initial_transition_duration; - Eliom_client.unlock_request_handling (); - Lwt.return_unit + Eliom_client.unlock_request_handling () let forward_animation ?(transition_duration = 0.5) take_screenshot = - let wait_for_page_change, trigger_page_change = Lwt.wait () in + let wait_for_page_change, trigger_page_change = Eio.Promise.create () in Eliom_client.Page_status.oninactive ~once:true (fun () -> - Lwt.wakeup trigger_page_change ()); + Eio.Promise.resolve trigger_page_change ()); let fa ss = - Lwt.async @@ fun () -> - let* () = wait_for_page_change in + Eliom_lib.fork @@ fun () -> + Eio.Promise.await wait_for_page_change; forward_animation_ transition_duration ss in let f screenshot = fa @@ Some screenshot in - (try take_screenshot f with _ -> fa None); - Lwt.return_unit + try take_screenshot f with _ -> fa None let backward_animation_ transition_duration screenshot = let screenshot_wrapper, _ = @@ -105,26 +102,24 @@ module Make (Conf : PAGE_TRANSITION_CONF) = struct in Eliom_client.lock_request_handling (); Manip.appendToBody screenshot_wrapper; - let* () = Lwt_js_events.request_animation_frame () in - let* () = Lwt_js_events.request_animation_frame () in + Eio_js_events.request_animation_frame (); + Eio_js_events.request_animation_frame (); Manip.Class.add screenshot_wrapper cl_wrapper_post_backward; - let* () = Lwt_js.sleep transition_duration in + Eio_js.sleep transition_duration; Manip.removeSelf screenshot_wrapper; - Eliom_client.unlock_request_handling (); - Lwt.return_unit + Eliom_client.unlock_request_handling () let backward_animation ?(transition_duration = 0.5) take_screenshot = - let wait_for_page_change, trigger_page_change = Lwt.wait () in + let wait_for_page_change, trigger_page_change = Eio.Promise.create () in Eliom_client.Page_status.oninactive ~once:true (fun () -> - Lwt.wakeup trigger_page_change ()); + Eio.Promise.resolve trigger_page_change ()); let ba ss = - Lwt.async @@ fun () -> - let* () = wait_for_page_change in + Eliom_lib.fork @@ fun () -> + Eio.Promise.await wait_for_page_change; backward_animation_ transition_duration ss in let f screenshot = ba @@ Some screenshot in - (try take_screenshot f with _ -> ba None); - Lwt.return_unit + try take_screenshot f with _ -> ba None let install_global_handler ?transition_duration @@ -134,7 +129,7 @@ module Make (Conf : PAGE_TRANSITION_CONF) = struct let rec hc_handler ev = Eliom_client.onchangepage hc_handler; match animation_type ev with - | Nil -> Lwt.return_unit + | Nil -> () | Forward -> forward_animation ?transition_duration take_screenshot | Backward -> backward_animation ?transition_duration take_screenshot in diff --git a/src/widgets/ot_picture_uploader.eliom b/src/widgets/ot_picture_uploader.eliom index 9d31d45d..e0790af1 100644 --- a/src/widgets/ot_picture_uploader.eliom +++ b/src/widgets/ot_picture_uploader.eliom @@ -1,4 +1,3 @@ -[%%shared (* Ocsigen * http://www.ocsigen.org * @@ -18,12 +17,10 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Js_of_ocaml] - -[%%client open Js_of_ocaml_lwt] -[%%client open Lwt.Syntax] -[%%shared open Eliom_content.Html] -[%%shared open Eliom_content.Html.F] +open%shared Js_of_ocaml +open%client Js_of_ocaml_eio +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F type%shared ('a, 'b) service = ( unit @@ -43,10 +40,7 @@ type%shared ('a, 'b) service = Eliom_service.t let%client process_file input callback = - Js.Opt.case - input##.files##(item 0) - (fun () -> Lwt.return_unit) - (fun x -> callback x) + Js.Opt.case input##.files##(item 0) (fun () -> ()) (fun x -> callback x) let%client file_reader file callback = let reader = new%js File.fileReader in @@ -120,7 +114,7 @@ let%shared let img_h, set_img_h = Eliom_shared.React.S.create 0. in let _ = [%client - (let open Lwt_js_events in + (let open Eio_js_events in let crop = To_dom.of_element ~%crop in let t_f = To_dom.of_element ~%t_f in let tr_f = To_dom.of_element ~%tr_f in @@ -283,8 +277,8 @@ let%shared Js.bool true in let bind_handler add_trigger event rm_trigger get_x get_y (dom, handler) = - Lwt.async (fun () -> - add_trigger (To_dom.of_element dom) (fun ev _ -> + Eliom_lib.fork (fun () -> + add_trigger (To_dom.of_element dom) (fun ev -> Dom.preventDefault ev; Dom_html.stopPropagation ev; let () = x := get_x ev in @@ -294,11 +288,9 @@ let%shared (Dom_html.handler (fun ev -> handler (get_x ev) (get_y ev))) (Js.bool false) in - let* _ = - Lwt.pick @@ List.map (fun e -> e Dom_html.document) rm_trigger - in - Dom_html.removeEventListener x; - Lwt.return_unit)) + Eio.Fiber.any + @@ List.map (fun e () -> e Dom_html.document) rm_trigger; + Dom_html.removeEventListener x)) in let listeners = match ~%ratio with @@ -327,7 +319,7 @@ let%shared List.iter2 (fun x y -> bind_handler mousedowns Dom_html.Event.mousemove - [Lwt_js_events.mouseup] + [Eio_js_events.mouseup] (fun ev -> Js.to_float ev##.clientX) (fun ev -> Js.to_float ev##.clientY) (x, y)) @@ -338,7 +330,7 @@ let%shared List.iter (fun x -> bind_handler touchstarts Dom_html.Event.touchmove - [Lwt_js_events.touchend; Lwt_js_events.touchcancel] + [Eio_js_events.touchend; Eio_js_events.touchcancel] (fun ev -> Js.Optdef.case (ev##.touches##item 0) @@ -410,46 +402,36 @@ let%shared preview ?(a = []) () = let%shared submit ?(a = []) content = D.Raw.button ~a:(a_class ["ot-pup-submit"] :: a) content -(* FIXME: To be put in Lwt_js_events *) +(* FIXME: To be put in Eio_js_events *) let%client loads ?cancel_handler ?use_capture t = - Lwt_js_events.(seq_loop load ?cancel_handler ?use_capture t) + Eio_js_events.(seq_loop load ?cancel_handler ?use_capture t) let%client bind_input input preview ?container ?reset () = let onerror () = Eliom_lib.Option.iter (fun container -> container##.classList##add (Js.string "ot-no-file")) container; - preview##.src := Js.string ""; - Lwt.return_unit + preview##.src := Js.string "" in - Eliom_lib.Option.iter - (fun f -> - Lwt.async (fun () -> loads preview (fun _ _ -> Lwt.return @@ f ()))) - reset; - Lwt.async (fun () -> - Lwt_js_events.changes input (fun _ _ -> - Js.Opt.case - (input##.files##item 0) - onerror - (fun file -> - let () = - file_reader (Js.Unsafe.coerce file) (fun data -> - preview##.src := data; - Eliom_lib.Option.iter - (fun container -> - container##.classList##remove (Js.string "ot-no-file")) - container) - in - Lwt.return_unit))) + Eliom_lib.Option.iter (fun f -> ignore @@ loads preview (fun _ -> f ())) reset; + ignore + @@ Eio_js_events.changes input (fun _ -> + Js.Opt.case + (input##.files##item 0) + onerror + (fun file -> + file_reader (Js.Unsafe.coerce file) (fun data -> + preview##.src := data; + Eliom_lib.Option.iter + (fun container -> + container##.classList##remove (Js.string "ot-no-file")) + container))) [%%shared type cropping = (float * float * float * float) React.S.t type 'a upload = - ?progress:(int -> int -> unit) - -> ?cropping:cropping - -> File.file Js.t - -> 'a Lwt.t] + ?progress:(int -> int -> unit) -> ?cropping:cropping -> File.file Js.t -> 'a] let%client ocaml_service_upload ~service ~arg ?progress ?cropping file = Eliom_client.call_ocaml_service ~service () ?upload_progress:progress @@ -457,8 +439,8 @@ let%client ocaml_service_upload ~service ~arg ?progress ?cropping file = let%client do_submit input ?progress ?cropping ~upload () = process_file input @@ fun file -> - let* _ = upload ?progress ?cropping file in - Lwt.return_unit + let _ = upload ?progress ?cropping file in + () let%client bind_submit @@ -469,12 +451,12 @@ let%client ~after_submit () = - Lwt.async (fun () -> - Lwt_js_events.clicks button (fun ev _ -> - Dom.preventDefault ev; - Dom_html.stopPropagation ev; - let* () = do_submit input ?cropping ~upload () in - after_submit ())) + ignore + @@ Eio_js_events.clicks button (fun ev -> + Dom.preventDefault ev; + Dom_html.stopPropagation ev; + do_submit input ?cropping ~upload (); + after_submit ()) let%client bind ?container ~input ~preview ?crop ~submit ~upload ~after_submit () @@ -499,7 +481,7 @@ let%server mk_service name arg_deriver = let%shared mk_form - ?(after_submit = fun () -> Lwt.return_unit) + ?(after_submit = fun () -> ()) ?crop ?input:(input_a, input_content = [], []) ?submit:(submit_a, submit_content = [], []) @@ -532,4 +514,4 @@ let%shared ~upload:~%upload ~after_submit:~%after_submit () : unit)] in - Lwt.return form + form diff --git a/src/widgets/ot_picture_uploader.eliomi b/src/widgets/ot_picture_uploader.eliomi index df129b10..8c964c05 100644 --- a/src/widgets/ot_picture_uploader.eliomi +++ b/src/widgets/ot_picture_uploader.eliomi @@ -33,10 +33,7 @@ open Js_of_ocaml type cropping = (float * float * float * float) React.S.t type 'a upload = - ?progress:(int -> int -> unit) - -> ?cropping:cropping - -> File.file Js.t - -> 'a Lwt.t + ?progress:(int -> int -> unit) -> ?cropping:cropping -> File.file Js.t -> 'a type ('a, 'b) service = ( unit @@ -89,18 +86,19 @@ val do_submit : -> ?cropping:cropping -> upload:'a upload -> unit - -> unit Lwt.t + -> unit (** [ do_submit input ?cropping ~upload () ] [input] is the input with file loaded [cropping] are cropping info - [upload] function to upload the file *) + [upload] function to upload the file. + This function waits for the submission to complete. *) val bind_submit : Dom_html.inputElement Js.t Eliom_client_value.t -> #Dom_html.eventTarget Js.t Eliom_client_value.t -> ?cropping:cropping -> upload:'a upload - -> after_submit:(unit -> unit Lwt.t) + -> after_submit:(unit -> unit) -> unit -> unit (** [ bind_submit input button ?cropping ~upload ~after_submit () ] @@ -114,7 +112,7 @@ val bind : -> ?crop:(unit -> unit) * cropping -> submit:#Dom_html.eventTarget Js.t Eliom_client_value.t -> upload:'a upload - -> after_submit:(unit -> unit Lwt.t) + -> after_submit:(unit -> unit) -> unit -> unit (** [bind] is a shortcut for [bind_input] and [bind_submit] actions *) @@ -142,7 +140,7 @@ val submit : (** Create a button with [ot-pup-sumit] clas *) val mk_form : - ?after_submit:(unit -> unit Lwt.t) + ?after_submit:(unit -> unit) -> ?crop:float option -> ?input: [< Html_types.label_attrib > `Class] Eliom_content.Html.attrib list @@ -151,7 +149,7 @@ val mk_form : [< Html_types.button_attrib > `Class] Eliom_content.Html.attrib list * [< Html_types.button_content_fun] Eliom_content.Html.elt list -> 'a upload - -> [> `Form] Eliom_content.Html.elt Lwt.t + -> [> `Form] Eliom_content.Html.elt (** Ready-to-use form. Customizable with [input], the input button content, [submit], the submit button content. If [crop] is present, cropping is enable, with the optional ratio it is. diff --git a/src/widgets/ot_popup.eliom b/src/widgets/ot_popup.eliom index f3e44ad0..ecc5d422 100644 --- a/src/widgets/ot_popup.eliom +++ b/src/widgets/ot_popup.eliom @@ -1,4 +1,3 @@ -[%%shared (* Ocsigen * http://www.ocsigen.org * @@ -19,14 +18,10 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Eliom_content.Html] - -[%%shared open Eliom_content.Html.F] - +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F open%client Js_of_ocaml -open%client Lwt.Syntax - -[%%client open Js_of_ocaml_lwt] +open%client Js_of_ocaml_eio let%shared hcf ?(a = []) ?(header = []) ?(footer = []) content = D.section @@ -72,14 +67,14 @@ let%client ?(enable_scrolling_hack = true) ?close_button ?confirmation_onclose - ?(onclose = fun () -> Lwt.return_unit) + ?(onclose = fun () -> ()) ?(close_on_background_click = false) ?(close_on_escape = close_button <> None) gen_content = let a = (a :> Html_types.div_attrib attrib list) in let gen_content = - (gen_content :> (unit -> unit Lwt.t) -> Html_types.div_content elt Lwt.t) + (gen_content :> (unit -> unit) -> Html_types.div_content elt) in let popup = ref None in let stop, stop_thread = React.E.create () in @@ -98,16 +93,13 @@ let%client let close () = match confirmation_onclose with | None -> do_close () - | Some f -> - Lwt.bind (f ()) (function - | true -> do_close () - | false -> Lwt.return_unit) + | Some f -> if f () then do_close () in (* FIXME: use a list for gen_content return type *) - let* c = + let c = Ot_spinner.with_spinner ~a:[a_class ["ot-popup-content"]] - (Lwt.map (fun x -> [x]) (gen_content do_close)) + (fun () -> [gen_content do_close]) in let content = [c] in let content = @@ -117,7 +109,7 @@ let%client ~a: [ a_button_type `Button ; a_class ["ot-popup-close"] - ; a_onclick (fun ev -> Lwt.async (fun () -> close ())) ] + ; a_onclick (fun ev -> Eliom_lib.fork (fun () -> close ())) ] but :: content | None -> content @@ -129,20 +121,20 @@ let%client then Eliom_client.Page_status.while_active ~stop (fun () -> (* Close the popup when user clicks on background *) - let* event = Lwt_js_events.click box_dom in - if event##.target = Js.some box_dom then close () else Lwt.return_unit); + let event = Eio_js_events.click box_dom in + if event##.target = Js.some box_dom then close ()); if close_on_escape then Eliom_client.Page_status.while_active ~stop (fun () -> - Lwt_js_events.keydowns Dom_html.window @@ fun ev _ -> - if ev##.keyCode = 27 then close () else Lwt.return_unit); + Eio_js_events.keydowns Dom_html.window @@ fun ev -> + if ev##.keyCode = 27 then close ()); popup := Some box; Manip.appendToBody box; - Lwt.return box + box let%client ask_question ?a ?a_hcf ~header ~buttons contents = - let t, w = Lwt.wait () in - let* _ = + let t, w = Eio.Promise.create () in + let _ = popup ?a (fun do_close -> let answers = List.map @@ -150,17 +142,16 @@ let%client ask_question ?a ?a_hcf ~header ~buttons contents = let btn = D.Raw.button ~a:[a_class btn_class] content in (* Onlick, give t the selected value and close question popup. *) - Lwt.async (fun () -> - Lwt_js_events.clicks (To_dom.of_element btn) (fun _ _ -> - let* r = action () in - let* result = do_close () in - Lwt.wakeup w r; Lwt.return result)); + Eio_js_events.clicks (To_dom.of_element btn) (fun _ -> + let r = action () in + let result = do_close () in + Eio.Promise.resolve w r; result); btn) buttons in - Lwt.return (hcf ?a:a_hcf ~header ~footer:answers contents)) + hcf ?a:a_hcf ~header ~footer:answers contents) in - t + Eio.Promise.await t let%client confirm ?(a = []) question yes no = let a = (a :> Html_types.div_attrib attrib list) in @@ -168,6 +159,6 @@ let%client confirm ?(a = []) question yes no = ~a:(a_class ["ot-popup-confirmation"] :: a) ~header:question ~buttons: - [ yes, (fun () -> Lwt.return_true), ["ot-popup-yes"] - ; no, (fun () -> Lwt.return_false), ["ot-popup-no"] ] + [ yes, (fun () -> true), ["ot-popup-yes"] + ; no, (fun () -> false), ["ot-popup-no"] ] [] diff --git a/src/widgets/ot_popup.eliomi b/src/widgets/ot_popup.eliomi index a8802974..e1222122 100644 --- a/src/widgets/ot_popup.eliomi +++ b/src/widgets/ot_popup.eliomi @@ -44,12 +44,12 @@ val popup : ?a:[< div_attrib] attrib list -> ?enable_scrolling_hack:bool -> ?close_button:button_content elt list - -> ?confirmation_onclose:(unit -> bool Lwt.t) - -> ?onclose:(unit -> unit Lwt.t) + -> ?confirmation_onclose:(unit -> bool) + -> ?onclose:(unit -> unit) -> ?close_on_background_click:bool -> ?close_on_escape:bool - -> ((unit -> unit Lwt.t) -> [< div_content] elt Lwt.t) - -> [> `Div] elt Lwt.t + -> ((unit -> unit) -> [< div_content] elt) + -> [> `Div] elt (** [ popup ?a ?enable_scrolling_hack ?close_button ?confirmation_onclose ?onclose gen_content ] Display a modal popup. @@ -81,10 +81,9 @@ val ask_question : ?a:[< div_attrib] attrib list -> ?a_hcf:[< div_attrib] attrib list -> header:[< header_content] elt list - -> buttons: - ([< button_content_fun] elt list * (unit -> 'a Lwt.t) * string list) list + -> buttons:([< button_content_fun] elt list * (unit -> 'a) * string list) list -> [< div_content] elt list - -> 'a Lwt.t + -> 'a (** [ask_question ?a ?a_hcf question buttons] Prompt a user, wait for its response and return the selected value. [question] is the content of the popup header @@ -97,7 +96,7 @@ val confirm : -> [< header_content_fun] elt list -> ([< button_content_fun] as 'a) elt list -> 'a elt list - -> bool Lwt.t + -> bool (** Shortcut using [ask_question] for prompting the user with a question and returning a boolean. [confirm ?a question yes no] diff --git a/src/widgets/ot_pulltorefresh.eliom b/src/widgets/ot_pulltorefresh.eliom index 23aaf803..a0153fed 100644 --- a/src/widgets/ot_pulltorefresh.eliom +++ b/src/widgets/ot_pulltorefresh.eliom @@ -2,8 +2,7 @@ type state = Pulling | Ready | Loading | Succeeded | Failed -[%%client open Eliom_content.Html] - +open%client Eliom_content.Html open Eliom_content.Html.D let%shared default_header = @@ -14,7 +13,8 @@ let%shared default_header = [%%client open Js_of_ocaml -open Lwt.Syntax +open Js_of_ocaml +open Js_of_ocaml_eio module type CONF = sig val dragThreshold : float @@ -22,7 +22,7 @@ module type CONF = sig val container : Html_types.div Eliom_content.Html.D.elt val set_state : ?step:React.step -> state option -> unit val timeout : float - val afterPull : unit -> bool Lwt.t + val afterPull : unit -> bool end module Make (Conf : CONF) = struct @@ -43,18 +43,17 @@ module Make (Conf : CONF) = struct let _, y = Dom_html.getDocumentScroll () in if y > 0. then top := false else top := true - let touchstart_handler ev _ = + let touchstart_handler ev = Dom_html.stopPropagation ev; - (if !refreshFlag || !joinRefreshFlag - then Dom.preventDefault ev - else - let touch = ev##.changedTouches##item 0 in - Js.Optdef.iter touch (fun touch -> - dragStart := Js.to_float touch##.clientY; - scrollXStart := Js.to_float touch##.clientX); - first_move := true; - Manip.Class.remove container "ot-pull-refresh-transition-on"); - Lwt.return_unit + if !refreshFlag || !joinRefreshFlag + then Dom.preventDefault ev + else + let touch = ev##.changedTouches##item 0 in + Js.Optdef.iter touch (fun touch -> + dragStart := Js.to_float touch##.clientY; + scrollXStart := Js.to_float touch##.clientX); + first_move := true; + Manip.Class.remove container "ot-pull-refresh-transition-on" let touchmove_handler_ ev = Dom.preventDefault ev; @@ -66,7 +65,7 @@ module Make (Conf : CONF) = struct js_container##.style##.transform := Js.string ("translateY(" ^ string_of_float translateY ^ "px)") - let touchmove_handler ev _ = + let touchmove_handler ev = scroll_handler (); if not !scrollingX then ( @@ -91,8 +90,7 @@ module Make (Conf : CONF) = struct if !top && !distance > 0. && not !scrollingX then touchmove_handler_ ev else joinRefreshFlag := false)); - first_move := false; - Lwt.return_unit + first_move := false let refresh () = Conf.set_state @@ Some Loading; @@ -101,12 +99,13 @@ module Make (Conf : CONF) = struct := Js.string ("translateY(" ^ (string_of_float @@ Conf.dragThreshold) ^ "px)"); refreshFlag := true; - Lwt.async (fun () -> - let* b = - Lwt.pick - [ Conf.afterPull () - ; (let* () = Js_of_ocaml_lwt.Lwt_js.sleep Conf.timeout in - Lwt.return_false) ] + Eliom_lib.fork (fun () -> + let b = + Eio.Fiber.any + [ Conf.afterPull + ; (fun () -> + Js_of_ocaml_eio.Eio_js.sleep Conf.timeout; + false) ] in if b then @@ -127,8 +126,7 @@ module Make (Conf : CONF) = struct ignore (Dom_html.window##setTimeout (Js.wrap_callback (fun () -> refreshFlag := false)) - (Js.float 500.))); - Lwt.return_unit) + (Js.float 500.)))) let scroll_back () = Conf.set_state None; @@ -142,7 +140,7 @@ module Make (Conf : CONF) = struct (Js.wrap_callback (fun () -> refreshFlag := false)) (Js.float 500.))) - let touchend_handler ev _ = + let touchend_handler ev = if !top && !distance > 0. && !dragStart >= 0. then if !refreshFlag @@ -156,15 +154,14 @@ module Make (Conf : CONF) = struct dragStart := -1.; distance := 0.); scrollXStart := -1.; - scrollingX := false; - Lwt.return_unit + scrollingX := false let init () = - let open Js_of_ocaml_lwt.Lwt_js_events in - Lwt.async (fun () -> touchstarts js_container touchstart_handler); - Lwt.async (fun () -> touchmoves js_container touchmove_handler); - Lwt.async (fun () -> touchends js_container touchend_handler); - Lwt.async (fun () -> touchcancels js_container touchend_handler) + let open Js_of_ocaml_eio.Eio_js_events in + Eio_js.start (fun () -> touchstarts js_container touchstart_handler); + Eio_js.start (fun () -> touchmoves js_container touchmove_handler); + Eio_js.start (fun () -> touchends js_container touchend_handler); + Eio_js.start (fun () -> touchcancels js_container touchend_handler) end] let make @@ -175,7 +172,7 @@ let make ?(refresh_timeout = 20.) ?(header = [%shared default_header]) ~content - (afterPull : (unit -> bool Lwt.t) Eliom_client_value.t) + (afterPull : (unit -> bool) Eliom_client_value.t) = if app_only && not (Eliom_client.is_client_app ()) then div ~a [content] diff --git a/src/widgets/ot_pulltorefresh.eliomi b/src/widgets/ot_pulltorefresh.eliomi index c45d0054..fb64e4bf 100644 --- a/src/widgets/ot_pulltorefresh.eliomi +++ b/src/widgets/ot_pulltorefresh.eliomi @@ -25,7 +25,7 @@ val make : list) Eliom_shared.Value.t -> content:'a Eliom_content.Html.elt - -> (unit -> bool Lwt.t) Eliom_client_value.t + -> (unit -> bool) Eliom_client_value.t -> 'a Eliom_content.Html.elt (** Creates a pull-to-refresh container from an html element. diff --git a/src/widgets/ot_size.eliom b/src/widgets/ot_size.eliom index 93c9fdeb..7b9ee80c 100644 --- a/src/widgets/ot_size.eliom +++ b/src/widgets/ot_size.eliom @@ -22,7 +22,7 @@ [%%client.start] open Js_of_ocaml -open Js_of_ocaml_lwt +open Js_of_ocaml_eio (* size and orientation *) type orientation = Portrait | Landscape @@ -56,9 +56,9 @@ let update_width_height () = let width_height, width, height = (* TODO: MutationObserver? *) - (let open Lwt_js_events in + (let open Eio_js_events in async @@ fun () -> - onresizes @@ fun _ _ -> Lwt.return @@ update_width_height ()); + onresizes @@ fun _ -> update_width_height ()); let w = React.S.l1 fst wh in let h = React.S.l1 snd wh in (* Make sure the signals are not destroyed indirectly diff --git a/src/widgets/ot_spinner.eliom b/src/widgets/ot_spinner.eliom index 89aace98..2705e2d8 100644 --- a/src/widgets/ot_spinner.eliom +++ b/src/widgets/ot_spinner.eliom @@ -20,11 +20,9 @@ *) open%client Js_of_ocaml - -[%%shared open Eliom_content.Html] -[%%shared open Lwt.Syntax] -[%%shared open Eliom_content.Html.F] -[%%client open Eliom_shared] +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F +open%client Eliom_shared let%shared default_fail_fun e = [ (if Eliom_config.get_debugmode () @@ -54,129 +52,91 @@ let%client set_default_fail f = : exn -> [< Html_types.div_content] Eliom_content.Html.elt list :> exn -> Html_types.div_content Eliom_content.Html.elt list) -let%server with_spinner ?(a = []) ?spinner:_ ?fail thread = +let%server with_spinner ?(a = []) ?spinner:_ ?fail gen = let a = (a :> Html_types.div_attrib attrib list) in let fail = ((match fail with - | Some fail -> (fail :> exn -> Html_types.div_content elt list Lwt.t) - | None -> fun e -> Lwt.return (default_fail e)) - :> exn -> Html_types.div_content elt list Lwt.t) + | Some fail -> (fail :> exn -> Html_types.div_content elt list) + | None -> fun e -> default_fail e) + :> exn -> Html_types.div_content elt list) in - let* v = - Lwt.catch - (fun () -> - let* v = thread in - Lwt.return (v :> Html_types.div_content_fun F.elt list)) - (fun e -> - let* v = fail e in - Lwt.return (v :> Html_types.div_content_fun F.elt list)) + let v = + try (gen () :> Html_types.div_content_fun F.elt list) + with e -> (fail e :> Html_types.div_content_fun F.elt list) in - Lwt.return (D.div ~a:(a_class ["ot-spinner"] :: a) v) + D.div ~a:(a_class ["ot-spinner"] :: a) v -[%%client -let num_active_spinners, set_num_active_spinners = React.S.create 0 -let onloaded, set_onloaded = React.E.create () +let%client num_active_spinners, set_num_active_spinners = React.S.create 0 +let%client onloaded, set_onloaded = React.E.create () (* Make sure the signal is not destroyed indirectly by a call to React.E.stop *) -let _ = ignore (React.E.map (fun _ -> ()) onloaded) +let%client _ = ignore (React.E.map (fun _ -> ()) onloaded) -let _ = +let%client _ = Ot_lib.onloads @@ fun () -> if React.S.value num_active_spinners = 0 then set_onloaded () -let inc_active_spinners () = +let%client inc_active_spinners () = set_num_active_spinners @@ (React.S.value num_active_spinners + 1) -let dec_active_spinners () = +let%client dec_active_spinners () = set_num_active_spinners @@ (React.S.value num_active_spinners - 1); if React.S.value num_active_spinners = 0 then set_onloaded () -let cl_spinning = "ot-icon-animation-spinning" -let cl_spinner = "ot-icon-spinner" +let%client cl_spinning = "ot-icon-animation-spinning" +let%client cl_spinner = "ot-icon-spinner" -let replace_content ?fail elt thread = +let%client replace_content ?fail elt gen = let fail = match fail with | Some fail -> (fail - : exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t - :> exn -> Html_types.div_content Eliom_content.Html.elt list Lwt.t) - | None -> fun e -> Lwt.return (default_fail e) + : exn -> [< Html_types.div_content] Eliom_content.Html.elt list + :> exn -> Html_types.div_content Eliom_content.Html.elt list) + | None -> fun e -> default_fail e in inc_active_spinners (); Manip.replaceChildren elt []; Manip.Class.add elt cl_spinning; Manip.Class.add elt cl_spinner; - let* new_content = Lwt.catch (fun () -> thread) (fun e -> fail e) in + let new_content = try gen () with e -> fail e in Manip.replaceChildren elt new_content; Manip.Class.remove elt cl_spinning; Manip.Class.remove elt cl_spinner; - dec_active_spinners (); - Lwt.return_unit - -module Make (A : sig - type +'a t + dec_active_spinners () - val bind : 'a t -> ('a -> 'b t) -> 'b t - val bind2 : 'a t -> ('a -> 'b Lwt.t) -> 'b Lwt.t - val return : 'a -> 'a t - end) = -struct - let with_spinner ?(a = []) ?spinner ?fail thread = - let a = (a :> Html_types.div_attrib attrib list) in - let fail = - match fail with - | Some fail -> - (fail - : exn -> [< Html_types.div_content] elt list A.t - :> exn -> Html_types.div_content elt list A.t) - | None -> fun e -> A.return (default_fail e) +let%client with_spinner ?(a = []) ?spinner ?fail gen = + let a = (a :> Html_types.div_attrib attrib list) in + let fail = + match fail with + | Some fail -> + (fail + : exn -> [< Html_types.div_content] elt list + :> exn -> Html_types.div_content elt list) + | None -> fun e -> default_fail e + in + let prom, prom_resolver = Eio.Promise.create () in + Eliom_lib.fork (fun () -> + let v = + try (gen () :> Html_types.div_content_fun F.elt list) + with e -> (fail e :> Html_types.div_content_fun F.elt list) in - match Lwt.state thread with - | Lwt.Return v -> A.return (D.div ~a:(a_class ["ot-spinner"] :: a) v) - | Lwt.Sleep -> - inc_active_spinners (); - let cl = ["ot-spinner"] in - let cl = - if spinner = None then cl_spinner :: cl_spinning :: cl else cl - in - let d = - D.div ~a:(a_class cl :: a) - (match spinner with None -> [] | Some s -> s) - in - Lwt.async (fun () -> - let* v = - Lwt.catch - (fun () -> - let* v = thread in - Lwt.return (v :> Html_types.div_content_fun F.elt list)) - (fun e -> - A.bind2 (fail e) (fun v -> - Lwt.return (v :> Html_types.div_content_fun F.elt list))) - in - Manip.replaceChildren d v; - Manip.Class.remove d cl_spinning; - Manip.Class.remove d cl_spinner; - dec_active_spinners (); - Lwt.return_unit); - A.return d - | Lwt.Fail e -> A.bind (fail e) (fun c -> A.return (D.div ~a c)) -end - -module N = Make (struct - type +'a t = 'a - - let bind a f = f a - let bind2 a f = f a - let return a = a - end) - -module L = Make (struct - include Lwt - - let bind2 = bind - end) - -let with_spinner_no_lwt = N.with_spinner -let with_spinner = L.with_spinner] + Eio.Promise.resolve prom_resolver v); + match Eio.Promise.peek prom with + | Some v -> D.div ~a:(a_class ["ot-spinner"] :: a) v + | None -> + inc_active_spinners (); + let cl = ["ot-spinner"] in + let cl = if spinner = None then cl_spinner :: cl_spinning :: cl else cl in + let d = + D.div ~a:(a_class cl :: a) + (match spinner with None -> [] | Some s -> s) + in + Eliom_lib.fork (fun () -> + let v = Eio.Promise.await prom in + Manip.replaceChildren d v; + Manip.Class.remove d cl_spinning; + Manip.Class.remove d cl_spinner; + dec_active_spinners ()); + d diff --git a/src/widgets/ot_spinner.eliomi b/src/widgets/ot_spinner.eliomi index c8fb10da..ad437bfa 100644 --- a/src/widgets/ot_spinner.eliomi +++ b/src/widgets/ot_spinner.eliomi @@ -26,18 +26,18 @@ val with_spinner : ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list -> ?spinner:[< Html_types.div_content] Eliom_content.Html.elt list - -> ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t) - -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t - -> [> `Div] Eliom_content.Html.elt Lwt.t -(** On client side, [with_spinner th] returns immediately a spinner - while Lwt thread [th] is not finished, that will automatically - be replaced by the result of [th] when finished. + -> ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list) + -> (unit -> [< Html_types.div_content] Eliom_content.Html.elt list) + -> [> `Div] Eliom_content.Html.elt +(** On client side, [with_spinner f] returns immediately a spinner + while function [f] has not returned, that will automatically + be replaced by the result of [f] when finished. - On server side, it will wait for [th] to be finished before + On server side, it will wait for [f] to be finished before returning its result (and never display a spinner). - If you want the spinner on both sides, you can use [with_spinner_no_lwt] - and [Eliom_content.Html.C.node]. + If you want the spinner on both sides, you can use it from a + client-side node ([Eliom_content.Html.C.node]). Function [fail] will be used to display block in case an exception is raised. @@ -50,24 +50,14 @@ val with_spinner : [%%client.start] -val with_spinner_no_lwt : - ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list - -> ?spinner:[< Html_types.div_content] Eliom_content.Html.elt list - -> ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list) - -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t - -> [> `Div] Eliom_content.Html.elt -(** Same as [with_spinner] but returns immediately. - Client only (as we must wait for the thread to terminate on server - before sending the page). *) - val replace_content : - ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t) + ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list) -> 'a Eliom_content.Html.elt - -> Html_types.div_content Eliom_content.Html.elt list Lwt.t - -> unit Lwt.t -(** [replace_content elt thread] replaces the contents of [elt] by the content - generated by [thread]. The [elt] has be a D-node. Until [thread] is - finished [elt] is transformed into a spinner. *) + -> (unit -> Html_types.div_content Eliom_content.Html.elt list) + -> unit +(** [replace_content elt promise] replaces the contents of [elt] by the content + generated by [promise]. The [elt] has be a D-node. Until [promise] is + resolved, [elt] is transformed into a spinner. *) val num_active_spinners : int Eliom_shared.React.S.t (** the number of spinners currently spinning *) diff --git a/src/widgets/ot_sticky.eliom b/src/widgets/ot_sticky.eliom index 64ac065c..b4177f22 100644 --- a/src/widgets/ot_sticky.eliom +++ b/src/widgets/ot_sticky.eliom @@ -3,8 +3,7 @@ open Eliom_content.Html open Html_types open Js_of_ocaml -open Js_of_ocaml_lwt -open Lwt.Syntax +open Js_of_ocaml_eio (* This is about the real "position: sticky" *) @@ -55,8 +54,8 @@ type glue = ; inline : div_content D.elt ; dir : [`Top | `Left] ; (*TODO: support `Bottom and `Right*) - scroll_thread : unit Lwt.t - ; resize_thread : (int * int) React.S.t + cancel_scroll : unit -> unit + ; resize_signal : (int * int) React.S.t ; dissolve : unit -> unit } let move_content ~from to_elt = @@ -125,9 +124,9 @@ let make_sticky ?(force = false) elt = - let* () = Ot_nodeready.nodeready (To_dom.of_element elt) in + Ot_nodeready.nodeready (To_dom.of_element elt); if (not force) && supports_position_sticky elt - then Lwt.return_none + then None else let fixed_dom = Js.Opt.case @@ -137,16 +136,16 @@ let make_sticky in let fixed = Of_dom.of_element @@ Dom_html.element fixed_dom in Manip.insertBefore ~before:elt fixed; - let* () = Ot_nodeready.nodeready fixed_dom in + Ot_nodeready.nodeready fixed_dom; Manip.Class.add fixed "ot-sticky-fixed"; Manip.Class.add elt "ot-sticky-inline"; let glue = { fixed ; inline = elt ; dir - ; scroll_thread = Lwt.return_unit + ; cancel_scroll = (fun () -> ()) ; (* updated below *) - resize_thread = React.S.const (0, 0) + resize_signal = React.S.const (0, 0) ; (* updated below *) dissolve = (fun () -> failwith "undefined") } in @@ -154,41 +153,41 @@ let make_sticky unstick ~force:true glue; synchronise glue; update_state glue in init (); - let onloaded_thread = Ot_spinner.onloaded |> React.E.map init in + let onloaded_event = Ot_spinner.onloaded |> React.E.map init in Eliom_lib.Dom_reference.retain (To_dom.of_element fixed) - ~keep:onloaded_thread; - let scroll_thread = - Ot_lib.window_scrolls ~ios_html_scroll_hack @@ fun _ _ -> - update_state glue; Lwt.return_unit - in - let resize_thread = + ~keep:onloaded_event; + Eio.Switch.run @@ fun sw -> + Eio.Fiber.fork ~sw (fun () -> + Ot_lib.window_scrolls ~ios_html_scroll_hack @@ fun _ -> update_state glue); + let cancel_scroll () = Eio.Switch.fail sw Eio_js_events.Cancelled in + let resize_signal = Ot_size.width_height |> React.S.map @@ fun (width, height) -> synchronise glue; update_state glue; width, height in - Eliom_lib.Dom_reference.retain (To_dom.of_element fixed) ~keep:resize_thread; + Eliom_lib.Dom_reference.retain (To_dom.of_element fixed) ~keep:resize_signal; let dissolve () = - Lwt.cancel scroll_thread; - React.S.stop resize_thread; - React.E.stop onloaded_thread; + cancel_scroll (); + React.S.stop resize_signal; + React.E.stop onloaded_event; unstick ~force:true glue; Manip.removeSelf glue.fixed; Manip.Class.remove glue.inline "ot-sticky-inline" in Eliom_client.onunload (fun () -> dissolve ()); - Lwt.return_some {glue with scroll_thread; resize_thread; dissolve} + Some {glue with cancel_scroll; resize_signal; dissolve} (* This is about functionality built on top of position:sticky / the polyfill *) (* TODO: ensure compatibility with DOM caching *) let keep_in_sight ~dir ?ios_html_scroll_hack elt = - let* () = Ot_nodeready.nodeready (To_dom.of_element elt) in - let* glue = make_sticky ?ios_html_scroll_hack ~dir elt in + Ot_nodeready.nodeready (To_dom.of_element elt); + let glue = make_sticky ?ios_html_scroll_hack ~dir elt in let elt = match glue with None -> elt | Some g -> g.fixed in match Manip.parentNode elt with - | None -> Lwt.return (fun () -> ()) + | None -> fun () -> () | Some parent -> - let* () = Ot_nodeready.nodeready (To_dom.of_element parent) in + Ot_nodeready.nodeready (To_dom.of_element parent); let compute_top_left (_, win_height) = match dir with | `Top -> @@ -205,30 +204,28 @@ let keep_in_sight ~dir ?ios_html_scroll_hack elt = failwith "Ot_sticky.keep_in_sight only supports ~dir:`Top right now." in - let resize_thread = + let resize_signal = React.S.map compute_top_left @@ match glue with | None -> Ot_size.width_height - | Some glue -> glue.resize_thread + | Some glue -> glue.resize_signal in - Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:resize_thread; + Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:resize_signal; let init () = let doIt () = compute_top_left @@ React.S.value Ot_size.width_height in (* the additional initialisation after some delay is due to the inexplicable behaviour on Chrome where the initialisation happens too early. *) - Lwt.async (fun () -> - let* _ = Lwt_js.sleep 0.5 in - Lwt.return @@ doIt ()); + Eliom_lib.fork (fun () -> Eio_js.sleep 0.5; doIt ()); doIt () in init (); - let onload_thread = React.E.map init Ot_spinner.onloaded in - Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:onload_thread; + let onload_event = React.E.map init Ot_spinner.onloaded in + Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:onload_event; let stop () = - React.E.stop onload_thread; - React.S.stop resize_thread; + React.E.stop onload_event; + React.S.stop resize_signal; match glue with Some g -> g.dissolve () | None -> () in Eliom_client.onunload (fun () -> stop ()); - Lwt.return stop + stop diff --git a/src/widgets/ot_sticky.eliomi b/src/widgets/ot_sticky.eliomi index 0eacab7d..a921cd64 100644 --- a/src/widgets/ot_sticky.eliomi +++ b/src/widgets/ot_sticky.eliomi @@ -20,8 +20,8 @@ type glue = { fixed : div_content D.elt ; inline : div_content D.elt ; dir : [`Top | `Left] - ; scroll_thread : unit Lwt.t - ; resize_thread : (int * int) React.S.t + ; cancel_scroll : unit -> unit + ; resize_signal : (int * int) React.S.t ; dissolve : unit -> unit } (** returned by [make sticky] (if position:sticky is not supported). You only need this value if you want to manipulate the stickiness later (as @@ -29,10 +29,13 @@ type glue = [fixed]: element cloned from the element supplied to [make_sticky]; [inline]: original element supplied to [make_sticky]; [dir]: see [make_sticky]; - [scroll_thread]: thread that makes either [fixed] or [inline] visible, - depending on the scroll position; - [resize_thread]: thread that resizes the fixed element according to the - inline element on window resize; + [cancel_scroll]: function to be called to cancel the scroll + [scroll_promise]: promise that will be resolved when scroll is finished + (with either [fixed] or [inline] visible, + depending on the scroll position); + [resize_signal]: React signal updated with the size of fixed element + recomputed according to the + inline element on window resize; [dissolve]: undo [make_sticky] i.e. kill [scroll_thread] and [resize_thread] and remove [fixed] from the DOM tree. *) @@ -42,7 +45,7 @@ val make_sticky : -> ?ios_html_scroll_hack:bool -> ?force:bool -> div_content elt - -> glue option Lwt.t + -> glue option (** position:sticky polyfill which is not supported by some browsers. It functions by making a clone with position:fixed of the designated element and continuously (window scroll/resize) monitoring the @@ -54,6 +57,8 @@ val make_sticky : [dir] determines whether it sticks to the top on vertical scroll or the the left on horizontal scroll. + The function will wait until the node is ready is the page before starting. + NOTE: Do not forget to include the CSS attributes as defined in the file css/ot_sticky.css. @@ -67,7 +72,8 @@ val keep_in_sight : dir:[`Left | `Top] -> ?ios_html_scroll_hack:bool -> div_content elt - -> (unit -> unit) Lwt.t + -> unit + -> unit (** make sure an element gets never out of sight while scrolling by continuously (window scroll/resize) monitoring the position of the element and adjusting the top/left value. Calls @@ -78,4 +84,8 @@ val keep_in_sight : div. (It has to be the parent and not the element itself because when the element floats (is in its fixed state) we can't use its position for computing the right values. Returns a function by - which the [keep_in_sight] functionality can be stopped. *) + which the [keep_in_sight] functionality can be stopped. + + The function will wait until the node is ready is the page before starting. + + *) diff --git a/src/widgets/ot_swipe.eliom b/src/widgets/ot_swipe.eliom index d17f739f..e930addb 100644 --- a/src/widgets/ot_swipe.eliom +++ b/src/widgets/ot_swipe.eliom @@ -1,12 +1,9 @@ (** Swiping an element *) -[%%shared open Js_of_ocaml] -[%%client open Js_of_ocaml_lwt] - +open%shared Js_of_ocaml +open%client Js_of_ocaml_eio open%client Eliom_content.Html -open%client Lwt.Syntax - -[%%shared open Eliom_content.Html.F] +open%shared Eliom_content.Html.F (** sensibility for detecting swipe left/right or up/down *) @@ -122,28 +119,25 @@ let%shared (* position when touch starts *) in let status = ref Stopped in - let onpanend ev aa = + let onpanend ev = if !status <> Start then ( add_transition ~%transition_duration elt'; let left = ~%compute_final_pos ev (truncate (clX ev -. !startx)) in elt'##.style##.left := px_of_int left; Eliom_lib.Option.iter (fun f -> f ev left) ~%onend; - Lwt.async (fun () -> - let* _ = Lwt_js_events.transitionend elt' in - Manip.Class.remove elt "ot-swiping"; - Lwt.return_unit)); - status := Stopped; - Lwt.return_unit + Eliom_lib.fork (fun () -> + ignore @@ Eio_js_events.transitionend elt'; + Manip.Class.remove elt "ot-swiping")); + status := Stopped in let onpanstart0 () = status := Start in - let onpanstart ev _ = + let onpanstart ev = startx := clX ev -. float elt'##.offsetLeft; starty := clY ev; - onpanstart0 (); - Lwt.return_unit + onpanstart0 () in - let onpan ev aa = + let onpan ev = let left = clX ev -. !startx in let do_pan left = elt'##.style##.left := px_of_int left in if !status = Start @@ -176,9 +170,8 @@ let%shared (* We send a touchstart event to the parent *) dispatch_event ~ev elt' "touchstart" (float min +. !startx) - (clY ev); + (clY ev) (* We propagate *) - Lwt.return_unit | _, Some max when left > float max -> (* max reached. We stop the movement of this element @@ -189,15 +182,13 @@ let%shared (* We send a touchstart event to the parent *) dispatch_event ~ev elt' "touchstart" (float max +. !startx) - (clY ev); + (clY ev) (* We propagate *) - Lwt.return_unit | _ -> Dom_html.stopPropagation ev; Dom.preventDefault ev; Eliom_lib.Option.iter (fun f -> f ev (truncate left)) ~%onmove; - do_pan (int_of_float (left +. 0.5)); - Lwt.return_unit) + do_pan (int_of_float (left +. 0.5))) else (* Shall we restart swiping this element? *) let restart_pos = @@ -217,12 +208,11 @@ let%shared (clY ev); onpanstart0 ( (* restart_pos + !startx *) ); Dom_html.stopPropagation ev; - do_pan (int_of_float (left +. 0.5)); - Lwt.return_unit - | None -> (* We propagate *) Lwt.return_unit + do_pan (int_of_float (left +. 0.5)) + | None -> (* We propagate *) () in - Lwt.async (fun () -> Lwt_js_events.touchstarts elt' onpanstart); - Lwt.async (fun () -> Lwt_js_events.touchmoves elt' onpan); - Lwt.async (fun () -> Lwt_js_events.touchends elt' onpanend); - Lwt.async (fun () -> Lwt_js_events.touchcancels elt' onpanend) + Eio_js.start (fun () -> Eio_js_events.touchstarts elt' onpanstart); + Eio_js.start (fun () -> Eio_js_events.touchmoves elt' onpan); + Eio_js.start (fun () -> Eio_js_events.touchends elt' onpanend); + Eio_js.start (fun () -> Eio_js_events.touchcancels elt' onpanend) : unit)] diff --git a/src/widgets/ot_time_picker.eliom b/src/widgets/ot_time_picker.eliom index a7f3f25f..0659e12e 100644 --- a/src/widgets/ot_time_picker.eliom +++ b/src/widgets/ot_time_picker.eliom @@ -23,8 +23,7 @@ open Eliom_shared.React.S.Infix open Eliom_content.Html open%client Js_of_ocaml - -[%%client open Js_of_ocaml_lwt] +open%client Js_of_ocaml_eio type 'a rf = ?step:React.step -> 'a -> unit @@ -272,15 +271,12 @@ let clock_html_wrap ?(classes = []) s (f : (int * bool) rf Eliom_client_value.t) let _ = [%client (let e = Eliom_content.Html.To_dom.of_element ~%e in - ( Lwt.async @@ fun () -> - Lwt_js_events.touchends e @@ fun ev _ -> - Lwt.return (wrap_touch ~ends:true ev ~%f) ); - ( Lwt.async @@ fun () -> - Lwt_js_events.touchcancels e @@ fun ev _ -> - Lwt.return (wrap_touch ~ends:true ev ~%f) ); - Lwt.async @@ fun () -> - Lwt_js_events.touchmoves e @@ fun ev _ -> - Lwt.return (wrap_touch ~ends:false ev ~%f) + Eio_js.start (fun () -> + Eio_js_events.touchends e @@ fun ev -> wrap_touch ~ends:true ev ~%f); + Eio_js.start (fun () -> + Eio_js_events.touchcancels e @@ fun ev -> wrap_touch ~ends:true ev ~%f); + Eio_js.start (fun () -> + Eio_js_events.touchmoves e @@ fun ev -> wrap_touch ~ends:false ev ~%f) : unit)] in e @@ -314,14 +310,12 @@ let clock_html_wrap_24h ?(classes = []) s f_e f_b = wrap_touch_24h ~ends ev (~%f_e ~step) f_b; React.Step.execute step and e = Eliom_content.Html.To_dom.of_element ~%e in - ( Lwt.async @@ fun () -> - Lwt_js_events.touchends e @@ fun ev _ -> Lwt.return (f ~ends:true ev) - ); - ( Lwt.async @@ fun () -> - Lwt_js_events.touchcancels e @@ fun ev _ -> - Lwt.return (f ~ends:true ev) ); - Lwt.async @@ fun () -> - Lwt_js_events.touchmoves e @@ fun ev _ -> Lwt.return (f ~ends:false ev) + Eio_js.start (fun () -> + Eio_js_events.touchends e @@ fun ev -> f ~ends:true ev); + Eio_js.start (fun () -> + Eio_js_events.touchcancels e @@ fun ev -> f ~ends:true ev); + Eio_js.start (fun () -> + Eio_js_events.touchmoves e @@ fun ev -> f ~ends:false ev) : unit)]; e @@ -381,7 +375,7 @@ let display_hours_minutes_seq ?h24 f = Eliom_shared.React.S.l2 [%shared display_hours_minutes_seq ?h24:~%h24 ~%f] let show_minutes_aux - ?(action : (int * int -> unit Lwt.t) Eliom_client_value.t option) + ?(action : (int * int -> unit) Eliom_client_value.t option) e_m hm f_e_m @@ -394,7 +388,7 @@ let show_minutes_aux match ~%action with | Some action -> let v = React.S.value ~%hm in - Lwt.async (fun () -> action v) + Eliom_lib.fork (fun () -> action v) | None -> () : (int * bool) rf)] @@ -407,7 +401,7 @@ let get_angle_signal ?round = | _, _ -> e] let make_hours_minutes_seq_24h - ?(action : (int * int -> unit Lwt.t) Eliom_client_value.t option) + ?(action : (int * int -> unit) Eliom_client_value.t option) ?(init = 0, 0) ?(update : (int * int) React.E.t Eliom_client_value.t option) ?round_5 diff --git a/src/widgets/ot_time_picker.eliomi b/src/widgets/ot_time_picker.eliomi index 09c56569..f7bfb804 100644 --- a/src/widgets/ot_time_picker.eliomi +++ b/src/widgets/ot_time_picker.eliomi @@ -23,7 +23,7 @@ (** This module implements a clock-style time picker. *) val make : - ?action:(int * int -> unit Lwt.t) Eliom_client_value.t + ?action:(int * int -> unit) Eliom_client_value.t -> ?init:int * int -> ?update:(int * int) React.E.t Eliom_client_value.t -> ?round_5:bool @@ -56,7 +56,7 @@ val make : is a function that can be called to go back to hours selection. *) val make_hours_minutes_seq : - ?action:(int * int -> unit Lwt.t) Eliom_client_value.t + ?action:(int * int -> unit) Eliom_client_value.t -> ?init:int * int -> ?update:(int * int) React.E.t Eliom_client_value.t -> ?round_5:bool diff --git a/src/widgets/ot_tip.eliom b/src/widgets/ot_tip.eliom index 2db080c5..8245b4de 100644 --- a/src/widgets/ot_tip.eliom +++ b/src/widgets/ot_tip.eliom @@ -1,4 +1,3 @@ -[%%client (* Ocsigen Toolkit * http://www.ocsigen.org/ocsigen-toolkit * @@ -19,10 +18,10 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Js_of_ocaml] - -[%%client open Eliom_content.Html] -[%%client open Eliom_content.Html.F] +open%client Js_of_ocaml +open%client Js_of_ocaml_eio +open%client Eliom_content.Html +open%client Eliom_content.Html.F let%client display @@ -59,9 +58,11 @@ let%client let o_width = o_right -. o_left in let o_center_to_left = (o_right +. o_left) /. 2. in let o_center_to_right = d_width -. o_center_to_left in - let container_ready = Ot_nodeready.nodeready container_elt in + let container_ready () = Ot_nodeready.nodeready container_elt in let when_container_ready get_from_container use_it = - Lwt.(async @@ fun () -> container_ready >|= get_from_container >|= use_it) + Eio_js.start @@ fun () -> + container_ready (); + use_it (get_from_container ()) in let get_c_height () = float container_elt##.offsetHeight in let get_half_c_width () = float (container_elt##.offsetWidth / 2) in diff --git a/src/widgets/ot_tongue.eliom b/src/widgets/ot_tongue.eliom index 29b9d21a..a01bee4a 100644 --- a/src/widgets/ot_tongue.eliom +++ b/src/widgets/ot_tongue.eliom @@ -1,12 +1,7 @@ -[%%shared -open Eliom_content.Html -open Eliom_content.Html.F] - -[%%client -open Lwt.Infix -open Lwt.Syntax -open Js_of_ocaml -open Js_of_ocaml_lwt] +open%shared Eliom_content.Html +open%shared Eliom_content.Html.F +open%client Js_of_ocaml +open%client Js_of_ocaml_eio let%client inertia_parameter1 = 0.1 @@ -203,7 +198,7 @@ let%client stop_before ~speed ~maxsize size stops = let%client disable_transition elt = Manip.Class.add elt "notransition"; - Lwt_js_events.request_animation_frame () + Eio_js_events.request_animation_frame () let%client enable_transition ?duration elt = (match duration with @@ -213,7 +208,7 @@ let%client enable_transition ?duration elt = (Js.Unsafe.coerce elt'##.style)##.transitionDuration := Js.string (Printf.sprintf "%.2fs" duration)); Manip.Class.remove elt "notransition"; - Lwt_js_events.request_animation_frame () + Eio_js_events.request_animation_frame () let%client bind @@ -227,7 +222,7 @@ let%client set_swipe_pos elt = - let open Lwt_js_events in + let open Eio_js_events in let elt' = To_dom.of_element elt in let defaultduration = (Js.Unsafe.coerce elt'##.style)##.transitionDuration in let handle' = To_dom.of_element handle in @@ -253,21 +248,14 @@ let%client then None else Some Float.(pow (inertia_parameter2 *. abs speed) inertia_parameter3) in - let* () = enable_transition ?duration elt in + enable_transition ?duration elt; elt'##.style##.transform := make_stop elt side stop; set_before_signal stop; - Lwt.async (fun () -> - let* () = - if stop <> previousstop - then - let* _ = Lwt_js_events.transitionend elt' in - Lwt.return_unit - else Lwt.return_unit - in - set_after_signal stop; Lwt.return_unit); - Lwt.return_unit + Eliom_lib.fork (fun () -> + if stop <> previousstop then ignore @@ Eio_js_events.transitionend elt'; + set_after_signal stop) in - Lwt.async (fun () -> + Eliom_lib.fork (fun () -> (* Initialize size *) let maxsize = full_size elt vert in let px = px_of_simple_stop vert elt init in @@ -315,7 +303,7 @@ let%client | `Left -> pxl pos | `Right -> pxr pos in - let ontouchmove ev _ = + let ontouchmove ev = let pos = cl ev in if pos <> !currentpos then ( @@ -329,13 +317,12 @@ let%client if not !animation_frame_requested then ( animation_frame_requested := true; - let* () = Lwt_js_events.request_animation_frame () in + Eio_js_events.request_animation_frame (); animation_frame_requested := false; let d = sign *. (!startpos -. !currentpos) in let maxsize = full_size elt vert in let size = min (truncate (!startsize +. d)) maxsize in - set_swipe_pos size; set_tongue_position size; Lwt.return_unit) - else Lwt.return_unit + set_swipe_pos size; set_tongue_position size) in let ontouchend ev = let pos = pos ev in @@ -351,7 +338,7 @@ let%client in set speed (!currentstop, true) in - let ontouchstart ev _ = + let ontouchstart ev = startpos := cl ev; currentpos := !startpos; previouspos := !startpos; @@ -360,14 +347,14 @@ let%client (* To allow the user to stop the transition at the current position *) (* FIXME: This doesn't work too well when an adress bar appears while swiping *) set_tongue_position (truncate !startsize); - let a = touchmoves elt' ontouchmove in - let b = touchend elt' >>= ontouchend in - let c = touchcancel elt' >>= ontouchcancel in - let* () = disable_transition elt in + let a () = touchmoves elt' ontouchmove in + let b () = ontouchend @@ touchend elt' in + let c () = ontouchcancel @@ touchcancel elt' in + disable_transition elt; (Js.Unsafe.coerce elt'##.style)##.transitionDuration := defaultduration; - Lwt.pick [a; b; c] + Eio.Fiber.any [a; b; c] in - Lwt.async (fun () -> touchstarts handle' ontouchstart); + ignore @@ touchstarts handle' ontouchstart; match update with | Some update -> Eliom_lib.Dom_reference.retain elt' @@ -407,12 +394,11 @@ let%shared in ignore [%client - (Lwt.async (fun () -> - let* () = Ot_nodeready.nodeready (To_dom.of_element ~%elt) in + (Eliom_lib.fork (fun () -> + Ot_nodeready.nodeready (To_dom.of_element ~%elt); bind ~%side ~%stops ~%init ~%handle ~%(update : simple_stop React.E.t Eliom_client_value.t option) - (snd ~%before_signal) (snd ~%after_signal) (snd ~%swipe_pos) ~%elt; - Lwt.return_unit) + (snd ~%before_signal) (snd ~%after_signal) (snd ~%swipe_pos) ~%elt) : unit)]; let px_signal_before = [%client