diff --git a/Makefile b/Makefile
index 30f3e977..871ecb99 100644
--- a/Makefile
+++ b/Makefile
@@ -62,7 +62,7 @@ eliomdep=$(3)
# endif
objs=$(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(3))))
#depsort=$(call objs,$(1),$(2),$(call eliomdep,$(3),$(4),$(5)))
-depsort=$(shell ocaml tools/sort_deps.ml .depend $(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(5)))))
+depsort=$(shell ocaml tools/sort_deps.ml .depend -I str $(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(5)))))
$(LIBDIR):
mkdir $(LIBDIR)
@@ -231,7 +231,7 @@ COMMON_OPTIONS := -colorize-code -stars -sort
eliomdoc_wiki = ODOC_WIKI_SUBPROJECT="$(1)" \
eliomdoc \
-$(1) \
- -ppx -package resource-pooling,pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \
+ -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \
-intro doc/indexdoc.$(1) $(COMMON_OPTIONS) \
-i $(shell ocamlfind query wikidoc) \
-g odoc_wiki.cma \
@@ -242,7 +242,7 @@ eliomdoc_wiki = ODOC_WIKI_SUBPROJECT="$(1)" \
eliomdoc_html = ODOC_WIKI_SUBPROJECT="$(1)" \
eliomdoc \
-$(1) \
- -ppx -package resource-pooling,pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \
+ -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \
-intro doc/indexdoc.$(1) \
$(COMMON_OPTIONS) \
-html \
diff --git a/Makefile.options b/Makefile.options
index 2282167e..3d0293df 100644
--- a/Makefile.options
+++ b/Makefile.options
@@ -54,8 +54,8 @@ SASS_TEMPORARY_PROJECT_NAME := os_temporary_project_name
##----------------------------------------------------------------------
# OCamlfind packages for the server
-SERVER_PACKAGES := calendar safepass \
- ocsigen-toolkit.server yojson re.str cohttp-lwt-unix
+SERVER_PACKAGES := calendar safepass pgocaml \
+ ocsigen-toolkit.server yojson re.str cohttp-eio
SERVER_PPX_PACKAGES := js_of_ocaml-ppx_deriving_json ocsigen-ppx-rpc
diff --git a/opam b/opam
index 5250bcf7..9e3b1341 100644
--- a/opam
+++ b/opam
@@ -28,10 +28,10 @@ depends: [
"ocsigen-ppx-rpc"
"ocsigen-i18n" {>= "3.7.0"}
"yojson" {>= "1.6.0"}
- "resource-pooling" {>= "1.0" & < "2.0"}
"cohttp-lwt-unix"
"js_of_ocaml" {>= "6.0.0"}
"re" {>= "1.7.2"}
+ "resource-pooling"
]
depexts: [
["imagemagick" "ruby-sass" "postgresql" "postgresql-common"] {os-family = "debian"}
diff --git a/src/os_comet.eliom b/src/os_comet.eliom
index fe034207..9c8a2c68 100644
--- a/src/os_comet.eliom
+++ b/src/os_comet.eliom
@@ -18,12 +18,11 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%client Lwt.Syntax
-open%client Js_of_ocaml
-open%client Js_of_ocaml_lwt
-
let%shared __link = () (* to make sure os_comet is linked *)
+open%client Js_of_ocaml
+open%client Js_of_ocaml_eio
+
let%client cookies_enabled () =
try
Dom_html.document##.cookie := Js.string "cookietest=1";
@@ -51,8 +50,12 @@ let%client restart_process () =
then Eliom_client.exit_to ~service:Eliom_service.reload_action () ()
let%client _ =
- Eliom_comet.set_handle_exn_function (fun ?exn:_ () ->
- restart_process (); Lwt.return_unit)
+ Eliom_comet.set_handle_exn_function (fun ?exn () ->
+ Logs.err (fun fmt ->
+ fmt "Eliom_comet exception: %s"
+ (match exn with Some e -> Printexc.to_string e | None -> "unknown"))
+ (* TODO: re-enable restart_process () after fixing comet channel issues *)
+ )
(* We create a channel on scope user_indep_process_scope,
to monitor the application.
@@ -86,25 +89,23 @@ let already_send_ref =
let%client handle_error =
ref (fun exn ->
- Logs.info (fun fmt ->
+ Logs.err (fun fmt ->
fmt
("Exception received on Os_comet's monitor channel: " ^^ "@\n%s")
- (Printexc.to_string exn));
- restart_process ();
- Lwt.return_unit)
+ (Printexc.to_string exn))
+ (* TODO: re-enable restart_process () after fixing comet channel issues *)
+ )
let%client set_error_handler f = handle_error := f
let%client handle_message = function
| Error exn -> !handle_error exn
- | Ok Heartbeat ->
- Logs.info (fun fmt -> fmt "poum");
- Lwt.return_unit
+ | Ok Heartbeat -> Logs.info (fun fmt -> fmt "poum")
| Ok Connection_changed ->
Os_msg.msg ~level:`Err
"Connection has changed from outside. Program will restart.";
- let* () = Lwt_js.sleep 2. in
- restart_process (); Lwt.return_unit
+ Eio_js.sleep 2.;
+ restart_process ()
let%server warn_state c state =
match Eliom_reference.Volatile.Ext.get state monitor_channel_ref with
@@ -118,13 +119,15 @@ let%server _ =
Os_session.on_start_process (fun _ ->
let channel = create_monitor_channel () in
Eliom_reference.Volatile.set monitor_channel_ref (Some channel);
+ Logs.info (fun fmt -> fmt "[Os_comet] Monitor channel created on server");
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_stream.iter_s handle_message
- (Lwt_stream.wrap_exn ~%(fst channel)))
- : unit)];
- Lwt.return_unit);
+ (Logs.info (fun fmt -> fmt "[Os_comet] Client starting monitor channel listener");
+ Eio_js.start (fun () ->
+ Logs.info (fun fmt -> fmt "[Os_comet] Inside Eio_js.start, about to iter_s");
+ Eliom_stream.iter_s handle_message
+ (Eliom_stream.wrap_exn ~%(fst channel)))
+ : unit)]);
let warn c =
(* User connected or disconnected.
I want to send the message on all tabs of the browser: *)
@@ -138,8 +141,7 @@ let%server _ =
~scope:Os_session.user_indep_session_scope ()) (fun state ->
match Eliom_reference.Volatile.Ext.get state monitor_channel_ref with
| Some (_, send) as v -> if not (v == cur) then send c
- | None -> ()));
- Lwt.return_unit
+ | None -> ()))
in
let warn_connection_change _ = warn Connection_changed in
Os_session.on_open_session warn_connection_change;
diff --git a/src/os_comet.eliomi b/src/os_comet.eliomi
index 5cc5fbbe..ca382a8d 100644
--- a/src/os_comet.eliomi
+++ b/src/os_comet.eliomi
@@ -39,4 +39,4 @@ val restart_process : unit -> unit
subproject="server" | module Eliom_client.exit_to>>
*)
-val set_error_handler : (exn -> unit Lwt.t) -> unit
+val set_error_handler : (exn -> unit) -> unit
diff --git a/src/os_connect_phone.eliom b/src/os_connect_phone.eliom
index ff854358..e963dcfb 100644
--- a/src/os_connect_phone.eliom
+++ b/src/os_connect_phone.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%server Lwt.Syntax
-
type%shared sms_error_core = [`Unknown | `Send | `Limit | `Invalid_number]
type%shared sms_error = [`Ownership | sms_error_core]
@@ -46,74 +44,64 @@ let send_sms_handler =
Printf.printf
"INFO: send SMS %s to %s\nYou have not defined an SMS handler.\nPlease see Os_connect_phone.set_send_sms_handler\n%!"
message number;
- Lwt.return (Error `Send)
+ Error `Send
let set_send_sms_handler = ( := ) send_sms_handler
-let send_sms ~number message : (unit, sms_error_core) result Lwt.t =
+let send_sms ~number message : (unit, sms_error_core) result =
!send_sms_handler ~number message
let%server request_code reference number =
- Lwt.catch
- (fun () ->
- let* attempt =
- Lwt.bind (Eliom_reference.get reference) (function
- | Some (_, _, attempt) -> Lwt.return attempt
- | None -> Lwt.return 0)
- in
- if attempt <= 3
- then
- let attempt = attempt + 1 and code = activation_code () in
- let* () =
- Eliom_reference.set reference (Some (number, code, attempt))
- in
- Lwt.catch
- (fun () -> (send_sms ~number code :> (unit, sms_error) result Lwt.t))
- (fun _ -> Lwt.return (Error `Send))
- else Lwt.return (Error `Limit))
- (fun _ -> Lwt.return (Error `Unknown))
+ try
+ let attempt =
+ match Eliom_reference.get reference with
+ | Some (_, _, attempt) -> attempt
+ | None -> 0
+ in
+ if attempt <= 3
+ then
+ let attempt = attempt + 1 and code = activation_code () in
+ let () = Eliom_reference.set reference (Some (number, code, attempt)) in
+ try (send_sms ~number code :> (unit, sms_error) result)
+ with _ -> Error `Send
+ else Error `Limit
+ with _ -> Error `Unknown
let%server request_wrapper number f =
if Re.Str.string_match Os_lib.phone_regexp number 0
then f number
- else Lwt.return (Error `Invalid_number)
+ else Error `Invalid_number
-let%rpc request_recovery_code (number : string) : (unit, sms_error) result Lwt.t
- =
+let%rpc request_recovery_code (number : string) : (unit, sms_error) result =
request_wrapper number @@ fun number ->
- let* b = Os_db.Phone.exists number in
- if not b
- then Lwt.return (Error `Ownership)
- else request_code recovery_code_ref number
+ let b = Os_db.Phone.exists number in
+ if not b then Error `Ownership else request_code recovery_code_ref number
-let%rpc request_code (number : string) : (unit, sms_error) result Lwt.t =
+let%rpc request_code (number : string) : (unit, sms_error) result =
request_wrapper number @@ fun number ->
- let* b = Os_db.Phone.exists number in
- if b
- then Lwt.return (Error `Ownership)
- else request_code activation_code_ref number
+ let b = Os_db.Phone.exists number in
+ if b then Error `Ownership else request_code activation_code_ref number
let%server confirm_code myid code =
- Lwt.bind (Eliom_reference.get activation_code_ref) (function
- | Some (number, code', _) when code = code' -> Os_db.Phone.add myid number
- | _ -> Lwt.return_false)
+ match Eliom_reference.get activation_code_ref with
+ | Some (number, code', _) when code = code' -> Os_db.Phone.add myid number
+ | _ -> false
-let%rpc confirm_code_extra myid (code : string) : bool Lwt.t =
- confirm_code myid code
+let%rpc confirm_code_extra myid (code : string) : bool = confirm_code myid code
let%server
confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ()
=
- Lwt.bind (Eliom_reference.get activation_code_ref) (function
- | Some (number, code', _) when code = code' ->
- let* () = Eliom_reference.set activation_code_ref None in
- let* user =
- Os_user.create ~password ~firstname:first_name ~lastname:last_name ()
- in
- let userid = Os_user.userid_of_user user in
- let* _ = Os_db.Phone.add userid number in
- Lwt.return_some userid
- | _ -> Lwt.return_none)
+ match Eliom_reference.get activation_code_ref with
+ | Some (number, code', _) when code = code' ->
+ let () = Eliom_reference.set activation_code_ref None in
+ let user =
+ Os_user.create ~password ~firstname:first_name ~lastname:last_name ()
+ in
+ let userid = Os_user.userid_of_user user in
+ let _ = Os_db.Phone.add userid number in
+ Some userid
+ | _ -> None
let%rpc
confirm_code_signup
@@ -121,37 +109,34 @@ let%rpc
~(last_name : string)
~(code : string)
~(password : string)
- () : bool Lwt.t
+ () : bool
=
- Lwt.bind
- (confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ())
- (function
- | None -> Lwt.return_false
+ match
+ confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ()
+ with
+ | None -> false
+ | Some userid ->
+ let () = Os_session.connect userid in
+ true
+
+let%rpc confirm_code_recovery (code : string) : bool =
+ match Eliom_reference.get recovery_code_ref with
+ | Some (number, code', _) when code = code' -> (
+ match Os_db.Phone.userid number with
| Some userid ->
- let* () = Os_session.connect userid in
- Lwt.return_true)
-
-let%rpc confirm_code_recovery (code : string) : bool Lwt.t =
- Lwt.bind (Eliom_reference.get recovery_code_ref) (function
- | Some (number, code', _) when code = code' ->
- Lwt.bind (Os_db.Phone.userid number) (function
- | Some userid ->
- let* () = Os_session.connect userid in
- Lwt.return_true
- | None -> Lwt.return_false)
- | _ -> Lwt.return_false)
+ let () = Os_session.connect userid in
+ true
+ | None -> false)
+ | _ -> false
let%rpc connect ~(keepmeloggedin : bool) ~(password : string) (number : string)
- : [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set] Lwt.t
+ : [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set]
=
- Lwt.catch
- (fun () ->
- let* userid = Os_db.User.verify_password_phone ~password ~number in
- let* () = Os_session.connect ~expire:(not keepmeloggedin) userid in
- Lwt.return `Login_ok)
- (function
- | Os_db.Empty_password | Os_db.Wrong_password ->
- Lwt.return `Wrong_password
- | Os_db.No_such_user -> Lwt.return `No_such_user
- | Os_db.Password_not_set -> Lwt.return `Password_not_set
- | exc -> Lwt.reraise exc)
+ try
+ let userid = Os_db.User.verify_password_phone ~password ~number in
+ let () = Os_session.connect ~expire:(not keepmeloggedin) userid in
+ `Login_ok
+ with
+ | Os_db.Empty_password | Os_db.Wrong_password -> `Wrong_password
+ | Os_db.No_such_user -> `No_such_user
+ | Os_db.Password_not_set -> `Password_not_set
diff --git a/src/os_connect_phone.eliomi b/src/os_connect_phone.eliomi
index 296f3ee8..30877b00 100644
--- a/src/os_connect_phone.eliomi
+++ b/src/os_connect_phone.eliomi
@@ -26,7 +26,7 @@ type sms_error_core = [`Unknown | `Send | `Limit | `Invalid_number]
[%%server.start]
val set_send_sms_handler :
- (number:string -> string -> (unit, sms_error_core) result Lwt.t)
+ (number:string -> string -> (unit, sms_error_core) result)
-> unit
(** [set_send_sms_handler f] registers [f] as the function to be
called to send SMS messages. Used to send activation codes for
@@ -38,10 +38,10 @@ val confirm_code_signup_no_connect :
-> code:string
-> password:string
-> unit
- -> Os_types.User.id option Lwt.t
+ -> Os_types.User.id option
(** Confirm validation code and create corresponding user. *)
-val confirm_code : Os_types.User.id -> string -> bool Lwt.t
+val confirm_code : Os_types.User.id -> string -> bool
(** Confirm validation code and add extra phone to account of the given
user *)
@@ -49,14 +49,14 @@ val confirm_code : Os_types.User.id -> string -> bool Lwt.t
type sms_error = [`Ownership | sms_error_core]
-val request_code : string -> (unit, sms_error) result Lwt.t
+val request_code : string -> (unit, sms_error) result
(** Send a validation code for a new e-mail address (corresponds to
[confirm_code_signup] and [confirm_code_extra]). *)
-val request_recovery_code : string -> (unit, sms_error) result Lwt.t
+val request_recovery_code : string -> (unit, sms_error) result
(** Send a validation code for recovering an existing address. *)
-val confirm_code_extra : string -> bool Lwt.t
+val confirm_code_extra : string -> bool
(** Confirm validation code and add extra phone to account of the currently
connected user*)
@@ -66,11 +66,11 @@ val confirm_code_signup :
-> code:string
-> password:string
-> unit
- -> bool Lwt.t
+ -> bool
(** Confirm validation code and complete sign-up with the phone
number. *)
-val confirm_code_recovery : string -> bool Lwt.t
+val confirm_code_recovery : string -> bool
(** Confirm validation code and recover account. We redirect to the
settings page for setting a new password. *)
@@ -78,4 +78,4 @@ val connect :
keepmeloggedin:bool
-> password:string
-> string
- -> [`Login_ok | `No_such_user | `Wrong_password | `Password_not_set] Lwt.t
+ -> [`Login_ok | `No_such_user | `Wrong_password | `Password_not_set]
diff --git a/src/os_core_db.ml b/src/os_core_db.ml
index 033743d1..3976ceb8 100644
--- a/src/os_core_db.ml
+++ b/src/os_core_db.ml
@@ -18,32 +18,8 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-open Resource_pooling
-
let section = Logs.Src.create "os:db"
-let ( >>= ) = Lwt.bind
-
-module Lwt_thread = struct
- include Lwt
-
- let close_in = Lwt_io.close
- let really_input = Lwt_io.read_into_exactly
- let input_binary_int = Lwt_io.BE.read_int
- let input_char = Lwt_io.read_char
- let output_string = Lwt_io.write
- let output_binary_int = Lwt_io.BE.write_int
- let output_char = Lwt_io.write_char
- let flush = Lwt_io.flush
- let open_connection x = Lwt_io.open_connection x
-
- type out_channel = Lwt_io.output_channel
- type in_channel = Lwt_io.input_channel
-end
-
-module Lwt_PGOCaml = PGOCaml_generic.Make (Lwt_thread)
-module PGOCaml = Lwt_PGOCaml
-
+let ( >>= ) = fun x1 x2 -> x2 x1
let host_r = ref None
let port_r = ref None
let user_r = ref None
@@ -51,39 +27,35 @@ let password_r = ref None
let database_r = ref None
let unix_domain_socket_dir_r = ref None
let init_r = ref None
-
-let dispose db =
- Lwt.catch (fun () -> PGOCaml.close db) (fun _ -> Lwt.return_unit)
+let dispose db = try PGOCaml.close db with _ -> ()
let connect () =
- let* h =
- Lwt_PGOCaml.connect ?host:!host_r ?port:!port_r ?user:!user_r
+ let h =
+ PGOCaml.connect ?host:!host_r ?port:!port_r ?user:!user_r
?password:!password_r ?database:!database_r
?unix_domain_socket_dir:!unix_domain_socket_dir_r ()
in
match !init_r with
| Some init ->
- let* () =
- Lwt.catch
- (fun () -> init h)
- (fun exn ->
- let* () = dispose h in
- Lwt.fail exn)
+ let () =
+ try init h
+ with exn ->
+ let () = dispose h in
+ raise exn
in
- Lwt.return h
- | None -> Lwt.return h
+ h
+ | None -> h
let validate db =
- Lwt.catch
- (fun () ->
- let* () = Lwt_PGOCaml.ping db in
- Lwt.return_true)
- (fun _ -> Lwt.return_false)
+ try
+ let () = PGOCaml.ping db in
+ true
+ with _ -> false
-let pool : (string, bool) Hashtbl.t Lwt_PGOCaml.t Resource_pool.t ref =
- ref @@ Resource_pool.create 16 ~validate ~dispose connect
+let pool : (string, bool) Hashtbl.t PGOCaml.t Eio.Pool.t ref =
+ ref @@ Eio.Pool.create 16 ~validate ~dispose connect
-let set_pool_size n = pool := Resource_pool.create n ~validate ~dispose connect
+let set_pool_size n = pool := Eio.Pool.create n ~validate ~dispose connect
let init
?host
@@ -107,60 +79,60 @@ let init
let connection_pool () = !pool
-type wrapper =
- {f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t}
+type wrapper = {f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a) -> 'a}
let connection_wrapper = ref {f = (fun _ f -> f ())}
let set_connection_wrapper f = connection_wrapper := f
let use_pool f =
- Resource_pool.use !pool @@ fun db ->
+ Logs.warn ~src:section (fun fmt -> fmt "[use_pool] acquiring connection");
+ Eio.Pool.use !pool @@ fun db ->
+ Logs.warn ~src:section (fun fmt -> fmt "[use_pool] got connection");
!connection_wrapper.f db @@ fun () ->
- Lwt.catch
- (fun () -> f db)
- (function
- | Lwt_PGOCaml.Error msg as e ->
- Logs.err ~src:section (fun fmt ->
- fmt "postgresql protocol error: %s" msg);
- let* () = Lwt_PGOCaml.close db in
- Lwt.fail e
- | (Unix.Unix_error _ | End_of_file) as e ->
- Logs.err ~src:section (fun fmt ->
- fmt ("unix error" ^^ "@\n%s") (Printexc.to_string e));
- let* () = Lwt_PGOCaml.close db in
- Lwt.fail e
- | Lwt.Canceled as e ->
- Logs.err ~src:section (fun fmt -> fmt "thread canceled");
- let* () = PGOCaml.close db in
- Lwt.fail e
- | exc -> Lwt.reraise exc)
+ try
+ let r = f db in
+ Logs.warn ~src:section (fun fmt -> fmt "[use_pool] f done, releasing connection");
+ r
+ with
+ | PGOCaml.Error msg as e ->
+ Logs.err ~src:section (fun fmt -> fmt "postgresql protocol error: %s" msg);
+ let () = PGOCaml.close db in
+ raise e
+ | (Unix.Unix_error _ | End_of_file) as e ->
+ Logs.err ~src:section (fun fmt ->
+ fmt ("unix error" ^^ "@\n%s") (Printexc.to_string e));
+ let () = PGOCaml.close db in
+ raise e
+ | Eio.Cancel.Cancelled _ as e ->
+ Logs.err ~src:section (fun fmt -> fmt "fiber canceled");
+ let () = PGOCaml.close db in
+ raise e
let transaction_block db f =
- Lwt.catch
- (fun () ->
- Lwt_PGOCaml.begin_work db >>= fun _ ->
- let* r = f () in
- let* () = Lwt_PGOCaml.commit db in
- Lwt.return r)
- (function
- | (Lwt_PGOCaml.Error _ | Lwt.Canceled | Unix.Unix_error _ | End_of_file)
- as e ->
- (* The connection is going to be closed by [use_pool],
+ try
+ PGOCaml.begin_work db >>= fun _ ->
+ Logs.warn ~src:section (fun fmt -> fmt "[transaction_block] begin_work done");
+ let r = f () in
+ Logs.warn ~src:section (fun fmt -> fmt "[transaction_block] f() done, about to commit");
+ let () = PGOCaml.commit db in
+ Logs.warn ~src:section (fun fmt -> fmt "[transaction_block] commit done");
+ r
+ with
+ | (PGOCaml.Error _ | Eio.Cancel.Cancelled _ | Unix.Unix_error _ | End_of_file) as e ->
+ raise
+ (* The connection is going to be closed by [use_pool],
so no need to try to rollback *)
- Lwt.fail e
- | e ->
- let* () =
- Lwt.catch
- (fun () -> Lwt_PGOCaml.rollback db)
- (function
- | Lwt_PGOCaml.PostgreSQL_Error _ ->
- (* If the rollback fails, for instance due to a timeout,
+ e
+ | e ->
+ let () =
+ try PGOCaml.rollback db
+ with PGOCaml.PostgreSQL_Error _ ->
+ (* If the rollback fails, for instance due to a timeout,
it seems better to close the connection. *)
- Logs.err ~src:section (fun fmt -> fmt "rollback failed");
- Lwt_PGOCaml.close db
- | exc -> Lwt.reraise exc)
- in
- Lwt.fail e)
+ Logs.err ~src:section (fun fmt -> fmt "rollback failed");
+ PGOCaml.close db
+ in
+ raise e
let full_transaction_block f =
use_pool (fun db -> transaction_block db (fun () -> f db))
diff --git a/src/os_core_db.mli b/src/os_core_db.mli
index 284264bf..4d93e2e7 100644
--- a/src/os_core_db.mli
+++ b/src/os_core_db.mli
@@ -21,9 +21,6 @@
(** This module defines low level functions for database requests. *)
-open Resource_pooling
-module PGOCaml : PGOCaml_generic.PGOCAML_GENERIC with type 'a monad = 'a Lwt.t
-
val init :
?host:string
-> ?port:int
@@ -32,7 +29,7 @@ val init :
-> ?database:string
-> ?unix_domain_socket_dir:string
-> ?pool_size:int
- -> ?init:(PGOCaml.pa_pg_data PGOCaml.t -> unit Lwt.t)
+ -> ?init:(PGOCaml.pa_pg_data PGOCaml.t -> unit)
-> unit
-> unit
(** [init ?host ?port ?user ?password ?database ?unix_domain_socket_dir ?init ()]
@@ -40,21 +37,18 @@ val init :
function [init] invoked each time a connection is created.
*)
-val full_transaction_block :
- (PGOCaml.pa_pg_data PGOCaml.t -> 'a Lwt.t)
- -> 'a Lwt.t
+val full_transaction_block : (PGOCaml.pa_pg_data PGOCaml.t -> 'a) -> 'a
(** [full_transaction_block f] executes function [f] within a database
transaction. The argument of [f] is a PGOCaml database handle. *)
-val without_transaction : (PGOCaml.pa_pg_data PGOCaml.t -> 'a Lwt.t) -> 'a Lwt.t
+val without_transaction : (PGOCaml.pa_pg_data PGOCaml.t -> 'a) -> 'a
(** [without_transaction f] executes function [f] outside a database
transaction. The argument of [f] is a PGOCaml database handle. *)
-val connection_pool : unit -> PGOCaml.pa_pg_data PGOCaml.t Resource_pool.t
+val connection_pool : unit -> PGOCaml.pa_pg_data PGOCaml.t Eio.Pool.t
(** Direct access to the connection pool *)
-type wrapper =
- {f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t}
+type wrapper = {f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a) -> 'a}
(** Setup a wrapper function which is used each time a connection is
acquired. This function can perform some actions before and/or
after the connection is used. *)
diff --git a/src/os_current_user.eliom b/src/os_current_user.eliom
index 4a18996c..e5cf55cf 100644
--- a/src/os_current_user.eliom
+++ b/src/os_current_user.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%server Lwt.Syntax
-
[%%shared
type current_user =
| CU_idontknown
@@ -87,9 +85,8 @@ end]
let%client _ = Os_session.get_current_userid_o := Opt.get_current_userid
let%server set_user_server myid =
- let* u = Os_user.user_of_userid myid in
- Eliom_reference.Volatile.set me (CU_user u);
- Lwt.return_unit
+ let u = Os_user.user_of_userid myid in
+ Eliom_reference.Volatile.set me (CU_user u)
let%server unset_user_server () =
Eliom_reference.Volatile.set me CU_notconnected
@@ -105,22 +102,21 @@ let%server () =
Os_session.on_request (fun myid_o ->
match myid_o with
| Some myid -> set_user_server myid
- | None -> unset_user_server (); Lwt.return_unit);
+ | None -> unset_user_server ());
Os_session.on_start_connected_process (fun myid ->
- let* () = set_user_server myid in
- set_user_client (); Lwt.return_unit);
+ let () = set_user_server myid in
+ set_user_client ());
Os_session.on_pre_close_session (fun () ->
unset_user_client ();
(*VVV!!! will affect only current tab!! *)
- unset_user_server ();
- (* ok this is a request reference *)
- Lwt.return_unit)
+ unset_user_server ()
+ (* ok this is a request reference *))
-let%rpc remove_email_from_user (email : string) : unit Lwt.t =
+let%rpc remove_email_from_user (email : string) : unit =
let myid = get_current_userid () in
Os_user.remove_email_from_user ~userid:myid ~email
-let%rpc update_main_email (email : string) : unit Lwt.t =
+let%rpc update_main_email (email : string) : unit =
let myid = get_current_userid () in
Os_user.update_main_email ~userid:myid ~email
@@ -132,6 +128,6 @@ let%server is_main_email email =
let myid = get_current_userid () in
Os_user.is_main_email ~userid:myid ~email
-let%rpc update_language (language : string) : unit Lwt.t =
+let%rpc update_language (language : string) : unit =
let myid = get_current_userid () in
Os_user.update_language ~userid:myid ~language
diff --git a/src/os_current_user.eliomi b/src/os_current_user.eliomi
index ea473c0c..8945bc20 100644
--- a/src/os_current_user.eliomi
+++ b/src/os_current_user.eliomi
@@ -52,7 +52,7 @@ module Opt : sig
If no user is connected, [None] is returned. *)
end
-val remove_email_from_user : string -> unit Lwt.t
+val remove_email_from_user : string -> unit
(** [remove_email_from_user email] removes the email [email] of the current
user.
If no user is connected, it fails with {!Os_session.Not_connected}. If
@@ -60,27 +60,27 @@ val remove_email_from_user : string -> unit Lwt.t
{!Os_db.Main_email_removal_attempt}.
*)
-val update_main_email : string -> unit Lwt.t
+val update_main_email : string -> unit
(** [update_main_email email] sets the main email of the current user to
[email].
If no user is connected, it fails with {!Os_session.Not_connected}.
*)
-val update_language : string -> unit Lwt.t
+val update_language : string -> unit
(** [update_language language] updates the language of the current user.
If no user is connected, it fails with {!Os_session.Not_connected}.
*)
[%%server.start]
-val is_email_validated : string -> bool Lwt.t
+val is_email_validated : string -> bool
(** [is_email_validated email] returns [true] if [email] is a valided email for
the current user.
If no user is connected, it fails with {!Os_session.Not_connected}.
It returns [false] in all other cases.
*)
-val is_main_email : string -> bool Lwt.t
+val is_main_email : string -> bool
(** [is_main_email email] returns [true] if [email] is the main email of the current user. *)
[%%client.start]
diff --git a/src/os_date.eliom b/src/os_date.eliom
index dcd8f091..1c3cb7ba 100644
--- a/src/os_date.eliom
+++ b/src/os_date.eliom
@@ -26,6 +26,7 @@
*)
open%client Js_of_ocaml
+open%client Js_of_ocaml_eio
let%client timezone =
(* Use Intl API if available. Revert to using the time zone offset
@@ -75,16 +76,14 @@ let initialize tz =
Eliom_reference.Volatile.set user_tz_sr tz
(* When the browser is loaded, we init the timezone *)
-let%rpc init_time_rpc (tz : string) : unit Lwt.t =
- initialize tz; Lwt.return_unit
-
+let%rpc init_time_rpc (tz : string) : unit = initialize tz
let%client auto_init = ref true
let%client disable_auto_init () = auto_init := false
let%client _ =
(* We wait for the client process to be fully loaded: *)
Eliom_client.onload (fun () ->
- if !auto_init then Lwt.async (fun () -> init_time_rpc timezone))
+ if !auto_init then Eio_js.start (fun () -> init_time_rpc timezone))
[%%shared
open CalendarLib
diff --git a/src/os_db.ml b/src/os_db.ml
index 42c1e8b6..c90733dc 100644
--- a/src/os_db.ml
+++ b/src/os_db.ml
@@ -1,5 +1,4 @@
(* GENERATED CODE, DO NOT EDIT! *)
-open Lwt.Syntax
include Os_core_db
exception No_such_resource
@@ -10,8 +9,8 @@ exception Empty_password
exception Main_email_removal_attempt
exception Account_not_activated
-let ( >>= ) = Lwt.bind
-let one f ~success ~fail q = f q >>= function r :: _ -> success r | _ -> fail
+let ( >>= ) = fun x1 x2 -> x2 x1
+let one f ~success ~fail q = f q >>= function r :: _ -> success r | _ -> fail ()
let pwd_crypt_ref =
ref
@@ -24,8 +23,8 @@ let pwd_crypt_ref =
module Email = struct
let available email =
one without_transaction
- ~success:(fun _ -> Lwt.return_false)
- ~fail:Lwt.return_true
+ ~success:(fun _ -> false)
+ ~fail:(fun () -> true)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -37,7 +36,7 @@ module Email = struct
in
let split =
[ `Text
- "SELECT 1\n FROM ocsigen_start.emails\n JOIN ocsigen_start.users USING (userid)\n WHERE email = "
+ "SELECT 1\n\ FROM ocsigen_start.emails\n\ JOIN ocsigen_start.users USING (userid)\n\ WHERE email = "
; `Var ("email", false, false) ]
in
let i = ref 0 in
@@ -84,7 +83,7 @@ module Email = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT 1\n FROM ocsigen_start.emails\n JOIN ocsigen_start.users USING (userid)\n WHERE email = $email"
+ "SELECT 1\n\ FROM ocsigen_start.emails\n\ JOIN ocsigen_start.users USING (userid)\n\ WHERE email = $email"
in
List.rev_map
(fun row ->
@@ -115,8 +114,8 @@ module User = struct
let userid_of_email email =
one without_transaction
- ~success:(fun userid -> Lwt.return userid)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun userid -> userid)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -128,7 +127,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid\n FROM ocsigen_start.users JOIN ocsigen_start.emails USING (userid)\n WHERE email = "
+ "SELECT userid\n\ FROM ocsigen_start.users JOIN ocsigen_start.emails USING (userid)\n\ WHERE email = "
; `Var ("email", false, false) ]
in
let i = ref 0 in
@@ -175,7 +174,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid\n FROM ocsigen_start.users JOIN ocsigen_start.emails USING (userid)\n WHERE email = $email"
+ "SELECT userid\n\ FROM ocsigen_start.users JOIN ocsigen_start.emails USING (userid)\n\ WHERE email = $email"
in
List.rev_map
(fun row ->
@@ -203,16 +202,15 @@ module User = struct
_rows)))
let is_registered email =
- Lwt.catch
- (fun () ->
- let* _ = userid_of_email email in
- Lwt.return_true)
- (function No_such_resource -> Lwt.return_false | exc -> Lwt.reraise exc)
+ try
+ let _ = userid_of_email email in
+ true
+ with No_such_resource -> false
let is_email_validated userid email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -228,7 +226,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT 1 FROM ocsigen_start.emails\n WHERE userid = "
+ "SELECT 1 FROM ocsigen_start.emails\n\ WHERE userid = "
; `Var ("userid", false, false)
; `Text " AND email = "
; `Var ("email", false, false)
@@ -278,7 +276,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT 1 FROM ocsigen_start.emails\n WHERE userid = $userid AND email = $email AND validated"
+ "SELECT 1 FROM ocsigen_start.emails\n\ WHERE userid = $userid AND email = $email AND validated"
in
List.rev_map
(fun row ->
@@ -319,7 +317,7 @@ module User = struct
in
let split =
[ `Text
- "UPDATE ocsigen_start.emails SET validated = true\n WHERE userid = "
+ "UPDATE ocsigen_start.emails SET validated = true\n\ WHERE userid = "
; `Var ("userid", false, false)
; `Text " AND email = "
; `Var ("email", false, false) ]
@@ -423,7 +421,7 @@ module User = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.activation\n (userid, email, action, autoconnect, data,\n validity, activationkey, expiry)\n VALUES ("
+ "INSERT INTO ocsigen_start.activation\n\ (userid, email, action, autoconnect, data,\n\ validity, activationkey, expiry)\n\ VALUES ("
; `Var ("userid", false, false)
; `Text ", "
; `Var ("email", false, false)
@@ -603,8 +601,8 @@ module User = struct
let is_preregistered email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -774,134 +772,136 @@ module User = struct
let create ?password ?avatar ?language ?email ~firstname ~lastname () =
if password = Some ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
full_transaction_block (fun dbh ->
let password_o =
Eliom_lib.Option.map (fun p -> fst !pwd_crypt_ref p) password
in
- let* userid =
- Lwt.bind
- (PGOCaml.bind
- (let dbh = dbh in
- let params : string option list list =
- [ [ Some
- ((let open PGOCaml in
- string_of_string)
- firstname) ]
- ; [ Some
- ((let open PGOCaml in
- string_of_string)
- lastname) ]
- ; [ PGOCaml_aux.Option.map
- (let open PGOCaml in
- string_of_string)
- email ]
- ; [ PGOCaml_aux.Option.map
- (let open PGOCaml in
- string_of_string)
- password_o ]
- ; [ PGOCaml_aux.Option.map
- (let open PGOCaml in
+ let userid =
+ match
+ PGOCaml.bind
+ (let dbh = dbh in
+ let params : string option list list =
+ [ [ Some
+ ((let open PGOCaml in
string_of_string)
- avatar ]
- ; [ PGOCaml_aux.Option.map
- (let open PGOCaml in
+ firstname) ]
+ ; [ Some
+ ((let open PGOCaml in
string_of_string)
- language ] ]
- in
- let split =
- [ `Text
- "INSERT INTO ocsigen_start.users\n (firstname, lastname, main_email, password, avatar, language)\n VALUES ("
- ; `Var ("firstname", false, false)
- ; `Text ", "
- ; `Var ("lastname", false, false)
- ; `Text ", "
- ; `Var ("email", false, true)
- ; `Text ",\n "
- ; `Var ("password_o", false, true)
- ; `Text ", "
- ; `Var ("avatar", false, true)
- ; `Text ", "
- ; `Var ("language", false, true)
- ; `Text ")\n RETURNING userid" ]
- in
- let i = ref 0 in
- let j = ref 0 in
- let query =
- String.concat ""
- (List.map
- (function
- | `Text text -> text
- | `Var (_varname, false, _) ->
- let () = incr i in
- let () = incr j in
- "$" ^ string_of_int j.contents
- | `Var (_varname, true, _) ->
- let param = List.nth params i.contents in
- let () = incr i in
- "("
- ^ String.concat ","
- (List.map
- (fun _ ->
- let () = incr j in
- "$" ^ string_of_int j.contents)
- param)
- ^ ")")
- split)
- in
- let params = List.flatten params in
- let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
- let hash =
- try PGOCaml.private_data dbh
- with Not_found ->
- let hash = Hashtbl.create 17 in
- PGOCaml.set_private_data dbh hash;
- hash
- in
- let is_prepared = Hashtbl.mem hash name in
- PGOCaml.bind
- (if not is_prepared
- then
- PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ())
- (fun () -> Hashtbl.add hash name true; PGOCaml.return ())
- else PGOCaml.return ())
- (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
- (fun _rows ->
- PGOCaml.return
- (let original_query =
- "INSERT INTO ocsigen_start.users\n (firstname, lastname, main_email, password, avatar, language)\n VALUES ($firstname, $lastname, $?email,\n $?password_o, $?avatar, $?language)\n RETURNING userid"
- in
- List.rev_map
- (fun row ->
- match row with
- | c0 :: [] ->
- (let open PGOCaml in
- int64_of_string)
- (try PGOCaml_aux.Option.get c0
- with _ ->
- failwith
- "ppx_pgsql's nullability heuristic has failed - use \"nullable-results\"")
- | _ ->
- let msg =
- "ppx_pgsql: internal error: "
- ^ "Incorrect number of columns returned from query: "
- ^ original_query ^ ". Columns are: "
- ^ String.concat "; "
- (List.map
- (function
- | Some str -> Printf.sprintf "%S" str
- | None -> "NULL")
- row)
- in
- raise (PGOCaml.Error msg))
- _rows)))
- (function userid :: [] -> Lwt.return userid | _ -> assert false)
+ lastname) ]
+ ; [ PGOCaml_aux.Option.map
+ (let open PGOCaml in
+ string_of_string)
+ email ]
+ ; [ PGOCaml_aux.Option.map
+ (let open PGOCaml in
+ string_of_string)
+ password_o ]
+ ; [ PGOCaml_aux.Option.map
+ (let open PGOCaml in
+ string_of_string)
+ avatar ]
+ ; [ PGOCaml_aux.Option.map
+ (let open PGOCaml in
+ string_of_string)
+ language ] ]
+ in
+ let split =
+ [ `Text
+ "INSERT INTO ocsigen_start.users\n\ (firstname, lastname, main_email, password, avatar, language)\n\ VALUES ("
+ ; `Var ("firstname", false, false)
+ ; `Text ", "
+ ; `Var ("lastname", false, false)
+ ; `Text ", "
+ ; `Var ("email", false, true)
+ ; `Text ",\n "
+ ; `Var ("password_o", false, true)
+ ; `Text ", "
+ ; `Var ("avatar", false, true)
+ ; `Text ", "
+ ; `Var ("language", false, true)
+ ; `Text ")\n RETURNING userid" ]
+ in
+ let i = ref 0 in
+ let j = ref 0 in
+ let query =
+ String.concat ""
+ (List.map
+ (function
+ | `Text text -> text
+ | `Var (_varname, false, _) ->
+ let () = incr i in
+ let () = incr j in
+ "$" ^ string_of_int j.contents
+ | `Var (_varname, true, _) ->
+ let param = List.nth params i.contents in
+ let () = incr i in
+ "("
+ ^ String.concat ","
+ (List.map
+ (fun _ ->
+ let () = incr j in
+ "$" ^ string_of_int j.contents)
+ param)
+ ^ ")")
+ split)
+ in
+ let params = List.flatten params in
+ let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
+ let hash =
+ try PGOCaml.private_data dbh
+ with Not_found ->
+ let hash = Hashtbl.create 17 in
+ PGOCaml.set_private_data dbh hash;
+ hash
+ in
+ let is_prepared = Hashtbl.mem hash name in
+ PGOCaml.bind
+ (if not is_prepared
+ then
+ PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ())
+ (fun () -> Hashtbl.add hash name true; PGOCaml.return ())
+ else PGOCaml.return ())
+ (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
+ (fun _rows ->
+ PGOCaml.return
+ (let original_query =
+ "INSERT INTO ocsigen_start.users\n\ (firstname, lastname, main_email, password, avatar, language)\n\ VALUES ($firstname, $lastname, $?email,\n\ $?password_o, $?avatar, $?language)\n\ RETURNING userid"
+ in
+ List.rev_map
+ (fun row ->
+ match row with
+ | c0 :: [] ->
+ (let open PGOCaml in
+ int64_of_string)
+ (try PGOCaml_aux.Option.get c0
+ with _ ->
+ failwith
+ "ppx_pgsql's nullability heuristic has failed - use \"nullable-results\"")
+ | _ ->
+ let msg =
+ "ppx_pgsql: internal error: "
+ ^ "Incorrect number of columns returned from query: "
+ ^ original_query ^ ". Columns are: "
+ ^ String.concat "; "
+ (List.map
+ (function
+ | Some str -> Printf.sprintf "%S" str
+ | None -> "NULL")
+ row)
+ in
+ raise (PGOCaml.Error msg))
+ _rows))
+ with
+ | userid :: [] -> userid
+ | _ -> assert false
in
- let* () =
+ let () =
match email with
| Some email ->
- let* () =
+ let () =
PGOCaml.bind
(let dbh = dbh in
let params : string option list list =
@@ -916,7 +916,7 @@ module User = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.emails (email, userid)\n VALUES ("
+ "INSERT INTO ocsigen_start.emails (email, userid)\n\ VALUES ("
; `Var ("email", false, false)
; `Text ", "
; `Var ("userid", false, false)
@@ -969,13 +969,13 @@ module User = struct
(fun _rows -> PGOCaml.return ())
in
remove_preregister0 dbh email
- | None -> Lwt.return_unit
+ | None -> ()
in
- Lwt.return userid)
+ userid)
let update ?password ?avatar ?language ~firstname ~lastname userid =
if password = Some ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
let password =
match password with
@@ -1070,7 +1070,7 @@ module User = struct
let update_password ~userid ~password =
if password = ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
let password = fst !pwd_crypt_ref password in
without_transaction @@ fun dbh ->
@@ -1214,7 +1214,7 @@ module User = struct
in
let split =
[ `Text
- "UPDATE ocsigen_start.users u SET main_email = e.email\n FROM ocsigen_start.emails e\n WHERE e.email = "
+ "UPDATE ocsigen_start.users u SET main_email = e.email\n\ FROM ocsigen_start.emails e\n\ WHERE e.email = "
; `Var ("email", false, false)
; `Text " AND u.userid = "
; `Var ("userid", false, false)
@@ -1328,7 +1328,7 @@ module User = struct
let verify_password ~email ~password =
if password = ""
- then Lwt.fail Empty_password
+ then raise Empty_password
else
one without_transaction
(fun dbh ->
@@ -1342,7 +1342,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid, password, validated\n FROM ocsigen_start.users\n JOIN ocsigen_start.emails USING (userid)\n WHERE email = "
+ "SELECT userid, password, validated\n\ FROM ocsigen_start.users\n\ JOIN ocsigen_start.emails USING (userid)\n\ WHERE email = "
; `Var ("email", false, false) ]
in
let i = ref 0 in
@@ -1389,7 +1389,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, password, validated\n FROM ocsigen_start.users\n JOIN ocsigen_start.emails USING (userid)\n WHERE email = $email"
+ "SELECT userid, password, validated\n\ FROM ocsigen_start.users\n\ JOIN ocsigen_start.emails USING (userid)\n\ WHERE email = $email"
in
List.rev_map
(fun row ->
@@ -1429,16 +1429,14 @@ module User = struct
~success:(fun (userid, password', validated) ->
match password' with
| Some password' when snd !pwd_crypt_ref userid password password' ->
- if validated
- then Lwt.return userid
- else Lwt.fail Account_not_activated
- | Some _ -> Lwt.fail Wrong_password
- | _ -> Lwt.fail Password_not_set)
- ~fail:(Lwt.fail No_such_user)
+ if validated then userid else raise Account_not_activated
+ | Some _ -> raise Wrong_password
+ | _ -> raise Password_not_set)
+ ~fail:(fun () -> raise No_such_user)
let verify_password_phone ~number ~password =
if password = ""
- then Lwt.fail Empty_password
+ then raise Empty_password
else
one without_transaction
(fun dbh ->
@@ -1452,7 +1450,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid, password\n FROM ocsigen_start.users\n JOIN ocsigen_start.phones USING (userid)\n WHERE number = "
+ "SELECT userid, password\n\ FROM ocsigen_start.users\n\ JOIN ocsigen_start.phones USING (userid)\n\ WHERE number = "
; `Var ("number", false, false) ]
in
let i = ref 0 in
@@ -1499,7 +1497,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, password\n FROM ocsigen_start.users\n JOIN ocsigen_start.phones USING (userid)\n WHERE number = $number"
+ "SELECT userid, password\n\ FROM ocsigen_start.users\n\ JOIN ocsigen_start.phones USING (userid)\n\ WHERE number = $number"
in
List.rev_map
(fun row ->
@@ -1532,24 +1530,18 @@ module User = struct
~success:(fun (userid, password') ->
match password' with
| Some password' when snd !pwd_crypt_ref userid password password' ->
- Lwt.return userid
- | Some _ -> Lwt.fail Wrong_password
- | _ -> Lwt.fail Password_not_set)
- ~fail:(Lwt.fail No_such_user)
+ userid
+ | Some _ -> raise Wrong_password
+ | _ -> raise Password_not_set)
+ ~fail:(fun () -> raise No_such_user)
let user_of_userid userid =
one without_transaction
~success:
(fun
(userid, firstname, lastname, avatar, has_password, language) ->
- Lwt.return
- ( userid
- , firstname
- , lastname
- , avatar
- , has_password = Some true
- , language ))
- ~fail:(Lwt.fail No_such_resource)
+ userid, firstname, lastname, avatar, has_password = Some true, language)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -1561,7 +1553,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users WHERE userid = "
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users WHERE userid = "
; `Var ("userid", false, false) ]
in
let i = ref 0 in
@@ -1608,7 +1600,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users WHERE userid = $userid"
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users WHERE userid = $userid"
in
List.rev_map
(fun row ->
@@ -1663,7 +1655,7 @@ module User = struct
full_transaction_block (fun dbh ->
one
(fun q -> q dbh)
- ~fail:(Lwt.fail No_such_resource)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -1675,7 +1667,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid, email, validity, expiry, autoconnect, action, data\n FROM ocsigen_start.activation\n WHERE activationkey = "
+ "SELECT userid, email, validity, expiry, autoconnect, action, data\n\ FROM ocsigen_start.activation\n\ WHERE activationkey = "
; `Var ("act_key", false, false) ]
in
let i = ref 0 in
@@ -1722,7 +1714,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, email, validity, expiry, autoconnect, action, data\n FROM ocsigen_start.activation\n WHERE activationkey = $act_key"
+ "SELECT userid, email, validity, expiry, autoconnect, action, data\n\ FROM ocsigen_start.activation\n\ WHERE activationkey = $act_key"
in
List.rev_map
(fun row ->
@@ -1793,7 +1785,7 @@ module User = struct
| c -> `Custom c
in
let v = max 0L (Int64.pred validity) in
- let* () =
+ let () =
if v = 0L
then
PGOCaml.bind
@@ -1806,7 +1798,7 @@ module User = struct
in
let split =
[ `Text
- "UPDATE ocsigen_start.activation\n SET expiry = LEAST(NOW() AT TIME ZONE 'utc'\n + INTERVAL '20 seconds',\n expiry)\n WHERE activationkey = "
+ "UPDATE ocsigen_start.activation\n\ SET expiry = LEAST(NOW() AT TIME ZONE 'utc'\n\ + INTERVAL '20 seconds',\n\ expiry)\n\ WHERE activationkey = "
; `Var ("act_key", false, false) ]
in
let i = ref 0 in
@@ -1869,7 +1861,7 @@ module User = struct
in
let split =
[ `Text
- "UPDATE ocsigen_start.activation\n SET validity = "
+ "UPDATE ocsigen_start.activation\n\ SET validity = "
; `Var ("v", false, false)
; `Text " WHERE activationkey = "
; `Var ("act_key", false, false) ]
@@ -1920,9 +1912,8 @@ module User = struct
(fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
(fun _rows -> PGOCaml.return ())
in
- Lwt.return
- (let open Os_types.Action_link_key in
- {userid; email; validity; expiry; action; data; autoconnect})))
+ let open Os_types.Action_link_key in
+ {userid; email; validity; expiry; action; data; autoconnect}))
let emails_of_userid userid =
without_transaction @@ fun dbh ->
@@ -2021,7 +2012,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT email, validated\n FROM ocsigen_start.emails WHERE userid = "
+ "SELECT email, validated\n\ FROM ocsigen_start.emails WHERE userid = "
; `Var ("userid", false, false) ]
in
let i = ref 0 in
@@ -2068,7 +2059,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT email, validated\n FROM ocsigen_start.emails WHERE userid = $userid"
+ "SELECT email, validated\n\ FROM ocsigen_start.emails WHERE userid = $userid"
in
List.rev_map
(fun row ->
@@ -2104,8 +2095,8 @@ module User = struct
let email_of_userid userid =
one without_transaction
- ~success:(fun main_email -> Lwt.return main_email)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun main_email -> main_email)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -2191,8 +2182,8 @@ module User = struct
let is_main_email ~userid ~email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -2208,7 +2199,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT 1 FROM ocsigen_start.users\n WHERE userid = "
+ "SELECT 1 FROM ocsigen_start.users\n\ WHERE userid = "
; `Var ("userid", false, false)
; `Text " AND main_email = "
; `Var ("email", false, false) ]
@@ -2257,7 +2248,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT 1 FROM ocsigen_start.users\n WHERE userid = $userid AND main_email = $email"
+ "SELECT 1 FROM ocsigen_start.users\n\ WHERE userid = $userid AND main_email = $email"
in
List.rev_map
(fun row ->
@@ -2298,7 +2289,7 @@ module User = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.emails (email, userid)\n VALUES ("
+ "INSERT INTO ocsigen_start.emails (email, userid)\n\ VALUES ("
; `Var ("email", false, false)
; `Text ", "
; `Var ("userid", false, false)
@@ -2348,9 +2339,9 @@ module User = struct
(fun _rows -> PGOCaml.return ())
let remove_email_from_user ~userid ~email =
- let* b = is_main_email ~userid ~email in
+ let b = is_main_email ~userid ~email in
if b
- then Lwt.fail Main_email_removal_attempt
+ then raise Main_email_removal_attempt
else
without_transaction @@ fun dbh ->
PGOCaml.bind
@@ -2416,8 +2407,8 @@ module User = struct
let get_language userid =
one without_transaction
- ~success:(fun language -> Lwt.return language)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun language -> language)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -2501,7 +2492,7 @@ module User = struct
_rows)))
let get_users ?pattern () =
- let* l =
+ let l =
without_transaction (fun dbh ->
match pattern with
| None ->
@@ -2510,7 +2501,7 @@ module User = struct
let params : string option list list = [] in
let split =
[ `Text
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users"
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users"
]
in
let i = ref 0 in
@@ -2557,7 +2548,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users"
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users"
in
List.rev_map
(fun row ->
@@ -2619,7 +2610,7 @@ module User = struct
in
let split =
[ `Text
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users\n WHERE firstname <> '' -- avoids email addresses\n AND CONCAT_WS(' ', firstname, lastname) ~* "
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users\n\ WHERE firstname <> '' -- avoids email addresses\n\ AND CONCAT_WS(' ', firstname, lastname) ~* "
; `Var ("pattern", false, false) ]
in
let i = ref 0 in
@@ -2666,7 +2657,7 @@ module User = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT userid, firstname, lastname, avatar,\n password IS NOT NULL, language\n FROM ocsigen_start.users\n WHERE firstname <> '' -- avoids email addresses\n AND CONCAT_WS(' ', firstname, lastname) ~* $pattern"
+ "SELECT userid, firstname, lastname, avatar,\n\ password IS NOT NULL, language\n\ FROM ocsigen_start.users\n\ WHERE firstname <> '' -- avoids email addresses\n\ AND CONCAT_WS(' ', firstname, lastname) ~* $pattern"
in
List.rev_map
(fun row ->
@@ -2717,16 +2708,10 @@ module User = struct
raise (PGOCaml.Error msg))
_rows)))
in
- Lwt.return
- (List.map
- (fun (userid, firstname, lastname, avatar, has_password, language) ->
- ( userid
- , firstname
- , lastname
- , avatar
- , has_password = Some true
- , language ))
- l)
+ List.map
+ (fun (userid, firstname, lastname, avatar, has_password, language) ->
+ userid, firstname, lastname, avatar, has_password = Some true, language)
+ l
end
module Groups = struct
@@ -2746,7 +2731,7 @@ module Groups = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.groups (description, name)\n VALUES ("
+ "INSERT INTO ocsigen_start.groups (description, name)\n\ VALUES ("
; `Var ("description", false, true)
; `Text ", "
; `Var ("name", false, false)
@@ -2807,7 +2792,7 @@ module Groups = struct
in
let split =
[ `Text
- "SELECT groupid, name, description\n FROM ocsigen_start.groups WHERE name = "
+ "SELECT groupid, name, description\n\ FROM ocsigen_start.groups WHERE name = "
; `Var ("name", false, false) ]
in
let i = ref 0 in
@@ -2854,7 +2839,7 @@ module Groups = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT groupid, name, description\n FROM ocsigen_start.groups WHERE name = $name"
+ "SELECT groupid, name, description\n\ FROM ocsigen_start.groups WHERE name = $name"
in
List.rev_map
(fun row ->
@@ -2891,8 +2876,8 @@ module Groups = struct
raise (PGOCaml.Error msg))
_rows)))
>>= function
- | r :: [] -> Lwt.return r
- | _ -> Lwt.fail No_such_resource
+ | r :: [] -> r
+ | _ -> raise No_such_resource
let add_user_in_group ~groupid ~userid =
without_transaction @@ fun dbh ->
@@ -2910,7 +2895,7 @@ module Groups = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.user_groups (userid, groupid)\n VALUES ("
+ "INSERT INTO ocsigen_start.user_groups (userid, groupid)\n\ VALUES ("
; `Var ("userid", false, false)
; `Text ", "
; `Var ("groupid", false, false)
@@ -3028,8 +3013,8 @@ module Groups = struct
(match dbh with
| None -> without_transaction
| Some dbh -> fun f -> f dbh)
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
PGOCaml.bind
(let dbh = dbh in
@@ -3045,7 +3030,7 @@ module Groups = struct
in
let split =
[ `Text
- "SELECT 1 FROM ocsigen_start.user_groups\n WHERE groupid = "
+ "SELECT 1 FROM ocsigen_start.user_groups\n\ WHERE groupid = "
; `Var ("groupid", false, false)
; `Text " AND userid = "
; `Var ("userid", false, false) ]
@@ -3094,7 +3079,7 @@ module Groups = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "SELECT 1 FROM ocsigen_start.user_groups\n WHERE groupid = $groupid AND userid = $userid"
+ "SELECT 1 FROM ocsigen_start.user_groups\n\ WHERE groupid = $groupid AND userid = $userid"
in
List.rev_map
(fun row ->
@@ -3212,7 +3197,7 @@ end
module Phone = struct
let add userid number =
without_transaction @@ fun dbh ->
- let* l =
+ let l =
PGOCaml.bind
(let dbh = dbh in
let params : string option list list =
@@ -3227,7 +3212,7 @@ module Phone = struct
in
let split =
[ `Text
- "INSERT INTO ocsigen_start.phones (number, userid)\n VALUES ("
+ "INSERT INTO ocsigen_start.phones (number, userid)\n\ VALUES ("
; `Var ("number", false, false)
; `Text ", "
; `Var ("userid", false, false)
@@ -3278,7 +3263,7 @@ module Phone = struct
(fun _rows ->
PGOCaml.return
(let original_query =
- "INSERT INTO ocsigen_start.phones (number, userid)\n VALUES ($number, $userid)\n ON CONFLICT DO NOTHING\n RETURNING 0"
+ "INSERT INTO ocsigen_start.phones (number, userid)\n\ VALUES ($number, $userid)\n\ ON CONFLICT DO NOTHING\n\ RETURNING 0"
in
List.rev_map
(fun row ->
@@ -3303,180 +3288,183 @@ module Phone = struct
raise (PGOCaml.Error msg))
_rows))
in
- Lwt.return (match l with _ :: [] -> true | _ -> false)
+ match l with _ :: [] -> true | _ -> false
let exists number =
- Lwt.bind
- ( without_transaction @@ fun dbh ->
- PGOCaml.bind
- (let dbh = dbh in
- let params : string option list list =
- [ [ Some
- ((let open PGOCaml in
- string_of_string)
- number) ] ]
- in
- let split =
- [ `Text "SELECT 1 FROM ocsigen_start.phones WHERE number = "
- ; `Var ("number", false, false) ]
- in
- let i = ref 0 in
- let j = ref 0 in
- let query =
- String.concat ""
- (List.map
- (function
- | `Text text -> text
- | `Var (_varname, false, _) ->
- let () = incr i in
- let () = incr j in
- "$" ^ string_of_int j.contents
- | `Var (_varname, true, _) ->
- let param = List.nth params i.contents in
- let () = incr i in
- "("
- ^ String.concat ","
- (List.map
- (fun _ ->
- let () = incr j in
- "$" ^ string_of_int j.contents)
- param)
- ^ ")")
- split)
- in
- let params = List.flatten params in
- let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
- let hash =
- try PGOCaml.private_data dbh
- with Not_found ->
- let hash = Hashtbl.create 17 in
- PGOCaml.set_private_data dbh hash;
- hash
- in
- let is_prepared = Hashtbl.mem hash name in
- PGOCaml.bind
- (if not is_prepared
- then
- PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ()) (fun () ->
- Hashtbl.add hash name true; PGOCaml.return ())
- else PGOCaml.return ())
- (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
- (fun _rows ->
- PGOCaml.return
- (let original_query =
- "SELECT 1 FROM ocsigen_start.phones WHERE number = $number"
- in
- List.rev_map
- (fun row ->
- match row with
- | c0 :: [] ->
- PGOCaml_aux.Option.map
- (let open PGOCaml in
- int32_of_string)
- c0
- | _ ->
- let msg =
- "ppx_pgsql: internal error: "
- ^ "Incorrect number of columns returned from query: "
- ^ original_query ^ ". Columns are: "
- ^ String.concat "; "
- (List.map
- (function
- | Some str -> Printf.sprintf "%S" str
- | None -> "NULL")
- row)
- in
- raise (PGOCaml.Error msg))
- _rows)) )
- (function _ :: _ -> Lwt.return_true | [] -> Lwt.return_false)
+ match
+ without_transaction @@ fun dbh ->
+ PGOCaml.bind
+ (let dbh = dbh in
+ let params : string option list list =
+ [ [ Some
+ ((let open PGOCaml in
+ string_of_string)
+ number) ] ]
+ in
+ let split =
+ [ `Text "SELECT 1 FROM ocsigen_start.phones WHERE number = "
+ ; `Var ("number", false, false) ]
+ in
+ let i = ref 0 in
+ let j = ref 0 in
+ let query =
+ String.concat ""
+ (List.map
+ (function
+ | `Text text -> text
+ | `Var (_varname, false, _) ->
+ let () = incr i in
+ let () = incr j in
+ "$" ^ string_of_int j.contents
+ | `Var (_varname, true, _) ->
+ let param = List.nth params i.contents in
+ let () = incr i in
+ "("
+ ^ String.concat ","
+ (List.map
+ (fun _ ->
+ let () = incr j in
+ "$" ^ string_of_int j.contents)
+ param)
+ ^ ")")
+ split)
+ in
+ let params = List.flatten params in
+ let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
+ let hash =
+ try PGOCaml.private_data dbh
+ with Not_found ->
+ let hash = Hashtbl.create 17 in
+ PGOCaml.set_private_data dbh hash;
+ hash
+ in
+ let is_prepared = Hashtbl.mem hash name in
+ PGOCaml.bind
+ (if not is_prepared
+ then
+ PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ()) (fun () ->
+ Hashtbl.add hash name true; PGOCaml.return ())
+ else PGOCaml.return ())
+ (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
+ (fun _rows ->
+ PGOCaml.return
+ (let original_query =
+ "SELECT 1 FROM ocsigen_start.phones WHERE number = $number"
+ in
+ List.rev_map
+ (fun row ->
+ match row with
+ | c0 :: [] ->
+ PGOCaml_aux.Option.map
+ (let open PGOCaml in
+ int32_of_string)
+ c0
+ | _ ->
+ let msg =
+ "ppx_pgsql: internal error: "
+ ^ "Incorrect number of columns returned from query: "
+ ^ original_query ^ ". Columns are: "
+ ^ String.concat "; "
+ (List.map
+ (function
+ | Some str -> Printf.sprintf "%S" str
+ | None -> "NULL")
+ row)
+ in
+ raise (PGOCaml.Error msg))
+ _rows))
+ with
+ | _ :: _ -> true
+ | [] -> false
let userid number =
- Lwt.bind
- ( without_transaction @@ fun dbh ->
- PGOCaml.bind
- (let dbh = dbh in
- let params : string option list list =
- [ [ Some
- ((let open PGOCaml in
- string_of_string)
- number) ] ]
- in
- let split =
- [ `Text "SELECT userid FROM ocsigen_start.phones WHERE number = "
- ; `Var ("number", false, false) ]
- in
- let i = ref 0 in
- let j = ref 0 in
- let query =
- String.concat ""
- (List.map
- (function
- | `Text text -> text
- | `Var (_varname, false, _) ->
- let () = incr i in
- let () = incr j in
- "$" ^ string_of_int j.contents
- | `Var (_varname, true, _) ->
- let param = List.nth params i.contents in
- let () = incr i in
- "("
- ^ String.concat ","
- (List.map
- (fun _ ->
- let () = incr j in
- "$" ^ string_of_int j.contents)
- param)
- ^ ")")
- split)
- in
- let params = List.flatten params in
- let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
- let hash =
- try PGOCaml.private_data dbh
- with Not_found ->
- let hash = Hashtbl.create 17 in
- PGOCaml.set_private_data dbh hash;
- hash
- in
- let is_prepared = Hashtbl.mem hash name in
- PGOCaml.bind
- (if not is_prepared
- then
- PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ()) (fun () ->
- Hashtbl.add hash name true; PGOCaml.return ())
- else PGOCaml.return ())
- (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
- (fun _rows ->
- PGOCaml.return
- (let original_query =
- "SELECT userid FROM ocsigen_start.phones WHERE number = $number"
- in
- List.rev_map
- (fun row ->
- match row with
- | c0 :: [] ->
- (let open PGOCaml in
- int64_of_string)
- (try PGOCaml_aux.Option.get c0
- with _ ->
- failwith
- "ppx_pgsql's nullability heuristic has failed - use \"nullable-results\"")
- | _ ->
- let msg =
- "ppx_pgsql: internal error: "
- ^ "Incorrect number of columns returned from query: "
- ^ original_query ^ ". Columns are: "
- ^ String.concat "; "
- (List.map
- (function
- | Some str -> Printf.sprintf "%S" str
- | None -> "NULL")
- row)
- in
- raise (PGOCaml.Error msg))
- _rows)) )
- (function
- | userid :: _ -> Lwt.return (Some userid) | [] -> Lwt.return None)
+ match
+ without_transaction @@ fun dbh ->
+ PGOCaml.bind
+ (let dbh = dbh in
+ let params : string option list list =
+ [ [ Some
+ ((let open PGOCaml in
+ string_of_string)
+ number) ] ]
+ in
+ let split =
+ [ `Text "SELECT userid FROM ocsigen_start.phones WHERE number = "
+ ; `Var ("number", false, false) ]
+ in
+ let i = ref 0 in
+ let j = ref 0 in
+ let query =
+ String.concat ""
+ (List.map
+ (function
+ | `Text text -> text
+ | `Var (_varname, false, _) ->
+ let () = incr i in
+ let () = incr j in
+ "$" ^ string_of_int j.contents
+ | `Var (_varname, true, _) ->
+ let param = List.nth params i.contents in
+ let () = incr i in
+ "("
+ ^ String.concat ","
+ (List.map
+ (fun _ ->
+ let () = incr j in
+ "$" ^ string_of_int j.contents)
+ param)
+ ^ ")")
+ split)
+ in
+ let params = List.flatten params in
+ let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in
+ let hash =
+ try PGOCaml.private_data dbh
+ with Not_found ->
+ let hash = Hashtbl.create 17 in
+ PGOCaml.set_private_data dbh hash;
+ hash
+ in
+ let is_prepared = Hashtbl.mem hash name in
+ PGOCaml.bind
+ (if not is_prepared
+ then
+ PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ()) (fun () ->
+ Hashtbl.add hash name true; PGOCaml.return ())
+ else PGOCaml.return ())
+ (fun () -> PGOCaml.execute_rev dbh ~name ~params ()))
+ (fun _rows ->
+ PGOCaml.return
+ (let original_query =
+ "SELECT userid FROM ocsigen_start.phones WHERE number = $number"
+ in
+ List.rev_map
+ (fun row ->
+ match row with
+ | c0 :: [] ->
+ (let open PGOCaml in
+ int64_of_string)
+ (try PGOCaml_aux.Option.get c0
+ with _ ->
+ failwith
+ "ppx_pgsql's nullability heuristic has failed - use \"nullable-results\"")
+ | _ ->
+ let msg =
+ "ppx_pgsql: internal error: "
+ ^ "Incorrect number of columns returned from query: "
+ ^ original_query ^ ". Columns are: "
+ ^ String.concat "; "
+ (List.map
+ (function
+ | Some str -> Printf.sprintf "%S" str
+ | None -> "NULL")
+ row)
+ in
+ raise (PGOCaml.Error msg))
+ _rows))
+ with
+ | userid :: _ -> Some userid
+ | [] -> None
let delete userid number =
without_transaction @@ fun dbh ->
diff --git a/src/os_db.mli b/src/os_db.mli
index cfc8ae55..65b3cdd1 100644
--- a/src/os_db.mli
+++ b/src/os_db.mli
@@ -55,7 +55,7 @@ val pwd_crypt_ref :
(** This module is used for low-level email management with database. *)
module Email : sig
- val available : string -> bool Lwt.t
+ val available : string -> bool
(** [available email] returns [true] if [email] is not already used. Else, it
returns [false].
*)
@@ -65,19 +65,19 @@ end
module User : sig
exception Invalid_action_link_key of Os_types.User.id
- val userid_of_email : string -> Os_types.User.id Lwt.t
+ val userid_of_email : string -> Os_types.User.id
(** [userid_of_email email] returns the userid of the user which has the email
[email]. *)
- val is_registered : string -> bool Lwt.t
+ val is_registered : string -> bool
(** [is_registered email] returns [true] if the email is already registered.
Else, it returns [false]. *)
- val is_email_validated : Os_types.User.id -> string -> bool Lwt.t
+ val is_email_validated : Os_types.User.id -> string -> bool
(** [is_email_validated userid email] returns [true] if [email] has been
validated by the user with id [userid]. *)
- val set_email_validated : Os_types.User.id -> string -> unit Lwt.t
+ val set_email_validated : Os_types.User.id -> string -> unit
(** [set_email_validated userid email] valids [email] for the user with id
[userid]. *)
@@ -94,19 +94,19 @@ module User : sig
-> userid:Os_types.User.id
-> email:string
-> unit
- -> unit Lwt.t
+ -> unit
- val add_preregister : string -> unit Lwt.t
+ val add_preregister : string -> unit
(** [add_preregister email] preregisters [email] in the database. *)
- val remove_preregister : string -> unit Lwt.t
+ val remove_preregister : string -> unit
(** [remove_preregister email] removes [email] from the database. *)
- val is_preregistered : string -> bool Lwt.t
+ val is_preregistered : string -> bool
(** [is_preregistered email] returns [true] if [email] is already
registered. Else, it returns [false]. *)
- val all : ?limit:int64 -> unit -> string list Lwt.t
+ val all : ?limit:int64 -> unit -> string list
(** [all ?limit ()] get all email addresses with a limit of [limit] (default
is 10). *)
@@ -118,7 +118,7 @@ module User : sig
-> firstname:string
-> lastname:string
-> unit
- -> Os_types.User.id Lwt.t
+ -> Os_types.User.id
(** [create ?password ?avatar ?language ~firstname ~lastname email] creates a new user
in the database and returns the userid of the new user.
Email, first name, last name and language are mandatory to create a new
@@ -134,37 +134,34 @@ module User : sig
-> firstname:string
-> lastname:string
-> Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [update ?password ?avatar ?language ~firstname ~lastname userid] updates the user
profile with [userid].
If [password] is passed as an empty string, it fails with the message
["empty password"]. TODO: change it to an exception?
*)
- val update_password : userid:Os_types.User.id -> password:string -> unit Lwt.t
+ val update_password : userid:Os_types.User.id -> password:string -> unit
(** [update_password ~userid ~new_password] updates the password of the user
with ID [userid].
If [password] is passed as an empty string, it fails with the message
["empty password"]. TODO: change it to an exception?
*)
- val update_avatar : userid:Os_types.User.id -> avatar:string -> unit Lwt.t
+ val update_avatar : userid:Os_types.User.id -> avatar:string -> unit
(** [update_avatar ~userid ~avatar] updates the avatar of the user
with ID [userid]. *)
- val update_main_email : userid:Os_types.User.id -> email:string -> unit Lwt.t
+ val update_main_email : userid:Os_types.User.id -> email:string -> unit
(** [update_main_email ~userid ~email] updates the main email of the user
with ID [userid]. *)
- val update_language : userid:Os_types.User.id -> language:string -> unit Lwt.t
+ val update_language : userid:Os_types.User.id -> language:string -> unit
(** [update_language ~userid ~language] updates the language of the user with
ID [userid].
*)
- val verify_password :
- email:string
- -> password:string
- -> Os_types.User.id Lwt.t
+ val verify_password : email:string -> password:string -> Os_types.User.id
(** [verify_password ~email ~password] returns the userid if user with email
[email] is registered with the password [password].
If [password] the password is wrong,
@@ -178,7 +175,7 @@ module User : sig
val verify_password_phone :
number:string
-> password:string
- -> Os_types.User.id Lwt.t
+ -> Os_types.User.id
(** [verify_password_phone ~number ~password]
returns the userid if user
who owns [number] and whose password is [password].
@@ -190,13 +187,7 @@ module User : sig
val user_of_userid :
Os_types.User.id
- -> (Os_types.User.id
- * string
- * string
- * string option
- * bool
- * string option)
- Lwt.t
+ -> Os_types.User.id * string * string * string option * bool * string option
(** [user_of_userid userid] returns a tuple [(userid, firstname, lastname,
avatar, bool_password, language)] describing the information about
the user with ID [userid].
@@ -205,51 +196,46 @@ module User : sig
If there is no such user, it fails with {!No_such_resource}.
*)
- val get_actionlinkkey_info : string -> Os_types.Action_link_key.info Lwt.t
+ val get_actionlinkkey_info : string -> Os_types.Action_link_key.info
(** [get_actionlinkkey_info key] returns the information about the
action link [key] as a type {!Os_types.Action_link_key.info}. *)
- val emails_of_userid : Os_types.User.id -> string list Lwt.t
+ val emails_of_userid : Os_types.User.id -> string list
(** [emails_of_userid userid] returns all emails registered for the user with
ID [userid].
If there is no user with [userid] as ID, it fails with
{!No_such_resource}.
*)
- val emails_of_userid_with_status :
- Os_types.User.id
- -> (string * bool) list Lwt.t
+ val emails_of_userid_with_status : Os_types.User.id -> (string * bool) list
(** Like [emails_of_userid], but also returns validation
status. This way we perform fewer DB queries. *)
- val email_of_userid : Os_types.User.id -> string option Lwt.t
+ val email_of_userid : Os_types.User.id -> string option
(** [email_of_userid userid] returns the main email registered for the user
with ID [userid].
If there is no such user, it fails with
{!No_such_resource}.
*)
- val is_main_email : userid:Os_types.User.id -> email:string -> bool Lwt.t
+ val is_main_email : userid:Os_types.User.id -> email:string -> bool
(** [is_main_email ~email ~userid] returns [true] if the main email of the
user with ID [userid] is [email].
If there is no such user or if [email] is not the main
email, it returns [false].
*)
- val add_email_to_user : userid:Os_types.User.id -> email:string -> unit Lwt.t
+ val add_email_to_user : userid:Os_types.User.id -> email:string -> unit
(** [add_email_to_user ~userid ~email] add [email] to user with ID [userid].
*)
- val remove_email_from_user :
- userid:Os_types.User.id
- -> email:string
- -> unit Lwt.t
+ val remove_email_from_user : userid:Os_types.User.id -> email:string -> unit
(** [remove_email_from_user ~userid ~email] removes the email [email] from the
emails list of user with ID [userid].
If [email] is the main email, it fails with {!Main_email_removal_attempt}.
*)
- val get_language : Os_types.User.id -> string option Lwt.t
+ val get_language : Os_types.User.id -> string option
(** [get_language userid] returns the language of the user with ID [userid] *)
val get_users :
@@ -262,7 +248,6 @@ module User : sig
* bool
* string option)
list
- Lwt.t
(** [get_users ~pattern ()] returns all users matching the pattern [pattern]
as a tuple [(userid, firstname, lastname, avatar, bool_password,
language)].
@@ -271,13 +256,11 @@ end
(** This module is low-level and used to manage groups of user. *)
module Groups : sig
- val create : ?description:string -> string -> unit Lwt.t
+ val create : ?description:string -> string -> unit
(** [create ?description name] creates a new group with name [name] and with
description [description]. *)
- val group_of_name :
- string
- -> (Os_types.Group.id * string * string option) Lwt.t
+ val group_of_name : string -> Os_types.Group.id * string * string option
(** [group_of_name name] returns a tuple [(groupid, name, description)]
describing the group.
If no group has the name [name], it fails with {!No_such_resource}.
@@ -286,14 +269,14 @@ module Groups : sig
val add_user_in_group :
groupid:Os_types.Group.id
-> userid:Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [add_user_in_group ~groupid ~userid] adds the user with ID [userid] in the
group with ID [groupid] *)
val remove_user_in_group :
groupid:Os_types.Group.id
-> userid:Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [remove_user_in_group ~groupid ~userid] removes the user with ID [userid]
in the group with ID [groupid] *)
@@ -302,32 +285,32 @@ module Groups : sig
-> groupid:Os_types.Group.id
-> userid:Os_types.User.id
-> unit
- -> bool Lwt.t
+ -> bool
(** [in_group ~groupid ~userid] returns [true] if the user with ID [userid] is
in the group with ID [groupid]. *)
- val all : unit -> (Os_types.Group.id * string * string option) list Lwt.t
+ val all : unit -> (Os_types.Group.id * string * string option) list
(** [all ()] returns all groups as list of tuple [(groupid, name,
description)]. *)
end
(** Manage user phone numbers *)
module Phone : sig
- val add : int64 -> string -> bool Lwt.t
+ val add : int64 -> string -> bool
(** [add userid number] associates [number] with the user
[userid]. Returns [true] on success. *)
- val exists : string -> bool Lwt.t
+ val exists : string -> bool
(** Does the number exist in the database? *)
- val userid : string -> Os_types.User.id option Lwt.t
+ val userid : string -> Os_types.User.id option
(** The user corresponding to a phone number (if any). *)
- val delete : int64 -> string -> unit Lwt.t
+ val delete : int64 -> string -> unit
(** [delete userid number] deletes [number], which has to be
associated to [userid]. *)
- val get_list : int64 -> string list Lwt.t
+ val get_list : int64 -> string list
(** [get_list userid] returns the list of number associated to the
user. *)
end
diff --git a/src/os_db.ppx.ml b/src/os_db.ppx.ml
index e61c5233..e538c848 100644
--- a/src/os_db.ppx.ml
+++ b/src/os_db.ppx.ml
@@ -18,7 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
include Os_core_db
exception No_such_resource
@@ -29,11 +28,9 @@ exception Empty_password
exception Main_email_removal_attempt
exception Account_not_activated
-let ( >>= ) = Lwt.bind
-
(*****************************************************************************)
-let one f ~success ~fail q = f q >>= function r :: _ -> success r | _ -> fail
+let one f ~success ~fail q = match f q with r :: _ -> success r | _ -> fail ()
let pwd_crypt_ref =
ref
@@ -44,8 +41,8 @@ let pwd_crypt_ref =
module Email = struct
let available email =
one without_transaction
- ~success:(fun _ -> Lwt.return_false)
- ~fail:Lwt.return_true
+ ~success:(fun _ -> false)
+ ~fail:(fun () -> true)
(fun dbh ->
[%pgsql
dbh
@@ -60,8 +57,8 @@ module User = struct
let userid_of_email email =
one without_transaction
- ~success:(fun userid -> Lwt.return userid)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun userid -> userid)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
[%pgsql
dbh
@@ -70,16 +67,17 @@ module User = struct
WHERE email = $email"])
let is_registered email =
- Lwt.catch
- (fun () ->
- let* _ = userid_of_email email in
- Lwt.return_true)
- (function No_such_resource -> Lwt.return_false | exc -> Lwt.reraise exc)
+ try
+ ignore (userid_of_email email);
+ true
+ with
+ | No_such_resource -> false
+ | exc -> raise exc
let is_email_validated userid email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
[%pgsql
dbh
@@ -131,8 +129,8 @@ module User = struct
let is_preregistered email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
[%pgsql
dbh "SELECT 1 FROM ocsigen_start.preregister WHERE email = $email"])
@@ -143,38 +141,38 @@ module User = struct
let create ?password ?avatar ?language ?email ~firstname ~lastname () =
if password = Some ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
full_transaction_block (fun dbh ->
let password_o =
Eliom_lib.Option.map (fun p -> fst !pwd_crypt_ref p) password
in
- let* userid =
- Lwt.bind
+ let userid =
+ match
[%pgsql
dbh
"INSERT INTO ocsigen_start.users\n\ (firstname, lastname, main_email, password, avatar, language)\n\ VALUES ($firstname, $lastname, $?email,\n\ $?password_o, $?avatar, $?language)\n\ RETURNING userid"]
- (function
- | [userid] -> Lwt.return userid
- | _ -> assert false)
+ with
+ | [userid] -> userid
+ | _ -> assert false)
in
- let* () =
- match email with
- | Some email ->
- let* () =
- [%pgsql
- dbh
- "INSERT INTO ocsigen_start.emails (email, userid)
- VALUES ($email, $userid)"]
- in
- remove_preregister0 dbh email
- | None -> Lwt.return_unit
+ match email with
+ | Some email ->
+ match
+ [%pgsql
+ dbh
+ "INSERT INTO ocsigen_start.emails (email, userid)
+ VALUES ($email, $userid)"]
+ with
+ | _ -> ()
+ remove_preregister0 dbh email
+ | None -> ()
in
- Lwt.return userid)
+ userid)
let update ?password ?avatar ?language ~firstname ~lastname userid =
if password = Some ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
let password =
match password with
@@ -194,7 +192,7 @@ module User = struct
let update_password ~userid ~password =
if password = ""
- then Lwt.fail_with "empty password"
+ then failwith "empty password"
else
let password = fst !pwd_crypt_ref password in
without_transaction @@ fun dbh ->
@@ -228,7 +226,7 @@ module User = struct
let verify_password ~email ~password =
if password = ""
- then Lwt.fail Empty_password
+ then failwith "empty password"
else
one without_transaction
(fun dbh ->
@@ -246,15 +244,15 @@ module User = struct
match password' with
| Some password' when snd !pwd_crypt_ref userid password password' ->
if validated
- then Lwt.return userid
- else Lwt.fail Account_not_activated
- | Some _ -> Lwt.fail Wrong_password
- | _ -> Lwt.fail Password_not_set)
- ~fail:(Lwt.fail No_such_user)
+ then userid
+ else raise Account_not_activated
+ | Some _ -> raise Wrong_password
+ | _ -> raise Password_not_set)
+ ~fail:(raise No_such_user)
let verify_password_phone ~number ~password =
if password = ""
- then Lwt.fail Empty_password
+ then failwith "empty password"
else
one without_transaction
(fun dbh ->
@@ -267,24 +265,23 @@ module User = struct
~success:(fun (userid, password') ->
match password' with
| Some password' when snd !pwd_crypt_ref userid password password' ->
- Lwt.return userid
- | Some _ -> Lwt.fail Wrong_password
- | _ -> Lwt.fail Password_not_set)
- ~fail:(Lwt.fail No_such_user)
+ userid
+ | Some _ -> raise Wrong_password
+ | _ -> raise Password_not_set)
+ ~fail:(fun () -> raise No_such_user)
let user_of_userid userid =
one without_transaction
~success:
(fun
(userid, firstname, lastname, avatar, has_password, language) ->
- Lwt.return
( userid
, firstname
, lastname
, avatar
, has_password = Some true
, language ))
- ~fail:(Lwt.fail No_such_resource)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
[%pgsql
dbh
@@ -296,7 +293,7 @@ module User = struct
full_transaction_block (fun dbh ->
one
(fun q -> q dbh)
- ~fail:(Lwt.fail No_such_resource)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
[%pgsql
dbh
@@ -313,7 +310,7 @@ module User = struct
| c -> `Custom c
in
let v = max 0L (Int64.pred validity) in
- let* () =
+ let () =
(* We provide a grace period of 20 seconds before expiring the
key, in case the link is successively opened several times *)
if v = 0L
@@ -331,7 +328,6 @@ module User = struct
"UPDATE ocsigen_start.activation
SET validity = $v WHERE activationkey = $act_key"]
in
- Lwt.return
Os_types.Action_link_key.
{userid; email; validity; expiry; action; data; autoconnect}))
@@ -348,8 +344,8 @@ module User = struct
let email_of_userid userid =
one without_transaction
- ~success:(fun main_email -> Lwt.return main_email)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun main_email -> main_email)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
[%pgsql
dbh
@@ -357,8 +353,8 @@ module User = struct
let is_main_email ~userid ~email =
one without_transaction
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
[%pgsql
dbh
@@ -373,9 +369,9 @@ module User = struct
VALUES ($email, $userid)"]
let remove_email_from_user ~userid ~email =
- let* b = is_main_email ~userid ~email in
+ let b = is_main_email ~userid ~email in
if b
- then Lwt.fail Main_email_removal_attempt
+ then raise Main_email_removal_attempt
else
without_transaction @@ fun dbh ->
[%pgsql
@@ -385,14 +381,14 @@ module User = struct
let get_language userid =
one without_transaction
- ~success:(fun language -> Lwt.return language)
- ~fail:(Lwt.fail No_such_resource)
+ ~success:(fun language -> language)
+ ~fail:(fun () -> raise No_such_resource)
(fun dbh ->
[%pgsql
dbh "SELECT language FROM ocsigen_start.users WHERE userid = $userid"])
let get_users ?pattern () =
- let* l =
+ let l =
without_transaction (fun dbh ->
match pattern with
| None ->
@@ -411,16 +407,15 @@ module User = struct
WHERE firstname <> '' -- avoids email addresses
AND CONCAT_WS(' ', firstname, lastname) ~* $pattern"])
in
- Lwt.return
- (List.map
- (fun (userid, firstname, lastname, avatar, has_password, language) ->
- ( userid
- , firstname
- , lastname
- , avatar
- , has_password = Some true
- , language ))
- l)
+ List.map
+ (fun (userid, firstname, lastname, avatar, has_password, language) ->
+ ( userid
+ , firstname
+ , lastname
+ , avatar
+ , has_password = Some true
+ , language ))
+ l
end
module Groups = struct
@@ -439,8 +434,8 @@ module Groups = struct
"SELECT groupid, name, description
FROM ocsigen_start.groups WHERE name = $name"])
>>= function
- | [r] -> Lwt.return r
- | _ -> Lwt.fail No_such_resource
+ | [r] -> r
+ | _ -> raise No_such_resource
let add_user_in_group ~groupid ~userid =
without_transaction @@ fun dbh ->
@@ -461,8 +456,8 @@ module Groups = struct
(match dbh with
| None -> without_transaction
| Some dbh -> fun f -> f dbh)
- ~success:(fun _ -> Lwt.return_true)
- ~fail:Lwt.return_false
+ ~success:(fun _ -> true)
+ ~fail:(fun () -> false)
(fun dbh ->
[%pgsql
dbh
@@ -477,7 +472,7 @@ end
module Phone = struct
let add userid number =
without_transaction @@ fun dbh ->
- let* l =
+ let l =
[%pgsql
dbh
"INSERT INTO ocsigen_start.phones (number, userid)
@@ -485,23 +480,21 @@ module Phone = struct
ON CONFLICT DO NOTHING
RETURNING 0"]
in
- Lwt.return (match l with [_] -> true | _ -> false)
+ (match l with [_] -> true | _ -> false)
let exists number =
- Lwt.bind
- ( without_transaction @@ fun dbh ->
- [%pgsql dbh "SELECT 1 FROM ocsigen_start.phones WHERE number = $number"]
- )
- (function _ :: _ -> Lwt.return_true | [] -> Lwt.return_false)
+ ( without_transaction @@ fun dbh ->
+ [%pgsql dbh "SELECT 1 FROM ocsigen_start.phones WHERE number = $number"]
+ )
+ >>= (function _ :: _ -> true | [] -> false)
let userid number =
- Lwt.bind
- ( without_transaction @@ fun dbh ->
- [%pgsql
- dbh "SELECT userid FROM ocsigen_start.phones WHERE number = $number"]
- )
- (function
- | userid :: _ -> Lwt.return (Some userid) | [] -> Lwt.return None)
+ ( without_transaction @@ fun dbh ->
+ [%pgsql
+ dbh "SELECT userid FROM ocsigen_start.phones WHERE number = $number"]
+ )
+ >>= (function
+ | userid :: _ -> Some userid | [] -> None)
let delete userid number =
without_transaction @@ fun dbh ->
diff --git a/src/os_email.eliom b/src/os_email.eliom
index 63c81560..dba6fa00 100644
--- a/src/os_email.eliom
+++ b/src/os_email.eliom
@@ -53,8 +53,7 @@ let default_send ?url:_ ~from_addr ~to_addrs ~subject:_ content =
echo "]";
printf "[content]:\n%s\n" content;
echo "Please set your own sendmail function using Os_email.set_send";
- flush ();
- Lwt.return ()
+ flush ()
let send_ref = ref default_send
diff --git a/src/os_email.eliomi b/src/os_email.eliomi
index 2c395e30..34ca4430 100644
--- a/src/os_email.eliomi
+++ b/src/os_email.eliomi
@@ -51,7 +51,7 @@ val send :
-> to_addrs:(string * string) list
-> subject:string
-> string list
- -> unit Lwt.t
+ -> unit
(** Send an e-mail to [to_addrs] from [from_addr]. You have to define the
[subject] of your email. The body of the email is a list of strings
and each element of the list is automatically separated by a new line.
@@ -64,7 +64,7 @@ val set_send :
-> to_addrs:(string * string) list
-> subject:string
-> string list
- -> unit Lwt.t)
+ -> unit)
-> unit
(** Customize email sending function. See {!send} for more details about the
arguments.
diff --git a/src/os_fcm_notif.eliom b/src/os_fcm_notif.eliom
index 2820601a..8a1a4394 100644
--- a/src/os_fcm_notif.eliom
+++ b/src/os_fcm_notif.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-
exception FCM_empty_response
exception FCM_no_json_response of string
exception FCM_missing_field of string
@@ -346,20 +344,20 @@ module Response = struct
if an error occurred.
*)
let t_of_http_response (r, b) =
- Lwt.catch
- (fun () ->
- let status = Cohttp.(Code.code_of_status (Response.status r)) in
- let* b = Cohttp_lwt.Body.to_string b in
- Yojson.Safe.from_string b |> Yojson.Safe.to_basic |> t_of_json status
- |> Lwt.return)
- (function
- (* Could be the case if the server key is wrong or if it's not
+ try
+ let status = Cohttp.(Code.code_of_status (Response.status r)) in
+ let b =
+ let buf = Buffer.create 1024 in
+ Eio.Flow.copy b (Eio.Flow.buffer_sink buf);
+ Buffer.contents buf
+ in
+ Yojson.Safe.from_string b |> Yojson.Safe.to_basic |> t_of_json status
+ with
+ (* Could be the case if the server key is wrong or if it's not
registered only in FCM and not in FCM (since September 2016).
*)
- | Yojson.Json_error _ ->
- Lwt.fail
- (FCM_no_json_response "It could come from your server key.")
- | exc -> Lwt.reraise exc)
+ | Yojson.Json_error _ ->
+ raise (FCM_no_json_response "It could come from your server key.")
let multicast_id_of_t response = response.multicast_id
let success_of_t response = response.success
@@ -373,13 +371,17 @@ let send server_key notification ?(data = Data.empty ()) options =
and headers =
Cohttp.Header.of_list
["Authorization", "key=" ^ server_key; "Content-Type", "application/json"]
- (* Data is optional, so we use an option type and a pattern matching *)
and body =
`Assoc
(("notification", Notification.to_json notification)
:: ("data", Data.to_json data)
:: Options.to_list options)
- |> Yojson.Safe.to_string |> Cohttp_lwt.Body.of_string
+ |> Yojson.Safe.to_string |> Cohttp_eio.Body.of_string
+ in
+ let sw = Option.get (Eio.Fiber.get Ocsigen_lib.current_switch) in
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ let client = Cohttp_eio.Client.make ~https:None env#net in
+ let response =
+ Cohttp_eio.Client.call client ~headers ~body ~sw `POST gcm_url
in
- let* response = Cohttp_lwt_unix.Client.call ~headers ~body `POST gcm_url in
Response.t_of_http_response response
diff --git a/src/os_fcm_notif.eliomi b/src/os_fcm_notif.eliomi
index 52960d0d..7df35ee6 100644
--- a/src/os_fcm_notif.eliomi
+++ b/src/os_fcm_notif.eliomi
@@ -448,10 +448,5 @@ module Response : sig
(** [results_of_t response] returns the status of the messages processed. *)
end
-val send :
- string
- -> Notification.t
- -> ?data:Data.t
- -> Options.t
- -> Response.t Lwt.t
+val send : string -> Notification.t -> ?data:Data.t -> Options.t -> Response.t
(** [send server_key notification options] *)
diff --git a/src/os_group.ml b/src/os_group.ml
index b44da362..ad60b526 100644
--- a/src/os_group.ml
+++ b/src/os_group.ml
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-
exception No_such_group
type id = Os_types.Group.id [@@deriving json]
@@ -44,35 +42,26 @@ module MCache = Os_request_cache.Make (struct
let compare = compare
let get key =
- Lwt.catch
- (fun () ->
- let* g = Os_db.Groups.group_of_name key in
- Lwt.return (create_group_from_db g))
- (function
- | Os_db.No_such_resource -> Lwt.fail No_such_group
- | exc -> Lwt.reraise exc)
+ try
+ let g = Os_db.Groups.group_of_name key in
+ create_group_from_db g
+ with Os_db.No_such_resource -> raise No_such_group
end)
(** Helper function which creates a new group and return it as
* a record of type [Os_types.Group.t]. *)
let create ?description name =
let group_of_name name =
- let* g = Os_db.Groups.group_of_name name in
- Lwt.return (create_group_from_db g)
+ let g = Os_db.Groups.group_of_name name in
+ create_group_from_db g
in
- Lwt.catch
- (fun () -> group_of_name name)
- (function
- | Os_db.No_such_resource ->
- let* () = Os_db.Groups.create ?description name in
- Lwt.catch
- (fun () ->
- let* g = group_of_name name in
- Lwt.return g)
- (function
- | Os_db.No_such_resource -> Lwt.fail No_such_group
- | exc -> Lwt.reraise exc)
- | exc -> Lwt.reraise exc)
+ try group_of_name name
+ with Os_db.No_such_resource -> (
+ let () = Os_db.Groups.create ?description name in
+ try
+ let g = group_of_name name in
+ g
+ with Os_db.No_such_resource -> raise No_such_group)
(* Should never happen *)
(** Overwrite the function [group_of_name] of [Os_db.Group] and use
@@ -98,5 +87,5 @@ let in_group ?dbh ~(group : Os_types.Group.t) ~userid () =
(** Returns all the groups of the database. *)
let all () =
- let* groups = Os_db.Groups.all () in
- Lwt.return (List.map create_group_from_db groups)
+ let groups = Os_db.Groups.all () in
+ List.map create_group_from_db groups
diff --git a/src/os_group.mli b/src/os_group.mli
index b32c583f..06e4adb9 100644
--- a/src/os_group.mli
+++ b/src/os_group.mli
@@ -50,11 +50,11 @@ val name_of_group : Os_types.Group.t -> string
val desc_of_group : Os_types.Group.t -> string option
(** [desc_of_group group] returns the group description. *)
-val create : ?description:string -> string -> Os_types.Group.t Lwt.t
+val create : ?description:string -> string -> Os_types.Group.t
(** [create ~description name] creates a new group in the database and returns
it as a record of type [Os_types.Group.t]. *)
-val group_of_name : string -> Os_types.Group.t Lwt.t
+val group_of_name : string -> Os_types.Group.t
(** Overwrites the function [group_of_name] of [Os_db.Group] and use
the [get] function of the cache module. *)
@@ -69,25 +69,25 @@ val group_of_name : string -> Os_types.Group.t Lwt.t
val add_user_in_group :
group:Os_types.Group.t
-> userid:Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [add_user_in_group ~group ~userid] adds the user with ID [userid] to
[group]. *)
val remove_user_in_group :
group:Os_types.Group.t
-> userid:Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [remove_user_in_group ~group ~userid] removes the user with ID [userid] from
[group]. *)
val in_group :
- ?dbh:Os_db.PGOCaml.pa_pg_data Os_db.PGOCaml.t
+ ?dbh:PGOCaml.pa_pg_data PGOCaml.t
-> group:Os_types.Group.t
-> userid:Os_types.User.id
-> unit
- -> bool Lwt.t
+ -> bool
(** [in_group ~group ~userid] returns [true] if the user with ID [userid] is in
[group]. *)
-val all : unit -> Os_types.Group.t list Lwt.t
+val all : unit -> Os_types.Group.t list
(** [all ()] returns all the groups of the database. *)
diff --git a/src/os_handlers.eliom b/src/os_handlers.eliom
index cdcde01b..82e24d0d 100644
--- a/src/os_handlers.eliom
+++ b/src/os_handlers.eliom
@@ -1,3 +1,5 @@
+open Eio.Std
+
(* Ocsigen-start
* http://www.ocsigen.org/ocsigen-start
*
@@ -20,7 +22,6 @@
(** Registration of default services *)
-open%shared Lwt.Syntax
open%client Eliom_content.Html.F
open%client Js_of_ocaml
@@ -38,11 +39,9 @@ let%server
(((firstname, lastname), (pwd, pwd2)) as pd)
=
if firstname = "" || lastname = "" || pwd <> pwd2
- then (
- Eliom_reference.Volatile.set Os_msg.wrong_pdata (Some pd);
- Lwt.return_unit)
+ then Eliom_reference.Volatile.set Os_msg.wrong_pdata (Some pd)
else
- let* user = Os_user.user_of_userid myid in
+ let user = Os_user.user_of_userid myid in
let open Os_types.User in
let record = {user with fn = firstname; ln = lastname} in
Os_user.update' ~password:pwd record
@@ -50,15 +49,13 @@ let%server
(* Set password handler *)
let%server set_password_handler myid () (pwd, pwd2) =
if pwd <> pwd2
- then (
- Os_msg.msg ~level:`Err ~onload:true "Passwords do not match";
- Lwt.return_unit)
+ then Os_msg.msg ~level:`Err ~onload:true "Passwords do not match"
else
- let* user = Os_user.user_of_userid myid in
+ let user = Os_user.user_of_userid myid in
Os_user.update' ~password:pwd user
(* Set password RPC *)
-let%rpc set_password_rpc myid (p : string * string) : unit Lwt.t =
+let%rpc set_password_rpc myid (p : string * string) : unit =
set_password_handler myid () p
let%server
@@ -81,13 +78,14 @@ let%server
then print_endline ("Debug: action link created: " ^ act_link);
if send_email
then
- Lwt.async (fun () ->
- Lwt.catch
- (fun () ->
+ Fiber.fork
+ ~sw:(Stdlib.Option.get (Fiber.get Ocsigen_lib.current_switch))
+ (fun () ->
+ try
Os_email.send
~to_addrs:["", email]
- ~subject:"creation" ~url:act_link [text])
- (fun _ -> Lwt.return_unit));
+ ~subject:"creation" ~url:act_link [text]
+ with _ -> ());
act_key
(** For default value of [autoconnect], cf. [Os_user.add_actionlinkkey]. *)
@@ -104,11 +102,11 @@ let%server
=
let act_key = generate_action_link_key ~service ~text:msg email in
Eliom_reference.Volatile.set Os_msg.action_link_key_created true;
- let* () =
+ let () =
Os_user.add_actionlinkkey ?autoconnect ?action ?validity ?expiry ~act_key
~userid ~email ()
in
- Lwt.return_unit
+ ()
(* Sign up *)
let%server sign_up_handler () email =
@@ -120,52 +118,42 @@ let%server sign_up_handler () email =
~expiry:CalendarLib.Calendar.(add (now ()) (Period.hour 1))
~autoconnect:true msg Os_services.main_service email userid
in
- Lwt.catch
- (fun () ->
- let* user = Os_user.create ~firstname:"" ~lastname:"" ~email () in
- let userid = Os_user.userid_of_user user in
- Os_msg.msg ~onload:true ~level:`Msg ~duration:6.
- "An e-mail was sent to this address. Click on the link it contains to activate your account.";
- send_action_link email userid)
- (function
- | Os_user.Already_exists userid ->
- let*
- (* If email is not validated, the user never logged in,
+ try
+ let user = Os_user.create ~firstname:"" ~lastname:"" ~email () in
+ let userid = Os_user.userid_of_user user in
+ Os_msg.msg ~onload:true ~level:`Msg ~duration:6.
+ "An e-mail was sent to this address. Click on the link it contains to activate your account.";
+ send_action_link email userid
+ with Os_user.Already_exists userid ->
+ let
+ (* If email is not validated, the user never logged in,
I send an action link, as if it were a new user. *)
- validated
- =
- Os_db.User.is_email_validated userid email
- in
- if not validated
- then send_action_link email userid
- else (
- Eliom_reference.Volatile.set Os_user.user_already_exists true;
- Os_msg.msg ~level:`Err ~onload:true "E-mail already exists";
- Lwt.return_unit)
- | exc -> Lwt.reraise exc)
-
-let%rpc sign_up_handler_rpc (email : string) : unit Lwt.t =
- sign_up_handler () email
+ validated
+ =
+ Os_db.User.is_email_validated userid email
+ in
+ if not validated
+ then send_action_link email userid
+ else (
+ Eliom_reference.Volatile.set Os_user.user_already_exists true;
+ Os_msg.msg ~level:`Err ~onload:true "E-mail already exists")
+let%rpc sign_up_handler_rpc (email : string) : unit = sign_up_handler () email
let%client sign_up_handler () v = sign_up_handler_rpc v
(* Forgot password *)
let%server forgot_password_handler service () email =
- Lwt.catch
- (fun () ->
- let* userid = Os_user.userid_of_email email in
- let msg = "Hi,\r\nTo set a new password, please click on this link: " in
- Os_msg.msg ~level:`Msg ~onload:true
- "An email was sent to this address. Click on the link it contains to reset your password.";
- send_action_link ~autoconnect:true ~action:`PasswordReset ~validity:1L
- ~expiry:CalendarLib.Calendar.(add (now ()) (Period.hour 1))
- msg service email userid)
- (function
- | Os_db.No_such_resource ->
- Eliom_reference.Volatile.set Os_user.user_does_not_exist true;
- Os_msg.msg ~level:`Err ~onload:true "User does not exist";
- Lwt.return_unit
- | exc -> Lwt.reraise exc)
+ try
+ let userid = Os_user.userid_of_email email in
+ let msg = "Hi,\r\nTo set a new password, please click on this link: " in
+ Os_msg.msg ~level:`Msg ~onload:true
+ "An email was sent to this address. Click on the link it contains to reset your password.";
+ send_action_link ~autoconnect:true ~action:`PasswordReset ~validity:1L
+ ~expiry:CalendarLib.Calendar.(add (now ()) (Period.hour 1))
+ msg service email userid
+ with Os_db.No_such_resource ->
+ Eliom_reference.Volatile.set Os_user.user_does_not_exist true;
+ Os_msg.msg ~level:`Err ~onload:true "User does not exist"
let%client restart ?url () =
(* Restart the client.
@@ -197,7 +185,7 @@ let%client restart ?url () =
If [main_page] is true, it goes to the main page.
*)
let disconnect_handler ?(main_page = false) () () =
- let*
+ let
(* SECURITY: no check here because we disconnect the session cookie owner. *)
()
=
@@ -213,8 +201,7 @@ let disconnect_handler ?(main_page = false) () () =
Some
(make_uri ~absolute:true ~service:Eliom_service.reload_action ()))
()
- : unit)];
- Lwt.return_unit
+ : unit)]
let%rpc disconnect_handler_rpc (main_page : bool) =
disconnect_handler ~main_page () ()
@@ -224,32 +211,27 @@ let%client disconnect_handler ?(main_page = false) () () =
(* Connection *)
let connect_handler () ((login, pwd), keepmeloggedin) =
- Lwt.catch
- (fun () ->
- let*
- (* SECURITY: no check here. *)
- userid
- =
- Os_user.verify_password ~email:login ~password:pwd
- in
- let* () = disconnect_handler () () in
- Os_session.connect ~expire:(not keepmeloggedin) userid)
- (function
- | Os_db.Account_not_activated ->
- Eliom_reference.Volatile.set Os_user.account_not_activated true;
- Os_msg.msg ~level:`Err ~onload:true "Account not activated";
- Lwt.return_unit
- | Os_db.Empty_password | Os_db.Password_not_set | Os_db.Wrong_password ->
- Eliom_reference.Volatile.set Os_user.wrong_password true;
- Os_msg.msg ~level:`Err ~onload:true "Wrong password";
- Lwt.return_unit
- | Os_db.No_such_user ->
- Eliom_reference.Volatile.set Os_user.no_such_user true;
- Os_msg.msg ~level:`Err ~onload:true "No such user";
- Lwt.return_unit
- | exc -> Lwt.reraise exc)
-
-let%rpc connect_handler_rpc (v : (string * string) * bool) : unit Lwt.t =
+ try
+ let
+ (* SECURITY: no check here. *)
+ userid
+ =
+ Os_user.verify_password ~email:login ~password:pwd
+ in
+ let () = disconnect_handler () () in
+ Os_session.connect ~expire:(not keepmeloggedin) userid
+ with
+ | Os_db.Account_not_activated ->
+ Eliom_reference.Volatile.set Os_user.account_not_activated true;
+ Os_msg.msg ~level:`Err ~onload:true "Account not activated"
+ | Os_db.Empty_password | Os_db.Password_not_set | Os_db.Wrong_password ->
+ Eliom_reference.Volatile.set Os_user.wrong_password true;
+ Os_msg.msg ~level:`Err ~onload:true "Wrong password"
+ | Os_db.No_such_user ->
+ Eliom_reference.Volatile.set Os_user.no_such_user true;
+ Os_msg.msg ~level:`Err ~onload:true "No such user"
+
+let%rpc connect_handler_rpc (v : (string * string) * bool) : unit =
connect_handler () v
let%client connect_handler () v = connect_handler_rpc v
@@ -277,67 +259,62 @@ let%rpc action_link_handler_common myid_o (akey : string) :
| `No_such_resource
| `Reload
| `Restart_if_app ]
- Lwt.t
=
- Lwt.catch
- (fun () ->
- let open Os_types.Action_link_key in
- let* ({userid; email; validity; expiry; action; data = _; autoconnect} as
- action_link)
- =
- Os_user.get_actionlinkkey_info akey
- in
- let* () =
- if action = `AccountActivation && validity <= 0L
- then
- match myid_o with
- | Some myid ->
- Lwt.fail
- (Account_already_activated_connected (action_link, myid))
- | None ->
- Lwt.fail (Account_already_activated_unconnected action_link)
- else Lwt.return_unit
- in
- let outdated =
- match expiry with
- | None -> false
- | Some e -> e <= CalendarLib.Calendar.now ()
- in
- let* () =
- if validity <= 0L || outdated
- then Lwt.fail (Invalid_action_key action_link)
- else Lwt.return_unit
- in
- let* () =
- if action = `AccountActivation || action = `PasswordReset
- then Os_db.User.set_email_validated userid email
- else Lwt.return_unit
- in
- if autoconnect && myid_o <> Some userid
- then
- let* () = Os_session.connect userid in
- Lwt.return `Restart_if_app
- else
- match action with
- | `Custom _s ->
- let* existing_user = Os_db.User.is_email_validated userid email in
- Lwt.return (`Custom_action_link (action_link, not existing_user))
- | _ -> Lwt.return `Reload)
- (function
- | Os_db.No_such_resource -> Lwt.return `No_such_resource
- | Invalid_action_key action_link ->
- Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
- Lwt.return (`Invalid_action_key action_link)
- | Account_already_activated_unconnected action_link ->
- Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
- Lwt.return (`Account_already_activated_unconnected action_link)
- | Account_already_activated_connected (_action_link, _) ->
- Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
- (* Just reload the page without the GET parameters to get rid of the key.
+ try
+ let open Os_types.Action_link_key in
+ let ({userid; email; validity; expiry; action; data = _; autoconnect} as
+ action_link)
+ =
+ Os_user.get_actionlinkkey_info akey
+ in
+ let () =
+ if action = `AccountActivation && validity <= 0L
+ then
+ match myid_o with
+ | Some myid ->
+ raise (Account_already_activated_connected (action_link, myid))
+ | None -> raise (Account_already_activated_unconnected action_link)
+ else ()
+ in
+ let outdated =
+ match expiry with
+ | None -> false
+ | Some e -> e <= CalendarLib.Calendar.now ()
+ in
+ let () =
+ if validity <= 0L || outdated
+ then raise (Invalid_action_key action_link)
+ else ()
+ in
+ let () =
+ if action = `AccountActivation || action = `PasswordReset
+ then Os_db.User.set_email_validated userid email
+ else ()
+ in
+ if autoconnect && myid_o <> Some userid
+ then
+ let () = Os_session.connect userid in
+ `Restart_if_app
+ else
+ match action with
+ | `Custom _s ->
+ let existing_user = Os_db.User.is_email_validated userid email in
+ `Custom_action_link (action_link, not existing_user)
+ | _ -> `Reload
+ with
+ | Os_db.No_such_resource -> `No_such_resource
+ | Invalid_action_key action_link ->
+ Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
+ `Invalid_action_key action_link
+ | Account_already_activated_unconnected action_link ->
+ Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
+ `Account_already_activated_unconnected action_link
+ | Account_already_activated_connected (_action_link, _) ->
+ Eliom_reference.Volatile.set Os_user.action_link_key_outdated true;
+ (* Just reload the page without the GET parameters to get rid of the key.
If the user wasn't already logged in, let the exception pass to the
next exception handler. *)
- Lwt.return `Reload
- | exc -> Lwt.reraise exc)
+ `Reload
let%client restart_if_client_side () =
restart
@@ -347,33 +324,32 @@ let%client restart_if_client_side () =
let%server restart_if_client_side () = ()
let%shared action_link_handler _myid_o akey () =
- let* a = action_link_handler_common akey in
+ let a = action_link_handler_common akey in
match a with
| `Reload ->
Eliom_registration.(
appl_self_redirect Redirection.send
(Redirection Eliom_service.reload_action))
- | `No_such_resource -> Lwt.fail No_such_resource
- | `Invalid_action_key action_link -> Lwt.fail (Invalid_action_key action_link)
+ | `No_such_resource -> raise No_such_resource
+ | `Invalid_action_key action_link -> raise (Invalid_action_key action_link)
| `Restart_if_app ->
restart_if_client_side ();
Eliom_registration.(appl_self_redirect Action.send) ()
| `Custom_action_link (action_link, phantom_user) ->
- Lwt.fail (Custom_action_link (action_link, phantom_user))
+ raise (Custom_action_link (action_link, phantom_user))
| `Account_already_activated_unconnected action_link ->
- Lwt.fail (Account_already_activated_unconnected action_link)
+ raise (Account_already_activated_unconnected action_link)
(* Preregister *)
let preregister_handler () email =
- let* is_preregistered = Os_user.is_preregistered email in
- let* is_registered = Os_user.is_registered email in
+ let is_preregistered = Os_user.is_preregistered email in
+ let is_registered = Os_user.is_registered email in
Printf.printf "%b:%b%!\n" is_preregistered is_registered;
if not (is_preregistered || is_registered)
then Os_user.add_preregister email
else (
Eliom_reference.Volatile.set Os_user.user_already_preregistered true;
- Os_msg.msg ~level:`Err ~onload:true "E-mail already preregistered";
- Lwt.return_unit)
+ Os_msg.msg ~level:`Err ~onload:true "E-mail already preregistered")
(* Add email *)
let add_email_handler =
@@ -387,41 +363,36 @@ let add_email_handler =
| None -> Os_services.main_service)
in
let add_email myid () email =
- let* available = Os_db.Email.available email in
+ let available = Os_db.Email.available email in
if available
then
- let* () = Os_db.User.add_email_to_user ~userid:myid ~email in
+ let () = Os_db.User.add_email_to_user ~userid:myid ~email in
send_act () email myid
- else (
- Eliom_reference.Volatile.set Os_user.user_already_exists true;
- Lwt.return_unit)
+ else Eliom_reference.Volatile.set Os_user.user_already_exists true
in
Os_session.connected_fun add_email
-let%rpc add_email_rpc (email : string) : unit Lwt.t = add_email_handler () email
+let%rpc add_email_rpc (email : string) : unit = add_email_handler () email
let%client add_email_handler () = add_email_rpc
let%shared _ = Os_comet.__link (* to make sure os_comet is linked *)
let%client input_popup ?(button_label = "OK") f =
- let w, u = Lwt.wait () in
+ let w, u = Eio.Promise.create () in
let content close =
let open Eliom_content.Html in
let button = D.button ~a:[D.a_class ["button"]] [D.txt button_label] in
let inp =
- let f code =
- let* () = close () in
- Lwt.wakeup u (); f code
- in
+ let f code = close (); Eio.Promise.resolve u (); f code in
Os_lib.lwt_bound_input_enter ~button f
in
- Lwt.return (D.div [button; inp])
+ D.div [button; inp]
in
- let* _ = Ot_popup.popup ~close_button:[Os_icons.F.close ()] content in
- w
+ let _ = Ot_popup.popup ~close_button:[Os_icons.F.close ()] content in
+ Eio.Promise.await w
let%client confirm_code_popup ~dest f =
input_popup @@ fun code ->
- let* b = f code in
+ let b = f code in
if b
then
let service =
@@ -431,10 +402,8 @@ let%client confirm_code_popup ~dest f =
in
match service with
| Some service -> Eliom_client.change_page ~service () ()
- | None -> Lwt.fail_with "confirm_popup: settings service unknown"
- else (
- Os_msg.msg ~level:`Err ~duration:2. "Wrong SMS activation code";
- Lwt.return_unit)
+ | None -> failwith "confirm_popup: settings service unknown"
+ else Os_msg.msg ~level:`Err ~duration:2. "Wrong SMS activation code"
(* We only need confirm_code_*_service to implement the activation
UI. Assuming normal user behavior, we will only ever call them via
@@ -443,22 +412,18 @@ let%client confirm_code_popup ~dest f =
client. Until we fix Eliom, we define dummy server-side
handlers. *)
let%server confirm_code_handler _ _ =
- Lwt.fail_with
- "Os_handlers.confirm_code_*_handler not implemented on the server"
+ failwith "Os_handlers.confirm_code_*_handler not implemented on the server"
let%server confirm_code_signup_handler = confirm_code_handler
let%server confirm_code_extra_handler = confirm_code_handler
let%server confirm_code_recovery_handler = confirm_code_handler
let%client request_activation_code_wrapper number f =
- Lwt.bind (Os_connect_phone.request_code number) (function
- | Ok () -> f ()
- | Error `Ownership ->
- Os_msg.msg ~level:`Err ~duration:2. "Phone taken";
- Lwt.return_unit
- | Error (`Unknown | `Send | `Limit | `Invalid_number) ->
- Os_msg.msg ~level:`Err ~duration:2. "SMS error";
- Lwt.return_unit)
+ match Os_connect_phone.request_code number with
+ | Ok () -> f ()
+ | Error `Ownership -> Os_msg.msg ~level:`Err ~duration:2. "Phone taken"
+ | Error (`Unknown | `Send | `Limit | `Invalid_number) ->
+ Os_msg.msg ~level:`Err ~duration:2. "SMS error"
let%client
confirm_code_signup_handler () (first_name, (last_name, (password, number)))
@@ -472,10 +437,9 @@ let%client confirm_code_extra_handler () number =
confirm_code_popup ~dest:`Settings Os_connect_phone.confirm_code_extra
let%client confirm_code_recovery_handler () number =
- Lwt.bind (Os_connect_phone.request_recovery_code number) (function
- | Ok () ->
- confirm_code_popup ~dest:`Settings
- Os_connect_phone.confirm_code_recovery
- | Error (`Unknown | `Send | `Limit | _) ->
- Os_msg.msg ~level:`Err ~duration:2. "SMS error";
- Lwt.return ())
+ match Os_connect_phone.request_recovery_code number with
+ | Ok () ->
+ confirm_code_popup ~dest:`Settings
+ Os_connect_phone.confirm_code_recovery
+ | Error (`Unknown | `Send | `Limit | _) ->
+ Os_msg.msg ~level:`Err ~duration:2. "SMS error"
diff --git a/src/os_handlers.eliomi b/src/os_handlers.eliomi
index e73bf7ae..0a8cf0f7 100644
--- a/src/os_handlers.eliomi
+++ b/src/os_handlers.eliomi
@@ -25,18 +25,18 @@
{!Os_services}.
*)
-val connect_handler : unit -> (string * string) * bool -> unit Lwt.t
+val connect_handler : unit -> (string * string) * bool -> unit
(** [connect_handler () ((login, password), keepMeLoggedIn)] connects the user
with [login] and [password] and keeps the user logged in between different
session if [keepMeLoggedIn] is set to [true]. *)
-val disconnect_handler : ?main_page:bool -> unit -> unit -> unit Lwt.t
+val disconnect_handler : ?main_page:bool -> unit -> unit -> unit
(** [disconnect_handler ?main_page () ()] disconnects the current user. *)
-val sign_up_handler : unit -> string -> unit Lwt.t
+val sign_up_handler : unit -> string -> unit
(** [sign_up_handler () email] signes up an user with email [email]. *)
-val add_email_handler : unit -> string -> unit Lwt.t
+val add_email_handler : unit -> string -> unit
(** [add_email_handler () email] adds a new e-mail address
for the current user and sends an activation link.
Eliom reference [Os_user.user_already_exists] is set
@@ -71,7 +71,7 @@ val action_link_handler :
int64 option
-> string
-> unit
- -> 'a Eliom_registration.application_content Eliom_registration.kind Lwt.t
+ -> 'a Eliom_registration.application_content Eliom_registration.kind
(** [action_link_handler userid_o activation_key ()] is the handler for
activation keys.
@@ -83,18 +83,18 @@ val action_link_handler :
val confirm_code_signup_handler :
unit
-> string * (string * (string * string))
- -> unit Lwt.t
+ -> unit
(** [confirm_code_signup_handler () (first_name, (last_name, (pass,
number)))] sends a verification code to [number], displays a popup
for confirming the code, and creates the account if all goes
well. *)
-val confirm_code_extra_handler : unit -> string -> unit Lwt.t
+val confirm_code_extra_handler : unit -> string -> unit
(** [confirm_code_extra_handler () number] is like
[confirm_code_signup_handler] but for adding an additional number to
the account. The new phone is added to the account. *)
-val confirm_code_recovery_handler : unit -> string -> unit Lwt.t
+val confirm_code_recovery_handler : unit -> string -> unit
(** [confirm_code_recovery_handler () number] is like
[confirm_code_signup_handler] but for recovering a lost
password. The user is redirected to the settings page for setting
@@ -117,21 +117,17 @@ val forgot_password_handler :
Eliom_service.t
-> unit
-> string
- -> unit Lwt.t
+ -> unit
(** [forgot_password_handler service () email] creates and sends an action link
to [email] if the user forgot his password and redirects to [service].
If [email] doesn't correspond to any user, {!Os_user.user_does_not_exist}
is set to [true] and {!Os_msg.msg} is called with the level [`Err].
*)
-val preregister_handler : unit -> string -> unit Lwt.t
+val preregister_handler : unit -> string -> unit
(** [preregister_handler () email] preregisters the email [email]. *)
-val set_password_handler :
- Os_types.User.id
- -> unit
- -> string * string
- -> unit Lwt.t
+val set_password_handler : Os_types.User.id -> unit -> string * string -> unit
(** [set_password_handler userid () (password, confirmation_password)] updates
the password of the user with ID [userid] with the hashed value of
[password] if [confirmation_password] corresponds to [password]. If they
@@ -142,14 +138,14 @@ val set_personal_data_handler :
Os_types.User.id
-> unit
-> (string * string) * (string * string)
- -> unit Lwt.t
+ -> unit
(** [set_personal_data_handler userid () ((firstname, lastname), (password,
confirmation_password))] sets the corresponding data to given values.
*)
[%%client.start]
-val set_password_rpc : string * string -> unit Lwt.t
+val set_password_rpc : string * string -> unit
(** [set_password_rpc (password, confirmation_password)] is a RPC to
[set_password].
*)
diff --git a/src/os_lib.eliom b/src/os_lib.eliom
index 7a89e72c..30269fda 100644
--- a/src/os_lib.eliom
+++ b/src/os_lib.eliom
@@ -18,9 +18,8 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%shared Lwt.Syntax
open%client Js_of_ocaml
-open%client Js_of_ocaml_lwt
+open%client Js_of_ocaml_eio
let%client reload () =
Eliom_client.change_page ~replace:true
@@ -30,11 +29,11 @@ let%shared memoizator f =
let value_ref = ref None in
fun () ->
match !value_ref with
- | Some value -> Lwt.return value
+ | Some value -> value
| None ->
- let* value = f () in
+ let value = f () in
value_ref := Some value;
- Lwt.return value
+ value
let%shared string_repeat s n =
let b = Buffer.create (n * String.length s) in
@@ -132,9 +131,9 @@ module Email_or_phone = struct
end
let%client on_enter ~f inp =
- Lwt.async @@ fun () ->
- Lwt_js_events.keydowns inp @@ fun ev _ ->
- if ev##.keyCode = 13 then f (Js.to_string inp##.value) else Lwt.return_unit
+ Eio_js.start @@ fun () ->
+ Eio_js_events.keydowns inp (fun ev ->
+ if ev##.keyCode = 13 then f (Js.to_string inp##.value))
(* TODO: Build a nice Ot_form module with such functions *)
let%shared
@@ -142,13 +141,13 @@ let%shared
?(validate : (string -> bool) Eliom_client_value.t option)
?button
(e : Html_types.input Eliom_content.Html.elt)
- (f : (string -> unit Lwt.t) Eliom_client_value.t)
+ (f : (string -> unit) Eliom_client_value.t)
=
ignore
[%client
(let e = Eliom_content.Html.To_dom.of_input ~%e in
let f =
- let f = ~%(f : (string -> unit Lwt.t) Eliom_client_value.t) in
+ let f = ~%(f : (string -> unit) Eliom_client_value.t) in
match ~%validate with
| Some validate ->
fun v ->
@@ -165,9 +164,9 @@ let%shared
option)
with
| Some button ->
- Lwt.async @@ fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element button)
- @@ fun _ _ -> f (Js.to_string e##.value)
+ Eio_js.start @@ fun () ->
+ Eio_js_events.clicks (Eliom_content.Html.To_dom.of_element button)
+ (fun _ -> f (Js.to_string e##.value))
| None -> ()
: unit)]
@@ -180,13 +179,11 @@ let%shared lwt_bound_input_enter ?(a = []) ?button ?validate f =
module Http = struct
let string_of_stream ?(len = 16384) contents =
- Lwt.try_bind
- (fun () ->
- Ocsigen_stream.string_of_stream len (Ocsigen_stream.get contents))
- (fun r ->
- let* () = Ocsigen_stream.finalize contents `Success in
- Lwt.return r)
- (fun e ->
- let* () = Ocsigen_stream.finalize contents `Failure in
- Lwt.fail e)
+ match Ocsigen_stream.string_of_stream len (Ocsigen_stream.get contents) with
+ | r ->
+ let () = Ocsigen_stream.finalize contents `Success in
+ r
+ | exception e ->
+ let () = Ocsigen_stream.finalize contents `Failure in
+ raise e
end
diff --git a/src/os_lib.eliomi b/src/os_lib.eliomi
index 02c61e4c..8d46ff76 100644
--- a/src/os_lib.eliomi
+++ b/src/os_lib.eliomi
@@ -23,7 +23,7 @@
[%%client.start]
-val reload : unit -> unit Lwt.t
+val reload : unit -> unit
(** [reload ()] reloads the current page. *)
[%%shared.start]
@@ -54,7 +54,7 @@ end
val phone_regexp : Re.Str.regexp
val email_regexp : Re.Str.regexp
-val memoizator : (unit -> 'a Lwt.t) -> unit -> 'a Lwt.t
+val memoizator : (unit -> 'a) -> unit -> 'a
(** [memoizator f ()] caches the returned value of [f ()] *)
val string_repeat : string -> int -> string
@@ -64,7 +64,7 @@ val lwt_bound_input_enter :
?a:[< Html_types.input_attrib] Eliom_content.Html.attrib list
-> ?button:[< Html_types.button] Eliom_content.Html.elt
-> ?validate:(string -> bool) Eliom_client_value.t
- -> (string -> unit Lwt.t) Eliom_client_value.t
+ -> (string -> unit) Eliom_client_value.t
-> [> `Input] Eliom_content.Html.elt
(** [lwt_bound_input_enter f] produces an input element bound to [f],
i.e., when the user submits the input, we call [f]. *)
@@ -73,7 +73,7 @@ val lwt_bind_input_enter :
?validate:(string -> bool) Eliom_client_value.t
-> ?button:[< Html_types.button | Html_types.input] Eliom_content.Html.elt
-> Html_types.input Eliom_content.Html.elt
- -> (string -> unit Lwt.t) Eliom_client_value.t
+ -> (string -> unit) Eliom_client_value.t
-> unit
(** [lwt_bound_input_enter inp f] calls f whenever the user submits
the contents of [inp]. *)
@@ -82,7 +82,7 @@ val lwt_bind_input_enter :
(** This module contains functions about HTTP request. *)
module Http : sig
- val string_of_stream : ?len:int -> string Ocsigen_stream.t -> string Lwt.t
+ val string_of_stream : ?len:int -> string Ocsigen_stream.t -> string
(** [string_of_stream ?len stream] creates a string of maximum length [len]
(default is [16384]) from the stream [stream].
*)
diff --git a/src/os_msg.eliom b/src/os_msg.eliom
index 3524fab0..c1244824 100644
--- a/src/os_msg.eliom
+++ b/src/os_msg.eliom
@@ -18,7 +18,7 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%client Lwt.Syntax
+open%client Js_of_ocaml_eio
open%client Eliom_content.Html
open%client Eliom_content.Html.F
open%client Js_of_ocaml
@@ -45,16 +45,15 @@ let%shared
[%client
(let c = if ~%level = `Msg then [] else ["os-err"] in
let message_dom = To_dom.of_p (D.p ~a:[a_class c] [txt ~%message]) in
- Lwt.async (fun () ->
- let* () =
- if ~%onload then Eliom_client.lwt_onload () else Lwt.return_unit
- in
+ Eio_js.start (fun () ->
+ (if ~%onload then
+ (* Wait for Eliom's onload event (not browser's load event) *)
+ Eio.Promise.await (Eliom_client.onload_promise ()));
let msgbox = msgbox () in
Logs.info (fun fmt -> fmt "%s" ~%message);
Dom.appendChild msgbox message_dom;
- let* () = Js_of_ocaml_lwt.Lwt_js.sleep ~%duration in
- Dom.removeChild msgbox message_dom;
- Lwt.return_unit)
+ Eio_js.sleep ~%duration;
+ Dom.removeChild msgbox message_dom)
: unit)]
let action_link_key_created =
diff --git a/src/os_notif.eliom b/src/os_notif.eliom
index ab7d26b2..a5d49b2b 100644
--- a/src/os_notif.eliom
+++ b/src/os_notif.eliom
@@ -1,3 +1,5 @@
+open%server Eio.Std
+
(* Ocsigen-start
* http://www.ocsigen.org/ocsigen-start
*
@@ -37,7 +39,7 @@ module type ARG = sig
type server_notif
type client_notif
- val prepare : User.id option -> server_notif -> client_notif option Lwt.t
+ val prepare : User.id option -> server_notif -> client_notif option
val equal_key : key -> key -> bool
val max_resource : int
val max_identity_per_resource : int
@@ -57,10 +59,7 @@ module Make (A : ARG) :
let prepare = A.prepare
let equal_key = A.equal_key
let equal_identity = ( = )
-
- let get_identity () =
- Lwt.return @@ Os_current_user.Opt.get_current_userid ()
-
+ let get_identity () = Os_current_user.Opt.get_current_userid ()
let max_resource = A.max_resource
let max_identity_per_resource = A.max_identity_per_resource
end)
@@ -70,12 +69,14 @@ module Make (A : ARG) :
Eliom_state.Ext.volatile_data_group_state
~scope:Eliom_common.default_group_scope (Int64.to_string userid)
in
- Lwt.async @@ fun () ->
- (* Iterating on all sessions in group: *)
- Eliom_state.Ext.iter_sub_states ?sitedata ~state @@ fun state ->
- (* Iterating on all client processes in session: *)
- Eliom_state.Ext.iter_sub_states ?sitedata ~state (fun state ->
- Ext.unlisten state id; Lwt.return_unit)
+ Fiber.fork
+ ~sw:(Stdlib.Option.get (Fiber.get Ocsigen_lib.current_switch))
+ (fun () ->
+ (* Iterating on all sessions in group: *)
+ Eliom_state.Ext.iter_sub_states ?sitedata ~state @@ fun state ->
+ (* Iterating on all client processes in session: *)
+ Eliom_state.Ext.iter_sub_states ?sitedata ~state (fun state ->
+ Ext.unlisten state id))
let notify ?notfor key notif =
let notfor =
@@ -88,7 +89,7 @@ module Make (A : ARG) :
let _ =
Os_session.on_start_process (fun _ -> init ());
- Os_session.on_post_close_session (fun () -> deinit (); Lwt.return_unit)
+ Os_session.on_post_close_session (fun () -> deinit ())
end
module type ARG_SIMPLE = sig
@@ -105,7 +106,7 @@ module Make_Simple (A : ARG_SIMPLE) :
type server_notif = A.notification
type client_notif = A.notification
- let prepare _ n = Lwt.return_some n
+ let prepare _ n = Some n
let equal_key = ( = )
let max_resource = 1000
let max_identity_per_resource = 10
diff --git a/src/os_notif.eliomi b/src/os_notif.eliomi
index bbd531b3..0a3e75ea 100644
--- a/src/os_notif.eliomi
+++ b/src/os_notif.eliomi
@@ -51,7 +51,7 @@ module type ARG = sig
type server_notif
type client_notif
- val prepare : User.id option -> server_notif -> client_notif option Lwt.t
+ val prepare : User.id option -> server_notif -> client_notif option
val equal_key : key -> key -> bool
val max_resource : int
val max_identity_per_resource : int
diff --git a/src/os_page.eliom b/src/os_page.eliom
index 1b6e6dea..448d9032 100644
--- a/src/os_page.eliom
+++ b/src/os_page.eliom
@@ -18,7 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%shared Lwt.Syntax
open%shared Eliom_content.Html.F
open%client Js_of_ocaml
@@ -52,22 +51,17 @@ module type PAGE = sig
val css : string list list
val local_css : string list list
val other_head : Html_types.head_content_fun Eliom_content.Html.elt list
- val default_error_page : 'a -> 'b -> exn -> content Lwt.t
+ val default_error_page : 'a -> 'b -> exn -> content
val default_connected_error_page :
Os_types.User.id option
-> 'a
-> 'b
-> exn
- -> content Lwt.t
+ -> content
- val default_predicate : 'a -> 'b -> bool Lwt.t
-
- val default_connected_predicate :
- Os_types.User.id option
- -> 'a
- -> 'b
- -> bool Lwt.t
+ val default_predicate : 'a -> 'b -> bool
+ val default_connected_predicate : Os_types.User.id option -> 'a -> 'b -> bool
end
module Default_config = struct
@@ -90,10 +84,10 @@ module Default_config = struct
p [txt "You must be connected to see this page."] :: de
| _ -> de
in
- Lwt.return (content [div ~a:[a_class ["errormsg"]] (h2 [txt "Error"] :: l)])
+ content [div ~a:[a_class ["errormsg"]] (h2 [txt "Error"] :: l)]
- let default_predicate _ _ = Lwt.return_true
- let default_connected_predicate _ _ _ = Lwt.return_true
+ let default_predicate _ _ = true
+ let default_connected_predicate _ _ _ = true
let default_error_page _ _ exn = err_page exn
let default_connected_error_page _ _ _ exn = err_page exn
end
@@ -157,16 +151,15 @@ module Make (C : PAGE) = struct
gp
pp
=
- let* content =
- Lwt.catch
- (fun () ->
- let* b = predicate gp pp in
- if b
- then Lwt.catch (fun () -> f gp pp) (fun exc -> fallback gp pp exc)
- else fallback gp pp (Predicate_failed None))
- (fun exc -> fallback gp pp (Predicate_failed (Some exc)))
+ let content =
+ try
+ let b = predicate gp pp in
+ if b
+ then try f gp pp with exc -> fallback gp pp exc
+ else fallback gp pp (Predicate_failed None)
+ with exc -> fallback gp pp (Predicate_failed (Some exc))
in
- Lwt.return (make_page content)
+ make_page content
let connected_page
?allow
@@ -178,31 +171,24 @@ module Make (C : PAGE) = struct
pp
=
let f_wrapped myid gp pp =
- Lwt.catch
- (fun () ->
- let* b = predicate (Some myid) gp pp in
- if b
- then
- Lwt.catch
- (fun () -> f myid gp pp)
- (fun exc -> fallback (Some myid) gp pp exc)
- else Lwt.fail (Predicate_failed None))
- (function
- | Predicate_failed _ as exc -> fallback (Some myid) gp pp exc
- | exc -> fallback (Some myid) gp pp (Predicate_failed (Some exc)))
+ try
+ let b = predicate (Some myid) gp pp in
+ if b
+ then try f myid gp pp with exc -> fallback (Some myid) gp pp exc
+ else raise (Predicate_failed None)
+ with
+ | Predicate_failed _ as exc -> fallback (Some myid) gp pp exc
+ | exc -> fallback (Some myid) gp pp (Predicate_failed (Some exc))
in
- let* content =
- Lwt.catch
- (fun () ->
- Os_session.connected_fun ?allow ?deny
- ~deny_fun:(fun myid_o ->
- fallback myid_o gp pp Os_session.Permission_denied)
- f_wrapped gp pp)
- (function
- | Os_session.Not_connected as exc -> fallback None gp pp exc
- | exc -> Lwt.reraise exc)
+ let content =
+ try
+ Os_session.connected_fun ?allow ?deny
+ ~deny_fun:(fun myid_o ->
+ fallback myid_o gp pp Os_session.Permission_denied)
+ f_wrapped gp pp
+ with Os_session.Not_connected as exc -> fallback None gp pp exc
in
- Lwt.return (make_page content)
+ make_page content
module Opt = struct
let connected_page
@@ -215,25 +201,21 @@ module Make (C : PAGE) = struct
pp
=
let f_wrapped (myid_o : Os_types.User.id option) gp pp =
- Lwt.catch
- (fun () ->
- let* b = predicate myid_o gp pp in
- if b
- then
- Lwt.catch
- (fun () -> f myid_o gp pp)
- (fun exc -> fallback myid_o gp pp exc)
- else Lwt.fail (Predicate_failed None))
- (function
- | Predicate_failed _ as exc -> fallback myid_o gp pp exc
- | exc -> fallback myid_o gp pp (Predicate_failed (Some exc)))
+ try
+ let b = predicate myid_o gp pp in
+ if b
+ then try f myid_o gp pp with exc -> fallback myid_o gp pp exc
+ else raise (Predicate_failed None)
+ with
+ | Predicate_failed _ as exc -> fallback myid_o gp pp exc
+ | exc -> fallback myid_o gp pp (Predicate_failed (Some exc))
in
- let* content =
+ let content =
Os_session.Opt.connected_fun ?allow ?deny
~deny_fun:(fun myid_o ->
fallback myid_o gp pp Os_session.Permission_denied)
f_wrapped gp pp
in
- Lwt.return (make_page content)
+ make_page content
end
end]
diff --git a/src/os_page.eliomi b/src/os_page.eliomi
index 84ab8943..a4c17f3f 100644
--- a/src/os_page.eliomi
+++ b/src/os_page.eliomi
@@ -70,7 +70,7 @@ module type PAGE = sig
(** [other_head] is a list of custom elements to add in the head section.
It can be used to add elements, for example. *)
- val default_error_page : 'a -> 'b -> exn -> content Lwt.t
+ val default_error_page : 'a -> 'b -> exn -> content
(** [default_error_page get_param post_param exn] is the default error page.
[get_param] (resp. [post_param]) is the GET (resp. POST) parameters sent
to the error page.
@@ -83,19 +83,15 @@ module type PAGE = sig
-> 'a
-> 'b
-> exn
- -> content Lwt.t
+ -> content
(** [default_connected_error_page userid_o get_param post_param exn] is the
default error page for connected pages.
*)
- val default_predicate : 'a -> 'b -> bool Lwt.t
+ val default_predicate : 'a -> 'b -> bool
(** [default_predicate get_param post_param] is the default predicate. *)
- val default_connected_predicate :
- Os_types.User.id option
- -> 'a
- -> 'b
- -> bool Lwt.t
+ val default_connected_predicate : Os_types.User.id option -> 'a -> 'b -> bool
(** [default_connected_predicate userid_o get_param post_param] is the default
predicate for connected pages.
*)
@@ -117,12 +113,12 @@ module Make (_ : PAGE) : sig
for this app *)
val page :
- ?predicate:('a -> 'b -> bool Lwt.t)
- -> ?fallback:('a -> 'b -> exn -> content Lwt.t)
- -> ('a -> 'b -> content Lwt.t)
+ ?predicate:('a -> 'b -> bool)
+ -> ?fallback:('a -> 'b -> exn -> content)
+ -> ('a -> 'b -> content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
(** Default wrapper for service handler generating pages.
It takes as parameter a function generating page content
(body content) and transforms it into a function generating
@@ -138,12 +134,12 @@ module Make (_ : PAGE) : sig
val connected_page :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool Lwt.t)
- -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> content Lwt.t)
- -> (Os_types.User.id option -> 'a -> 'b -> content Lwt.t)
+ -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool)
+ -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> content)
+ -> (Os_types.User.id option -> 'a -> 'b -> content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
(** Wrapper for pages that first checks if the user is connected.
See {!Os_session.Opt.connected_fun}.
*)
@@ -152,12 +148,12 @@ module Make (_ : PAGE) : sig
val connected_page :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool Lwt.t)
- -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> content Lwt.t)
- -> (Os_types.User.id -> 'a -> 'b -> content Lwt.t)
+ -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool)
+ -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> content)
+ -> (Os_types.User.id -> 'a -> 'b -> content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
(** Wrapper for pages that first checks if the user is connected.
See {!Os_session.connected_fun}.
*)
diff --git a/src/os_request_cache.eliom b/src/os_request_cache.eliom
index 2a62b498..297abf68 100644
--- a/src/os_request_cache.eliom
+++ b/src/os_request_cache.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-
module type Cache_sig = sig
type key
type value
@@ -27,7 +25,7 @@ module type Cache_sig = sig
val has : key -> bool
val set : key -> value -> unit
val reset : key -> unit
- val get : key -> value Lwt.t
+ val get : key -> value
end
module Make (M : sig
@@ -35,7 +33,7 @@ module Make (M : sig
type value
val compare : key -> key -> int
- val get : key -> value Lwt.t
+ val get : key -> value
end) =
struct
type key = M.key
@@ -74,9 +72,9 @@ struct
then M.get k (* Not during a request. No cache. *)
else
let table = Eliom_reference.Volatile.get cache in
- try Lwt.return (MMap.find k table)
+ try MMap.find k table
with Not_found ->
- let* ret = M.get k in
+ let ret = M.get k in
Eliom_reference.Volatile.set cache (MMap.add k ret table);
- Lwt.return ret
+ ret
end
diff --git a/src/os_request_cache.eliomi b/src/os_request_cache.eliomi
index bc3856b1..8ca1268e 100644
--- a/src/os_request_cache.eliomi
+++ b/src/os_request_cache.eliomi
@@ -37,7 +37,7 @@ module type Cache_sig = sig
val reset : key -> unit
(** Remove a [value] for the given key. *)
- val get : key -> value Lwt.t
+ val get : key -> value
(** Get the value corresponding to the given key. *)
end
@@ -53,7 +53,7 @@ module Make : functor
val compare : key -> key -> int
(** The function used to compare keys. *)
- val get : key -> value Lwt.t
+ val get : key -> value
(** This function is called when the value corresponding to a key
is not yet stored into the cache. *)
end)
diff --git a/src/os_session.eliom b/src/os_session.eliom
index c966f1cc..5b4e3e29 100644
--- a/src/os_session.eliom
+++ b/src/os_session.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-
let log_section = Logs.Src.create "os:session"
let user_indep_state_hierarchy = Eliom_common.create_scope_hierarchy "userindep"
let user_indep_process_scope = `Client_process user_indep_state_hierarchy
@@ -33,12 +31,12 @@ let new_process_eref =
Eliom_reference.Volatile.eref ~scope:user_indep_process_scope true
let mk_action_queue name =
- let r = ref (fun _ -> Lwt.return_unit) in
+ let r = ref (fun _ -> ()) in
( (fun f ->
let oldf = !r in
r :=
fun arg ->
- let* () = oldf arg in
+ let () = oldf arg in
f arg)
, fun arg ->
Logs.debug ~src:log_section (fun fmt ->
@@ -65,11 +63,11 @@ let on_start_process, start_process_action = mk_action_queue "start process"
let on_start_connected_process f =
on_start_process (fun myid_o ->
- match myid_o with Some myid -> f myid | None -> Lwt.return_unit)
+ match myid_o with Some myid -> f myid | None -> ())
let on_start_unconnected_process f =
on_start_process (fun myid_o ->
- match myid_o with Some _myid -> Lwt.return_unit | None -> f ())
+ match myid_o with Some _myid -> () | None -> f ())
[%%shared
exception Not_connected
@@ -86,24 +84,24 @@ let connect_volatile uid =
open_session_action uid
let connect_string uid =
- let* () =
+ let () =
Eliom_state.set_persistent_data_session_group
~scope:Eliom_common.default_session_scope uid
in
- let* () = connect_volatile uid in
+ let () = connect_volatile uid in
let uid = Int64.of_string uid in
start_process_action (Some uid)
let disconnect () =
- let* () = pre_close_session_action () in
- let* () = Eliom_state.discard ~scope:Eliom_common.default_session_scope () in
- let* () = Eliom_state.discard ~scope:Eliom_common.default_process_scope () in
- let* () = Eliom_state.discard ~scope:Eliom_common.request_scope () in
+ let () = pre_close_session_action () in
+ let () = Eliom_state.discard ~scope:Eliom_common.default_session_scope () in
+ let () = Eliom_state.discard ~scope:Eliom_common.default_process_scope () in
+ let () = Eliom_state.discard ~scope:Eliom_common.request_scope () in
post_close_session_action ()
let connect ?(expire = false) userid =
- let* () = disconnect () in
- let* () =
+ let () = disconnect () in
+ let () =
if expire
then (
let open Eliom_common in
@@ -111,13 +109,13 @@ let connect ?(expire = false) userid =
Eliom_state.set_service_cookie_exp_date ~cookie_scope None;
Eliom_state.set_volatile_data_cookie_exp_date ~cookie_scope None;
Eliom_state.set_persistent_data_cookie_exp_date ~cookie_scope None)
- else Lwt.return_unit
+ else ()
in
connect_string (Int64.to_string userid)
let set_warn_connection_change, warn_connection_changed =
let r = ref (fun _ -> ()) in
- (fun f -> r := f), fun state -> !r state; Lwt.return_unit
+ (fun f -> r := f), fun state -> !r state
let disconnect_all
?sitedata
@@ -127,9 +125,7 @@ let disconnect_all
()
=
let close_my_sessions = userid = None in
- let* () =
- if close_my_sessions then pre_close_session_action () else Lwt.return_unit
- in
+ let () = if close_my_sessions then pre_close_session_action () else () in
let userid =
match userid with
| None -> (
@@ -138,7 +134,7 @@ let disconnect_all
| Some userid -> Some userid
in
match userid with
- | None -> Lwt.return_unit
+ | None -> ()
| Some userid ->
(* We do not close the group, as it may contain user data.
We close all sessions from group instead. *)
@@ -151,23 +147,23 @@ let disconnect_all
; Eliom_state.Ext.service_group_state
~scope:Eliom_common.default_group_scope group_name ]
in
- let* ui_states =
+ let ui_states =
List.fold_left
(fun acc state ->
- Lwt.bind
- (Eliom_reference.Ext.get state
- (current_user_indep_session_state
- :> ( [< `Session_group | `Session | `Client_process]
- , [< `Data | `Pers] )
- Eliom_state.Ext.state
- option
- Eliom_reference.eref))
- (function
- | None -> acc
- | Some s ->
- let* acc = acc in
- Lwt.return (s :: acc)))
- Lwt.return_nil
+ match
+ Eliom_reference.Ext.get state
+ (current_user_indep_session_state
+ :> ( [< `Session_group | `Session | `Client_process]
+ , [< `Data | `Pers] )
+ Eliom_state.Ext.state
+ option
+ Eliom_reference.eref)
+ with
+ | None -> acc
+ | Some s ->
+ let acc = acc in
+ s :: acc)
+ []
(Eliom_state.Ext.fold_volatile_sub_states ?sitedata
~state:
(Eliom_state.Ext.volatile_data_group_state
@@ -175,89 +171,86 @@ let disconnect_all
(fun acc s -> s :: acc)
[])
in
- let*
+ let
(* Closing all sessions: *)
()
=
- Lwt_list.iter_s
+ List.iter
(fun state ->
Eliom_state.Ext.iter_sub_states ?sitedata ~state @@ fun state ->
Eliom_state.Ext.discard_state ?sitedata ~state ())
states
in
- let* () =
- if close_my_sessions
- then post_close_session_action ()
- else Lwt.return_unit
- in
- let*
+ let () = if close_my_sessions then post_close_session_action () else () in
+ let
(* Warn every client process that the session is closed: *)
()
=
- Lwt_list.iter_s
+ List.iter
(fun state ->
Eliom_state.Ext.iter_sub_states ?sitedata ~state
warn_connection_changed)
ui_states
in
- let*
+ let
(* Closing user_indep states, if requested: *)
()
=
if user_indep
then
- Lwt_list.iter_s
+ List.iter
(fun state -> Eliom_state.Ext.discard_state ?sitedata ~state ())
ui_states
- else Lwt.return_unit
+ else ()
in
let () =
if with_restart then ignore [%client (Os_handlers.restart () : unit)]
in
- Lwt.return_unit
+ ()
let check_allow_deny userid allow deny =
- let* b =
+ let b =
match allow with
- | None -> Lwt.return_true (* By default allow all *)
+ | None -> true
+ (* By default allow all *)
| Some l ->
- (* allow only users from one of the groups of list l *)
- Lwt_list.fold_left_s
+ List.fold_left
+ (* allow only users from one of the groups of list l *)
(fun b group ->
- let* b2 = Os_group.in_group ~userid ~group () in
- Lwt.return (b || b2))
+ let b2 = Os_group.in_group ~userid ~group () in
+ b || b2)
false l
in
- let* b =
+ let b =
match deny with
- | None -> Lwt.return b (* By default deny nobody *)
+ | None -> b (* By default deny nobody *)
| Some l ->
- (* allow only users that are not
+ List.fold_left
+ (* allow only users that are not
in one of the groups of list l *)
- Lwt_list.fold_left_s
(fun b group ->
- let* b2 = Os_group.in_group ~userid ~group () in
- Lwt.return (b && not b2))
+ let b2 = Os_group.in_group ~userid ~group () in
+ b && not b2)
b l
in
if b
- then Lwt.return_unit
+ then ()
else
- let* () = denied_request_action (Some userid) in
- Lwt.fail Permission_denied
+ let () = denied_request_action (Some userid) in
+ raise Permission_denied
let get_session () =
let uids = Eliom_state.get_volatile_data_session_group () in
let get_uid uid =
try Eliom_lib.Option.map Int64.of_string uid with Failure _ -> None
in
- let* uid =
+ let uid =
match get_uid uids with
| None -> (
- let* uids = Eliom_state.get_persistent_data_session_group () in
+ let uids = Eliom_state.get_persistent_data_session_group () in
match get_uid uids with
| Some uid ->
- let*
+ let
(* A persistent session exists, but the volatile session has gone.
It may be due to a timeout or may be the server has been
relaunched.
@@ -267,28 +260,25 @@ let get_session () =
=
connect_volatile (Int64.to_string uid)
in
- Lwt.return_some uid
- | None -> Lwt.return_none)
- | Some uid -> Lwt.return_some uid
+ Some uid
+ | None -> None)
+ | Some uid -> Some uid
in
(* Check if the user exists in the DB *)
match uid with
- | None -> Lwt.return_none
- | Some uid ->
- Lwt.catch
- (fun () ->
- let* _user = Os_user.user_of_userid uid in
- Lwt.return_some uid)
- (function
- | Os_user.No_such_user ->
- let*
- (* If session exists and no user in DB, close the session *)
- ()
- =
- disconnect ()
- in
- Lwt.return_none
- | exc -> Lwt.reraise exc)
+ | None -> None
+ | Some uid -> (
+ try
+ let _user = Os_user.user_of_userid uid in
+ Some uid
+ with Os_user.No_such_user ->
+ let
+ (* If session exists and no user in DB, close the session *)
+ ()
+ =
+ disconnect ()
+ in
+ None)
(** The connection wrapper checks whether the user is connected,
and calls the page generator accordingly.
@@ -315,7 +305,7 @@ let%server
~allow
~deny
?(force_unconnected = false)
- ?(deny_fun = fun _ -> Lwt.fail Permission_denied)
+ ?(deny_fun = fun _ -> raise Permission_denied)
connected
not_connected
gp
@@ -324,31 +314,32 @@ let%server
let new_process =
(not force_unconnected) && Eliom_reference.Volatile.get new_process_eref
in
- let* uid = if force_unconnected then Lwt.return_none else get_session () in
- let* () = request_action uid in
- let* () =
+ Printf.printf "[Os_session] gen_wrapper: new_process=%b\n%!" new_process;
+ let uid = if force_unconnected then None else get_session () in
+ let () = request_action uid in
+ let () =
if new_process
then (
+ Printf.printf "[Os_session] gen_wrapper: calling start_process_action\n%!";
Eliom_reference.Volatile.set new_process_eref false;
start_process_action uid)
- else Lwt.return_unit
+ else ()
in
match uid with
| None ->
if allow = None
then
- let* () = unconnected_request_action () in
+ let () = unconnected_request_action () in
not_connected gp pp
else
- let* () = denied_request_action None in
+ let () = denied_request_action None in
deny_fun None
- | Some id ->
- Lwt.catch
- (fun () ->
- let* () = check_allow_deny id allow deny in
- let* () = connected_request_action id in
- connected id gp pp)
- (function Permission_denied -> deny_fun uid | exc -> Lwt.reraise exc)
+ | Some id -> (
+ try
+ let () = check_allow_deny id allow deny in
+ let () = connected_request_action id in
+ connected id gp pp
+ with Permission_denied -> deny_fun uid)
let%client get_current_userid_o = ref (fun () -> assert false)
@@ -371,12 +362,12 @@ let%client
| Some myid -> connected myid gp pp
let%shared connected_fun ?allow ?deny ?deny_fun f gp pp =
- gen_wrapper ~allow ~deny ?deny_fun f (fun _ _ -> Lwt.fail Not_connected) gp pp
+ gen_wrapper ~allow ~deny ?deny_fun f (fun _ _ -> raise Not_connected) gp pp
let%shared connected_rpc ?allow ?deny ?deny_fun f pp =
gen_wrapper ~allow ~deny ?deny_fun
(fun myid _ p -> f myid p)
- (fun _ _ -> Lwt.fail Not_connected)
+ (fun _ _ -> raise Not_connected)
() pp
let%shared connected_wrapper ?allow ?deny ?deny_fun ?force_unconnected f pp =
diff --git a/src/os_session.eliomi b/src/os_session.eliomi
index 0858a0d2..24e5c1bc 100644
--- a/src/os_session.eliomi
+++ b/src/os_session.eliomi
@@ -22,39 +22,39 @@
restrict access to services or server functions,
define actions to be executed at some points of the session. *)
-val on_start_process : (Os_types.User.id option -> unit Lwt.t) -> unit
+val on_start_process : (Os_types.User.id option -> unit) -> unit
(** Call this to add an action to be done on server side
when the process starts *)
-val on_start_connected_process : (Os_types.User.id -> unit Lwt.t) -> unit
+val on_start_connected_process : (Os_types.User.id -> unit) -> unit
(** Call this to add an action to be done
when the process starts in connected mode, or when the user logs in *)
-val on_start_unconnected_process : (unit -> unit Lwt.t) -> unit
+val on_start_unconnected_process : (unit -> unit) -> unit
(** Call this to add an action to be done on server side
when the process starts but only when not in connected mode *)
-val on_connected_request : (Os_types.User.id -> unit Lwt.t) -> unit
+val on_connected_request : (Os_types.User.id -> unit) -> unit
(** Call this to add an action to be done at each connected request.
The function takes the user id as parameter. *)
-val on_unconnected_request : (unit -> unit Lwt.t) -> unit
+val on_unconnected_request : (unit -> unit) -> unit
(** Call this to add an action to be done at each unconnected request. *)
-val on_open_session : (Os_types.User.id -> unit Lwt.t) -> unit
+val on_open_session : (Os_types.User.id -> unit) -> unit
(** Call this to add an action to be done just after opening a session
The function takes the user id as parameter. *)
-val on_pre_close_session : (unit -> unit Lwt.t) -> unit
+val on_pre_close_session : (unit -> unit) -> unit
(** Call this to add an action to be done just before closing the session *)
-val on_post_close_session : (unit -> unit Lwt.t) -> unit
+val on_post_close_session : (unit -> unit) -> unit
(** Call this to add an action to be done just after closing the session *)
-val on_request : (Os_types.User.id option -> unit Lwt.t) -> unit
+val on_request : (Os_types.User.id option -> unit) -> unit
(** Call this to add an action to be done just before handling a request *)
-val on_denied_request : (Os_types.User.id option -> unit Lwt.t) -> unit
+val on_denied_request : (Os_types.User.id option -> unit) -> unit
(** Call this to add an action to be done just for each denied request.
The function takes the user id as parameter, if some user is connected. *)
@@ -74,7 +74,7 @@ exception Permission_denied
[%%server.start]
-val connect : ?expire:bool -> Os_types.User.id -> unit Lwt.t
+val connect : ?expire:bool -> Os_types.User.id -> unit
(** Close current session (if any) by calling disconnect,
then open a new session for a user by setting a session group for the browser
which initiated the current request.
@@ -91,7 +91,7 @@ val disconnect_all :
-> ?user_indep:bool
-> ?with_restart:bool
-> unit
- -> unit Lwt.t
+ -> unit
(** Close all sessions of current user (or [userid] if present).
If [?user_indep] is [true]
(default), will also affect [user_indep_session_scope].
@@ -109,7 +109,7 @@ val disconnect_all :
[%%client.start]
-val disconnect_all : ?user_indep:bool -> unit -> unit Lwt.t
+val disconnect_all : ?user_indep:bool -> unit -> unit
(** Close all sessions of current user.
If [?user_indep] is [true] (default),
will also affect [user_indep_session_scope].
@@ -117,7 +117,7 @@ val disconnect_all : ?user_indep:bool -> unit -> unit Lwt.t
[%%shared.start]
-val disconnect : unit -> unit Lwt.t
+val disconnect : unit -> unit
(** Close a session by discarding server side states for current browser
(session and session group), current client process (tab) and current
request.
@@ -129,11 +129,11 @@ val disconnect : unit -> unit Lwt.t
val connected_fun :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?deny_fun:(Os_types.User.id option -> 'c Lwt.t)
- -> (Os_types.User.id -> 'a -> 'b -> 'c Lwt.t)
+ -> ?deny_fun:(Os_types.User.id option -> 'c)
+ -> (Os_types.User.id -> 'a -> 'b -> 'c)
-> 'a
-> 'b
- -> 'c Lwt.t
+ -> 'c
(** Wrapper for service handlers that fetches automatically connection
information.
Register [(connected_fun f)] as handler for your services,
@@ -161,20 +161,20 @@ val connected_fun :
val connected_rpc :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?deny_fun:(Os_types.User.id option -> 'b Lwt.t)
- -> (Os_types.User.id -> 'a -> 'b Lwt.t)
+ -> ?deny_fun:(Os_types.User.id option -> 'b)
+ -> (Os_types.User.id -> 'a -> 'b)
-> 'a
- -> 'b Lwt.t
+ -> 'b
(** Wrapper for server functions (see {!connected_fun}). *)
val connected_wrapper :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?deny_fun:(Os_types.User.id option -> 'b Lwt.t)
+ -> ?deny_fun:(Os_types.User.id option -> 'b)
-> ?force_unconnected:bool
- -> ('a -> 'b Lwt.t)
+ -> ('a -> 'b)
-> 'a
- -> 'b Lwt.t
+ -> 'b
(** Wrapper for server functions when you do not need userid
(see {!connected_fun}).
It is recommended to use this wrapper for all your server functions! *)
@@ -183,12 +183,12 @@ module Opt : sig
val connected_fun :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?deny_fun:(Os_types.User.id option -> 'c Lwt.t)
+ -> ?deny_fun:(Os_types.User.id option -> 'c)
-> ?force_unconnected:bool
- -> (Os_types.User.id option -> 'a -> 'b -> 'c Lwt.t)
+ -> (Os_types.User.id option -> 'a -> 'b -> 'c)
-> 'a
-> 'b
- -> 'c Lwt.t
+ -> 'c
(** Same as {!connected_fun} but instead of failing in case the user is
not connected, the function given as parameter takes an [Os_types.User.id
option] for user id.
@@ -197,11 +197,11 @@ module Opt : sig
val connected_rpc :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?deny_fun:(Os_types.User.id option -> 'b Lwt.t)
+ -> ?deny_fun:(Os_types.User.id option -> 'b)
-> ?force_unconnected:bool
- -> (Os_types.User.id option -> 'a -> 'b Lwt.t)
+ -> (Os_types.User.id option -> 'a -> 'b)
-> 'a
- -> 'b Lwt.t
+ -> 'b
(** Same as {!connected_rpc} but instead of failing in case the user is
not connected, the function given as parameter takes an [Os_types.User.id
option] for user id.
diff --git a/src/os_tips.eliom b/src/os_tips.eliom
index 12937646..6b9e1ec8 100644
--- a/src/os_tips.eliom
+++ b/src/os_tips.eliom
@@ -18,11 +18,10 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%shared Lwt.Syntax
open%shared Eliom_content.Html
open%shared Eliom_content.Html.F
open%client Js_of_ocaml
-open%client Js_of_ocaml_lwt
+open%client Js_of_ocaml_eio
module%shared Stringset = Set.Make (String)
(* tips_seen is a group persistent reference recording which tips have
@@ -65,17 +64,16 @@ let%server get_tips_seen () = Eliom_reference.Volatile.get seen_by_user
tabs at a time which means that the user may see the same tip several
times in that case. *)
let%client tips_seen_client_ref = ref Stringset.empty
-let%client get_tips_seen () = Lwt.return !tips_seen_client_ref
+let%client get_tips_seen () = !tips_seen_client_ref
let%server () =
Os_session.on_start_connected_process (fun _ ->
- let* tips = get_tips_seen () in
- ignore [%client (tips_seen_client_ref := ~%tips : unit)];
- Lwt.return_unit)
+ let tips = get_tips_seen () in
+ ignore [%client (tips_seen_client_ref := ~%tips : unit)])
(* notify the server that a user has seen a tip *)
-let%rpc set_tip_seen (name : string) : unit Lwt.t =
- let* prev = Eliom_reference.Volatile.get seen_by_user in
+let%rpc set_tip_seen (name : string) : unit =
+ let prev = Eliom_reference.Volatile.get seen_by_user in
let newset = Stringset.add (name : string) prev in
match Os_current_user.Opt.get_current_userid () with
| None -> Eliom_reference.set tips_seen_not_connected newset
@@ -86,8 +84,8 @@ let%client set_tip_seen name =
set_tip_seen name
(* counterpart of set_tip_seen *)
-let%rpc unset_tip_seen (name : string) : unit Lwt.t =
- let* prev = Eliom_reference.Volatile.get seen_by_user in
+let%rpc unset_tip_seen (name : string) : unit =
+ let prev = Eliom_reference.Volatile.get seen_by_user in
let newset = Stringset.remove name prev in
match Os_current_user.Opt.get_current_userid () with
| None -> Eliom_reference.set tips_seen_not_connected newset
@@ -98,8 +96,8 @@ let%client unset_tip_seen name =
unset_tip_seen name
let%shared tip_seen name =
- let* seen = get_tips_seen () in
- Lwt.return @@ Stringset.mem name seen
+ let seen = get_tips_seen () in
+ Stringset.mem name seen
(* I want to see the tips again *)
let%server reset_tips_user myid_o =
@@ -107,7 +105,7 @@ let%server reset_tips_user myid_o =
| None -> Eliom_reference.set tips_seen_not_connected Stringset.empty
| _ -> Eliom_reference.set tips_seen Stringset.empty
-let%rpc reset_tips myid_o () : unit Lwt.t = reset_tips_user myid_o
+let%rpc reset_tips myid_o () : unit = reset_tips_user myid_o
let%server reset_tips_service =
Eliom_service.create ~name:"resettips" ~path:Eliom_service.No_path
@@ -130,7 +128,7 @@ let%shared
block
?(a = [])
?(recipient = `All)
- ?(onclose = [%client (fun () -> Lwt.return_unit : unit -> unit Lwt.t)])
+ ?(onclose = [%client (fun () -> () : unit -> unit)])
~name
~content
()
@@ -138,23 +136,21 @@ let%shared
let myid_o = Os_current_user.Opt.get_current_userid () in
match recipient, myid_o with
| `All, _ | `Not_connected, None | `Connected, Some _ ->
- let* seen = get_tips_seen () in
+ let seen = get_tips_seen () in
if Stringset.mem name seen
- then Lwt.return_none
+ then None
else
let box_ref = ref None in
- let close : (unit -> unit Lwt.t) Eliom_client_value.t =
+ let close : (unit -> unit) Eliom_client_value.t =
[%client
fun () ->
- let* () = ~%onclose () in
- let () =
- match !(~%box_ref) with
- | Some x -> Manip.removeSelf x
- | None -> ()
- in
+ ~%onclose ();
+ (match !(~%box_ref) with
+ | Some x -> Manip.removeSelf x
+ | None -> ());
set_tip_seen ~%name]
in
- let* c = content close in
+ let c = content close in
let c = [div ~a:[a_class ["os-tip-content"]] c] in
let box =
D.div
@@ -162,28 +158,50 @@ let%shared
(Os_icons.D.close
~a:
[ a_class ["os-tip-close"]
- ; a_onclick [%client fun _ -> Lwt.async ~%close] ]
+ ; a_onclick [%client fun _ -> Eio_js.start ~%close] ]
()
:: c)
in
box_ref := Some box;
- Lwt.return_some box
- | _ -> Lwt.return_none
+ Some box
+ | _ -> None
+(* Create a promise that will be resolved when onload fires.
+ Must be called inside an Eio fiber. *)
let%client onload_waiter () =
- let* _ = Eliom_client.lwt_onload () in
- Lwt.return_unit
+ let t, u = Eio.Promise.create () in
+ Eliom_client.onload (fun () ->
+ Eio_js.start (fun () -> Eio.Promise.resolve_ok u ()));
+ t, u
-(* This thread is used to display only one tip at a time *)
-let%client waiter = ref (onload_waiter ())
+(* This promise is used to display only one tip at a time *)
+(* Initialized lazily to avoid calling Eio.Promise.create at toplevel *)
+(* We use a lazy value that is forced only inside an Eio fiber *)
+let%client waiter = ref None
+let%client get_waiter () =
+ match !waiter with
+ | Some w -> Lazy.force w
+ | None ->
+ let w = lazy (onload_waiter ()) in
+ waiter := Some w;
+ Lazy.force w
+exception%client Page_changed
+
+(* Called by onchangepage - invalidates the current waiter so a new one
+ will be created on next get_waiter call *)
let%client rec onchangepage_handler _ =
- Lwt.cancel !waiter;
- waiter := onload_waiter ();
+ (match !waiter with
+ | Some w when Lazy.is_val w ->
+ (* Only resolve if the lazy was forced (promise was created) *)
+ Eio_js.start (fun () ->
+ Eio.Promise.resolve_error (snd (Lazy.force w)) (Eio.Cancel.Cancelled Page_changed))
+ | _ -> ());
+ (* Create a new lazy for the next waiter - it will be forced inside an Eio fiber *)
+ waiter := Some (lazy (onload_waiter ()));
(* onchangepage handlers are one-off, register ourselves again for
next time *)
- Eliom_client.onchangepage onchangepage_handler;
- Lwt.return_unit
+ Eliom_client.onchangepage onchangepage_handler
let%client () = Eliom_client.onchangepage onchangepage_handler
@@ -200,92 +218,94 @@ let%client
?width
?(parent_node : _ elt option)
?(delay = 0.0)
- ?(onclose = fun () -> Lwt.return_unit)
+ ?(onclose = fun () -> ())
~name
~content
()
=
- let current_waiter = !waiter in
- let new_waiter, new_wakener = Lwt.task () in
- waiter := new_waiter;
- let* () = current_waiter in
- let bec = D.div ~a:[a_class ["os-tip-bec"]] [] in
- let box_ref = ref None in
- let close () =
- let* () = onclose () in
- let () = match !box_ref with Some x -> Manip.removeSelf x | None -> () in
- Lwt.wakeup new_wakener ();
- set_tip_seen (name : string)
- in
- let* c = content close in
- let c = [div ~a:[a_class ["os-tip-content"]] c] in
- let box =
- D.div
- ~a:(a_class ["os-tip"; "os-tip-bubble"] :: a)
- (Os_icons.D.close
- ~a:[a_class ["os-tip-close"]; a_onclick (fun _ -> Lwt.async close)]
- ()
- :: (match arrow with None -> c | _ -> bec :: c))
- in
- box_ref := Some box;
- let parent_node =
- match parent_node with
- | None -> Dom_html.document##.body
- | Some p -> To_dom.of_element p
- in
- let* () = Ot_nodeready.nodeready parent_node in
- let* () = Lwt_js.sleep delay in
- let box = To_dom.of_element box in
- Dom.appendChild parent_node box;
- box##.style##.opacity := Js.string "0";
- Eliom_lib.Option.iter
- (fun v -> box##.style##.top := Js.string (Printf.sprintf "%ipx" v))
- top;
- Eliom_lib.Option.iter
- (fun v -> box##.style##.left := Js.string (Printf.sprintf "%ipx" v))
- left;
- Eliom_lib.Option.iter
- (fun v -> box##.style##.right := Js.string (Printf.sprintf "%ipx" v))
- right;
- Eliom_lib.Option.iter
- (fun v -> box##.style##.bottom := Js.string (Printf.sprintf "%ipx" v))
- bottom;
- Eliom_lib.Option.iter
- (fun v -> box##.style##.width := Js.string (Printf.sprintf "%ipx" v))
- width;
- Eliom_lib.Option.iter
- (fun v -> box##.style##.height := Js.string (Printf.sprintf "%ipx" v))
- height;
- Eliom_lib.Option.iter
- (fun a ->
- let bec = To_dom.of_element bec in
- let bec_size = bec##.offsetWidth in
- let offset = Printf.sprintf "-%dpx" (bec_size / 2) in
- match a with
- | `top i ->
- bec##.style##.top := Js.string offset;
- bec##.style##.left := Js.string (Printf.sprintf "%ipx" i);
- bec##.style##.borderBottom := Js.string "none";
- bec##.style##.borderRight := Js.string "none"
- | `left i ->
- bec##.style##.left := Js.string offset;
- bec##.style##.top := Js.string (Printf.sprintf "%ipx" i);
- bec##.style##.borderTop := Js.string "none";
- bec##.style##.borderRight := Js.string "none"
- | `bottom i ->
- bec##.style##.bottom := Js.string offset;
- bec##.style##.left := Js.string (Printf.sprintf "%ipx" i);
- bec##.style##.borderTop := Js.string "none";
- bec##.style##.borderLeft := Js.string "none"
- | `right i ->
- bec##.style##.right := Js.string offset;
- bec##.style##.top := Js.string (Printf.sprintf "%ipx" i);
- bec##.style##.borderBottom := Js.string "none";
- bec##.style##.borderLeft := Js.string "none")
- arrow;
- let* () = Lwt_js_events.request_animation_frame () in
- box##.style##.opacity := Js.string "1";
- Lwt.return_unit
+ Eio_js.start (fun () ->
+ let current_waiter = fst (get_waiter ()) in
+ (* Create the new waiter inside the Eio fiber, wrapped in lazy (already forced) *)
+ let new_w = Eio.Promise.create () in
+ waiter := Some (lazy new_w);
+ let _new_promise, new_resolver = Lazy.force (Option.get !waiter) in
+ Eio.Promise.await_exn current_waiter;
+ let bec = D.div ~a:[a_class ["os-tip-bec"]] [] in
+ let box_ref = ref None in
+ let close () =
+ onclose ();
+ (match !box_ref with Some x -> Manip.removeSelf x | None -> ());
+ Eio.Promise.resolve_ok new_resolver ();
+ set_tip_seen (name : string)
+ in
+ let c = content close in
+ let c = [div ~a:[a_class ["os-tip-content"]] c] in
+ let box =
+ D.div
+ ~a:(a_class ["os-tip"; "os-tip-bubble"] :: a)
+ (Os_icons.D.close
+ ~a:[a_class ["os-tip-close"]; a_onclick (fun _ -> Eio_js.start close)]
+ ()
+ :: (match arrow with None -> c | _ -> bec :: c))
+ in
+ box_ref := Some box;
+ let parent_node =
+ match parent_node with
+ | None -> Dom_html.document##.body
+ | Some p -> To_dom.of_element p
+ in
+ Ot_nodeready.nodeready parent_node;
+ Eio_js.sleep delay;
+ let box = To_dom.of_element box in
+ Dom.appendChild parent_node box;
+ box##.style##.opacity := Js.string "0";
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.top := Js.string (Printf.sprintf "%ipx" v))
+ top;
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.left := Js.string (Printf.sprintf "%ipx" v))
+ left;
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.right := Js.string (Printf.sprintf "%ipx" v))
+ right;
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.bottom := Js.string (Printf.sprintf "%ipx" v))
+ bottom;
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.width := Js.string (Printf.sprintf "%ipx" v))
+ width;
+ Eliom_lib.Option.iter
+ (fun v -> box##.style##.height := Js.string (Printf.sprintf "%ipx" v))
+ height;
+ Eliom_lib.Option.iter
+ (fun a ->
+ let bec = To_dom.of_element bec in
+ let bec_size = bec##.offsetWidth in
+ let offset = Printf.sprintf "-%dpx" (bec_size / 2) in
+ match a with
+ | `top i ->
+ bec##.style##.top := Js.string offset;
+ bec##.style##.left := Js.string (Printf.sprintf "%ipx" i);
+ bec##.style##.borderBottom := Js.string "none";
+ bec##.style##.borderRight := Js.string "none"
+ | `left i ->
+ bec##.style##.left := Js.string offset;
+ bec##.style##.top := Js.string (Printf.sprintf "%ipx" i);
+ bec##.style##.borderTop := Js.string "none";
+ bec##.style##.borderRight := Js.string "none"
+ | `bottom i ->
+ bec##.style##.bottom := Js.string offset;
+ bec##.style##.left := Js.string (Printf.sprintf "%ipx" i);
+ bec##.style##.borderTop := Js.string "none";
+ bec##.style##.borderLeft := Js.string "none"
+ | `right i ->
+ bec##.style##.right := Js.string offset;
+ bec##.style##.top := Js.string (Printf.sprintf "%ipx" i);
+ bec##.style##.borderBottom := Js.string "none";
+ bec##.style##.borderLeft := Js.string "none")
+ arrow;
+ ignore (Eio_js_events.request_animation_frame ());
+ box##.style##.opacity := Js.string "1")
(* Function to be called on server to display a tip *)
let%shared
@@ -310,23 +330,22 @@ let%shared
?onclose
~(name : string)
~(content :
- ((unit -> unit Lwt.t)
- -> Html_types.div_content Eliom_content.Html.elt list Lwt.t)
+ ((unit -> unit) -> Html_types.div_content Eliom_content.Html.elt list)
Eliom_client_value.t)
()
=
let delay : float option = delay in
- let onclose : (unit -> unit Lwt.t) Eliom_client_value.t option = onclose in
+ let onclose : (unit -> unit) Eliom_client_value.t option = onclose in
let myid_o = Os_current_user.Opt.get_current_userid () in
match recipient, myid_o with
| `All, _ | `Not_connected, None | `Connected, Some _ ->
- let* seen = get_tips_seen () in
+ let seen = get_tips_seen () in
if Stringset.mem name seen
- then Lwt.return_unit
+ then ()
else
let _ =
[%client
- (Lwt.async (fun () ->
+ (Eio_js.start (fun () ->
display_bubble ?a:~%a ?arrow:~%arrow ?top:~%top ?left:~%left
?right:~%right ?bottom:~%bottom ?height:~%height ?width:~%width
?parent_node:~%parent_node ?delay:~%delay ?onclose:~%onclose
@@ -334,5 +353,5 @@ let%shared
~content:~%content ())
: unit)]
in
- Lwt.return_unit
- | _ -> Lwt.return_unit
+ ()
+ | _ -> ()
diff --git a/src/os_tips.eliomi b/src/os_tips.eliomi
index 8de51e18..6fac6c6a 100644
--- a/src/os_tips.eliomi
+++ b/src/os_tips.eliomi
@@ -36,14 +36,13 @@ val bubble :
-> ?width:int Eliom_client_value.t
-> ?parent_node:[< `Body | Html_types.body_content] Eliom_content.Html.elt
-> ?delay:float
- -> ?onclose:(unit -> unit Lwt.t) Eliom_client_value.t
+ -> ?onclose:(unit -> unit) Eliom_client_value.t
-> name:string
-> content:
- ((unit -> unit Lwt.t)
- -> Html_types.div_content Eliom_content.Html.elt list Lwt.t)
+ ((unit -> unit) -> Html_types.div_content Eliom_content.Html.elt list)
Eliom_client_value.t
-> unit
- -> unit Lwt.t
+ -> unit
(** Display tips in pages, as a speech bubble.
One tip is displayed at a time.
@@ -69,33 +68,33 @@ val bubble :
val block :
?a:[< Html_types.div_attrib > `Class] Eliom_content.Html.D.attrib list
-> ?recipient:[> `All | `Connected | `Not_connected]
- -> ?onclose:(unit -> unit Lwt.t) Eliom_client_value.t
+ -> ?onclose:(unit -> unit) Eliom_client_value.t
-> name:string
-> content:
- ((unit -> unit Lwt.t) Eliom_client_value.t
- -> Html_types.div_content Eliom_content.Html.elt list Lwt.t)
+ ((unit -> unit) Eliom_client_value.t
+ -> Html_types.div_content Eliom_content.Html.elt list)
-> unit
- -> [> `Div] Eliom_content.Html.elt option Lwt.t
+ -> [> `Div] Eliom_content.Html.elt option
(** Return a box containing a tip, to be inserted where you want in a page.
The box contains a close button. Once it is closed, it is never displayed
again for this user. In that case the function returns [None].
*)
-val reset_tips : unit -> unit Lwt.t
+val reset_tips : unit -> unit
(** Call this function to reset tips for current user.
Tips will be shown again from the beginning.
*)
-val set_tip_seen : string -> unit Lwt.t
+val set_tip_seen : string -> unit
(** Call this function to mark a tip as "already seen" by current user.
This is done automatically when a tip is closed.
*)
-val unset_tip_seen : string -> unit Lwt.t
+val unset_tip_seen : string -> unit
(** Counterpart of set_tip_seen. Does not fail if the tip has not been seen
yet *)
-val tip_seen : string -> bool Lwt.t
+val tip_seen : string -> bool
(** Returns whether a tip has been seen or not. *)
val reset_tips_service :
diff --git a/src/os_uploader.eliom b/src/os_uploader.eliom
index 04b88f68..9457589f 100644
--- a/src/os_uploader.eliom
+++ b/src/os_uploader.eliom
@@ -18,50 +18,49 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%server Lwt.Syntax
-
[%%server
exception Error_while_cropping of Unix.process_status
exception Error_while_resizing of Unix.process_status]
let%server resize_image ~src ?(dst = src) ~width ~height () =
- let* resize_unix_result =
- Lwt_process.exec
- ( ""
- , [| "convert"
- ; "+repage"
- ; "-strip"
- ; "-interlace"
- ; "Plane"
- ; "-auto-orient"
- ; "-define"
- ; Printf.sprintf "jpeg:size=%dx%d" (2 * width) (2 * height)
- ; "-resize"
- ; Printf.sprintf "%dx%d!" width height
- ; "-quality"
- ; "85"
- ; (* In case of transparent image *)
- "-background"
- ; "white"
- ; "-flatten"
- ; src
- ; "jpg:" ^ dst |] )
- in
- match resize_unix_result with
- | Unix.WEXITED status_code when status_code = 0 -> Lwt.return_unit
- | unix_process_status -> Lwt.fail (Error_while_resizing unix_process_status)
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ try
+ Eio.Process.run env#process_mgr
+ [ "convert"
+ ; "+repage"
+ ; "-strip"
+ ; "-interlace"
+ ; "Plane"
+ ; "-auto-orient"
+ ; "-define"
+ ; Printf.sprintf "jpeg:size=%dx%d" (2 * width) (2 * height)
+ ; "-resize"
+ ; Printf.sprintf "%dx%d!" width height
+ ; "-quality"
+ ; "85"
+ ; (* In case of transparent image *)
+ "-background"
+ ; "white"
+ ; "-flatten"
+ ; src
+ ; "jpg:" ^ dst ]
+ with _ -> raise (Error_while_resizing (Unix.WEXITED 1))
let%server get_image_width file =
- let* width =
- Lwt_process.pread ("", [|"convert"; file; "-print"; "%w"; "/dev/null"|])
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ let width =
+ Eio.Process.parse_out env#process_mgr Eio.Buf_read.line
+ ["convert"; file; "-print"; "%w"; "/dev/null"]
in
- Lwt.return (int_of_string width)
+ int_of_string width
let%server get_image_height file =
- let* height =
- Lwt_process.pread ("", [|"convert"; file; "-print"; "%h"; "/dev/null"|])
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ let height =
+ Eio.Process.parse_out env#process_mgr Eio.Buf_read.line
+ ["convert"; file; "-print"; "%h"; "/dev/null"]
in
- Lwt.return (int_of_string height)
+ int_of_string height
let%server crop_image ~src ?(dst = src) ?ratio ~top ~right ~bottom ~left () =
(* Given arguments are in percent. Use this to convert to pixel. The full size
@@ -69,8 +68,8 @@ let%server crop_image ~src ?(dst = src) ?ratio ~top ~right ~bottom ~left () =
let pixel_of_percent percent full_size_px =
truncate percent * full_size_px / 100
in
- let* width_src = get_image_width src in
- let* height_src = get_image_height src in
+ let width_src = get_image_width src in
+ let height_src = get_image_height src in
let left_px = pixel_of_percent left width_src in
let top_px = pixel_of_percent top height_src in
let width_cropped = width_src - left_px - pixel_of_percent right width_src in
@@ -79,20 +78,17 @@ let%server crop_image ~src ?(dst = src) ?ratio ~top ~right ~bottom ~left () =
| None -> height_src - top_px - pixel_of_percent bottom height_src
| Some ratio -> truncate (float_of_int width_cropped /. ratio)
in
- let* crop_unix_result =
- Lwt_process.exec
- ( ""
- , [| "convert"
- ; "-crop"
- ; Printf.sprintf "%dx%d+%d+%d" width_cropped height_cropped left_px
- top_px
- ; src
- ; dst |] )
- in
- match crop_unix_result with
- | Unix.WEXITED status_code when status_code = 0 ->
- resize_image ~src:dst ~dst ~width:width_cropped ~height:height_cropped ()
- | unix_process_status -> Lwt.fail (Error_while_cropping unix_process_status)
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ (try
+ Eio.Process.run env#process_mgr
+ [ "convert"
+ ; "-crop"
+ ; Printf.sprintf "%dx%d+%d+%d" width_cropped height_cropped left_px
+ top_px
+ ; src
+ ; dst ]
+ with _ -> raise (Error_while_cropping (Unix.WEXITED 1)));
+ resize_image ~src:dst ~dst ~width:width_cropped ~height:height_cropped ()
let%server record_image directory ?ratio ?cropping file =
let make_file_saver cp () =
@@ -103,14 +99,14 @@ let%server record_image directory ?ratio ?cropping file =
fun file_info ->
let fname = new_filename () in
let fpath = directory ^ "/" ^ fname in
- let* () = cp (Eliom_request_info.get_tmp_filename file_info) fpath in
- Lwt.return fname
+ let () = cp (Eliom_request_info.get_tmp_filename file_info) fpath in
+ fname
in
let cp =
match cropping with
| Some (top, right, bottom, left) ->
fun src dst -> crop_image ~src ~dst ?ratio ~top ~right ~bottom ~left ()
- | None -> Lwt_unix.link
+ | None -> fun src dst -> Unix.link src dst
in
let file_saver = make_file_saver cp () in
file_saver file
diff --git a/src/os_uploader.eliomi b/src/os_uploader.eliomi
index eff8e522..ff8d6c3c 100644
--- a/src/os_uploader.eliomi
+++ b/src/os_uploader.eliomi
@@ -29,10 +29,10 @@ exception Error_while_cropping of Unix.process_status
exception Error_while_resizing of Unix.process_status
(** Raised if an error occurred while resizing a picture. The corresponding code status is given in parameter. *)
-val get_image_height : string -> int Lwt.t
+val get_image_height : string -> int
(** Return the height of the given image. *)
-val get_image_width : string -> int Lwt.t
+val get_image_width : string -> int
(** Return the width of the given image. *)
val resize_image :
@@ -41,7 +41,7 @@ val resize_image :
-> width:int
-> height:int
-> unit
- -> unit Lwt.t
+ -> unit
(** Resize the given image ([src]) and save it to [dst] (default is the source
file). If an error occurred, it raises the exception [Error_while_resizing]
with the corresponding unix process status.
@@ -56,7 +56,7 @@ val crop_image :
-> bottom:float
-> left:float
-> unit
- -> unit Lwt.t
+ -> unit
(** [crop_image ~src ?dst ?ratio ~top ~right ~bottom ~left] crops the image
saved in [src] and saves the result in [dst] (default is the source file).
[top], [right], [bottom] and [left] are the number of pixels the image must
@@ -71,7 +71,7 @@ val record_image :
-> ?ratio:float
-> ?cropping:float * float * float * float
-> Ocsigen_extensions.file_info
- -> string Lwt.t
+ -> string
(** [record_image directory ?ratio ?cropping:(top, right, bottom, left) file]
crops the image like [crop_image] and save it in the directory [directory].
If an error occurred, it raises the exception [Error_while_resizing] or
diff --git a/src/os_user.eliom b/src/os_user.eliom
index 372619b2..bc2a54dc 100644
--- a/src/os_user.eliom
+++ b/src/os_user.eliom
@@ -18,8 +18,6 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open Lwt.Syntax
-
[%%shared
type id = Os_types.User.id [@@deriving json]
@@ -100,24 +98,21 @@ module MCache = Os_request_cache.Make (struct
let compare = compare
let get key =
- Lwt.catch
- (fun () ->
- let* g = Os_db.User.user_of_userid key in
- Lwt.return (create_user_from_db0 g))
- (function
- | Os_db.No_such_resource -> Lwt.fail No_such_user
- | exc -> Lwt.reraise exc)
+ try
+ let g = Os_db.User.user_of_userid key in
+ create_user_from_db0 g
+ with Os_db.No_such_resource -> raise No_such_user
end)
(* Overwrite the function [user_of_userid] of [Os_db.User] and use
the [get] function of the cache module. *)
let user_of_userid userid =
- let* u, _ = MCache.get userid in
- Lwt.return u
+ let u, _ = MCache.get userid in
+ u
let password_set userid =
- let* _, s = MCache.get userid in
- Lwt.return s
+ let _, s = MCache.get userid in
+ s
(* -----------------------------------------------------------------
@@ -130,29 +125,30 @@ let password_set userid =
let create ?password ?avatar ?language ?email ~firstname ~lastname () =
let password = match password with Some "" -> None | _ -> password in
let really_create () =
- let* userid =
+ let userid =
Os_db.User.create ~firstname ~lastname ?password ?avatar ?language ?email
()
in
- user_of_userid userid
+ Logs.warn (fun fmt -> fmt "[Os_user.create] Created user with id %Ld, now calling user_of_userid" userid);
+ let u = user_of_userid userid in
+ Logs.warn (fun fmt -> fmt "[Os_user.create] user_of_userid succeeded");
+ u
in
match email with
- | Some email ->
- Lwt.catch
- (fun () ->
- let* userid = Os_db.User.userid_of_email email in
- Lwt.fail (Already_exists userid))
- (function
- | Os_db.No_such_resource -> really_create () | exc -> Lwt.reraise exc)
+ | Some email -> (
+ try
+ let userid = Os_db.User.userid_of_email email in
+ raise (Already_exists userid)
+ with Os_db.No_such_resource -> really_create ())
| None -> really_create ()
(* Overwrites the function [update] of [Os_db.User]
to reset the cache *)
let update ?password ?avatar ?language ~firstname ~lastname userid =
- let* () =
+ let () =
Os_db.User.update ?password ?avatar ?language ~firstname ~lastname userid
in
- MCache.reset userid; Lwt.return_unit
+ MCache.reset userid
let update' ?password user =
update ?password ?avatar:(avatar_of_user user)
@@ -160,22 +156,22 @@ let update' ?password user =
~lastname:(lastname_of_user user) (userid_of_user user)
let update_password ~userid ~password =
- let* () = Os_db.User.update_password ~userid ~password in
- MCache.reset userid; Lwt.return_unit
+ let () = Os_db.User.update_password ~userid ~password in
+ MCache.reset userid
let update_language ~userid ~language =
- let* () = Os_db.User.update_language ~userid ~language in
- MCache.reset userid; Lwt.return_unit
+ let () = Os_db.User.update_language ~userid ~language in
+ MCache.reset userid
let update_avatar ~userid ~avatar =
- let* () = Os_db.User.update_avatar ~userid ~avatar in
- MCache.reset userid; Lwt.return_unit
+ let () = Os_db.User.update_avatar ~userid ~avatar in
+ MCache.reset userid
let get_language userid = Os_db.User.get_language userid
let get_users ?pattern () =
- let* users = Os_db.User.get_users ?pattern () in
- Lwt.return (List.map create_user_from_db users)
+ let users = Os_db.User.get_users ?pattern () in
+ List.map create_user_from_db users
let set_pwd_crypt_fun a = Os_db.pwd_crypt_ref := a
diff --git a/src/os_user.eliomi b/src/os_user.eliomi
index 22b63831..f1ce2dea 100644
--- a/src/os_user.eliomi
+++ b/src/os_user.eliomi
@@ -44,7 +44,7 @@ exception Already_exists of Os_types.User.id
exception No_such_user
(** Exception used if an user doesn't exist. *)
-val password_set : Os_types.User.id -> bool Lwt.t
+val password_set : Os_types.User.id -> bool
(** [password_set userid] returns [true] if the user with ID [userid] has set
a password. Else [false].
*)
@@ -133,12 +133,12 @@ val add_actionlinkkey :
-> userid:Os_types.User.id
-> email:string
-> unit
- -> unit Lwt.t
+ -> unit
(** [add_actionlinkkey ?autoconnect ?action ?data ?validity ?expiry ~act_key ~userid
~email ()] adds the action key in the database.
*)
-val verify_password : email:string -> password:string -> Os_types.User.id Lwt.t
+val verify_password : email:string -> password:string -> Os_types.User.id
(** [verify_password ~email ~password] returns the userid if user with email
[email] is registered with the password [password].
If [password] the password is wrong,
@@ -149,12 +149,12 @@ val verify_password : email:string -> password:string -> Os_types.User.id Lwt.t
If user is not found, it fails with exception {!No_such_user}.
If password is empty, it fails with exception {!Empty_password}. *)
-val user_of_userid : Os_types.User.id -> Os_types.User.t Lwt.t
+val user_of_userid : Os_types.User.id -> Os_types.User.t
(** [user_of_userid userid] returns the information about the user with ID
[userid].
*)
-val get_actionlinkkey_info : string -> Os_types.Action_link_key.info Lwt.t
+val get_actionlinkkey_info : string -> Os_types.Action_link_key.info
(** Retrieve the data corresponding to an action link key, each
call decrements the validity of the key by [1] if it exists and
[validity > 0] (it remains at [0] if it's already [0]). It is up to
@@ -162,34 +162,34 @@ val get_actionlinkkey_info : string -> Os_types.Action_link_key.info Lwt.t
Raises {!Os_db.No_such_resource} if the action link key is not found.
*)
-val userid_of_email : string -> Os_types.User.id Lwt.t
+val userid_of_email : string -> Os_types.User.id
(** [userid_of_email email] returns the userid of the user with email [email].
It raises the exception {!Os_db.No_such_resource} if the email [email] is
not used.
*)
-val emails_of_userid : Os_types.User.id -> string list Lwt.t
+val emails_of_userid : Os_types.User.id -> string list
(** [emails_of_userid userid] returns the emails list of user with ID
[userid].
*)
-val email_of_userid : Os_types.User.id -> string option Lwt.t
+val email_of_userid : Os_types.User.id -> string option
(** [email_of_userid userid] returns the main email of user with ID
[userid].
*)
-val emails_of_user : Os_types.User.t -> string list Lwt.t
+val emails_of_user : Os_types.User.t -> string list
(** [emails_of_user user] returns the emails list of user [user]. *)
-val email_of_user : Os_types.User.t -> string option Lwt.t
+val email_of_user : Os_types.User.t -> string option
(** [email_of_user user] returns the main email of user [user]. *)
-val get_language : Os_types.User.id -> string option Lwt.t
+val get_language : Os_types.User.id -> string option
(** [get_language userid] returns the language of the user with ID [userid]. The
language is retrieved from the database.
*)
-val get_users : ?pattern:string -> unit -> Os_types.User.t list Lwt.t
+val get_users : ?pattern:string -> unit -> Os_types.User.t list
(** [get_users ?pattern ()] gets users who match the [pattern] (useful for
completion).
*)
@@ -202,7 +202,7 @@ val create :
-> firstname:string
-> lastname:string
-> unit
- -> Os_types.User.t Lwt.t
+ -> Os_types.User.t
(** [create ?password ?avatar ?language ~firstname ~lastname email] creates a new user
with the given information. An email, the first name and the last name are mandatory.
*)
@@ -214,52 +214,52 @@ val update :
-> firstname:string
-> lastname:string
-> Os_types.User.id
- -> unit Lwt.t
+ -> unit
(** [update ?password ?avatar ?language ~firstname ~lastname userid] update the
given information of the user with ID [userid]. Only given information are
updated.
*)
-val update' : ?password:string -> Os_types.User.t -> unit Lwt.t
+val update' : ?password:string -> Os_types.User.t -> unit
(** Another version of [update] using a type {!Os_types.User.t} instead of
label.
*)
-val update_password : userid:Os_types.User.id -> password:string -> unit Lwt.t
+val update_password : userid:Os_types.User.id -> password:string -> unit
(** [update_password ~userid ~password] updates the password only. [password]
must not be hashed: it is done by the function [f_crypt] of the tuple
{!Os_db.pwd_crypt_ref}.
*)
-val update_avatar : userid:Os_types.User.id -> avatar:string -> unit Lwt.t
+val update_avatar : userid:Os_types.User.id -> avatar:string -> unit
(** [update_avatar ~userid ~avatar] updates the avatar of the user with ID
[userid].
*)
-val update_language : userid:Os_types.User.id -> language:string -> unit Lwt.t
+val update_language : userid:Os_types.User.id -> language:string -> unit
(** [update_language ~userid ~language] updates the language of the user with ID
[userid].
*)
-val is_registered : string -> bool Lwt.t
+val is_registered : string -> bool
(** [is_registered email] returns [true] if a user exists with email [email].
Else, it returns [false].
*)
-val is_preregistered : string -> bool Lwt.t
+val is_preregistered : string -> bool
(** [is_preregistered email] returns [true] if a user exists with email
[email]. Else, it returns [false].
*)
-val add_preregister : string -> unit Lwt.t
+val add_preregister : string -> unit
(** [add_preregister email] adds an email into the preregister collections. *)
-val remove_preregister : string -> unit Lwt.t
+val remove_preregister : string -> unit
(** [remove_preregister email] removes an email from the preregister
collections.
*)
-val all : ?limit:int64 -> unit -> string list Lwt.t
+val all : ?limit:int64 -> unit -> string list
(** Get [limit] (default: 10) emails from the preregister collections. *)
val set_pwd_crypt_fun :
@@ -274,26 +274,23 @@ val set_pwd_crypt_fun :
by user, and as third parameter the hash found in database.
*)
-val remove_email_from_user :
- userid:Os_types.User.id
- -> email:string
- -> unit Lwt.t
+val remove_email_from_user : userid:Os_types.User.id -> email:string -> unit
(** [remove_email_from_user ~userid ~email] removes the email [email] from the
user with the id [userid]. If the email is registered as the main email for
the user it fails with the exception {!Os_db.Main_email_removal_attempt}.
*)
-val is_email_validated : userid:Os_types.User.id -> email:string -> bool Lwt.t
+val is_email_validated : userid:Os_types.User.id -> email:string -> bool
(** [is_email_validated ~userid ~email] returns whether for a user designated by
its id the given email has been validated.
*)
-val is_main_email : userid:Os_types.User.id -> email:string -> bool Lwt.t
+val is_main_email : userid:Os_types.User.id -> email:string -> bool
(** [is_main_email ~userid ~email] returns whether an email is the main email
registered for a given user designated by its id.
*)
-val update_main_email : userid:Os_types.User.id -> email:string -> unit Lwt.t
+val update_main_email : userid:Os_types.User.id -> email:string -> unit
(** [update_mail_email ~userid ~email] sets the main email for a user with the
ID [userid] as the email [email].
*)
diff --git a/src/os_user_proxy.eliom b/src/os_user_proxy.eliom
index 2ca0caed..34ed1c79 100644
--- a/src/os_user_proxy.eliom
+++ b/src/os_user_proxy.eliom
@@ -34,7 +34,7 @@ let%server cache : (Os_types.User.id, Os_types.User.t) Eliom_cscache.t =
let%server get_data_from_db _myid_o userid = Os_user.user_of_userid userid
-let%rpc get_data myid_o (userid : Os_types.User.id) : Os_types.User.t Lwt.t =
+let%rpc get_data myid_o (userid : Os_types.User.id) : Os_types.User.t =
get_data_from_db myid_o userid
let%server get_data_from_db_for_client myid_o userid =
diff --git a/src/os_user_proxy.eliomi b/src/os_user_proxy.eliomi
index b76db3cd..f1acef6f 100644
--- a/src/os_user_proxy.eliomi
+++ b/src/os_user_proxy.eliomi
@@ -32,17 +32,14 @@
val cache : (Os_types.User.id, Os_types.User.t) Eliom_cscache.t
(** Cache keeping userid and user information as a {!Os_types.user} type. *)
-val get_data_from_db : 'a -> Os_types.User.id -> Os_types.User.t Lwt.t
+val get_data_from_db : 'a -> Os_types.User.id -> Os_types.User.t
(** [get_data_from_db myid_o userid] returns the user which has ID [userid].
For the moment, [myid_o] is not used but it will be use later.
Data comes from the database, not the cache.
*)
-val get_data_from_db_for_client :
- 'a
- -> Os_types.User.id
- -> Os_types.User.t Lwt.t
+val get_data_from_db_for_client : 'a -> Os_types.User.id -> Os_types.User.t
(** [get_data_from_db_for_client myid_o userid] returns the user which has ID
[userid]. For the moment, [myid_o] is not used but it will be use later.
@@ -51,14 +48,14 @@ val get_data_from_db_for_client :
[%%shared.start]
-val get_data : Os_types.User.id -> Os_types.User.t Lwt.t
+val get_data : Os_types.User.id -> Os_types.User.t
(** [get_data userid] returns the user which has ID [userid].
For the moment, [myid_o] is not used but it will be use later.
Data comes from the database, not the cache.
*)
-val get_data_from_cache : Os_types.User.id -> Os_types.User.t Lwt.t
+val get_data_from_cache : Os_types.User.id -> Os_types.User.t
(** [get_data_from_cache userid] returns the user with ID [userid] saved in
cache.
*)
diff --git a/src/os_user_view.eliom b/src/os_user_view.eliom
index c7e96ba5..ab15d52d 100644
--- a/src/os_user_view.eliom
+++ b/src/os_user_view.eliom
@@ -18,19 +18,18 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-open%client Lwt.Syntax
open%shared Eliom_content.Html
open%shared Eliom_content.Html.F
open%client Js_of_ocaml
-open%client Js_of_ocaml_lwt
+open%client Js_of_ocaml_eio
let%shared enable_phone = ref false
let%client check_password_confirmation ~password ~confirmation =
let password_dom = To_dom.of_input password in
let confirmation_dom = To_dom.of_input confirmation in
- Lwt_js_events.async (fun () ->
- Lwt_js_events.inputs confirmation_dom (fun _ _ ->
+ Eio_js_events.async (fun () ->
+ Eio_js_events.inputs confirmation_dom (fun _ ->
ignore
(if
Js.to_string password_dom##.value
@@ -38,8 +37,7 @@ let%client check_password_confirmation ~password ~confirmation =
then
(Js.Unsafe.coerce confirmation_dom)##(setCustomValidity
"Passwords do not match")
- else (Js.Unsafe.coerce confirmation_dom)##(setCustomValidity ""));
- Lwt.return_unit))
+ else (Js.Unsafe.coerce confirmation_dom)##(setCustomValidity ""))))
let%shared
generic_email_form
@@ -67,30 +65,21 @@ let%shared
let%client form_override_phone phone_input form =
let phone_input = To_dom.of_input phone_input
and form = To_dom.of_form form in
- Lwt.async @@ fun () ->
- Lwt_js_events.submits form @@ fun ev _ ->
+ Eio_js.start @@ fun () ->
+ Eio_js_events.submits form @@ fun ev ->
let number = Js.to_string phone_input##.value in
if number <> ""
- then
- Lwt.bind
- (let password = (Js.Unsafe.coerce form)##.password##.value |> Js.to_string
- and keepmeloggedin =
- (Js.Unsafe.coerce form)##.keepmeloggedin##.checked |> Js.to_bool
- in
- Dom.preventDefault ev;
- Os_connect_phone.connect ~keepmeloggedin ~password number)
- (function
- | `Login_ok -> Os_lib.reload ()
- | `Wrong_password ->
- Os_msg.msg ~level:`Err "Wrong password";
- Lwt.return_unit
- | `No_such_user ->
- Os_msg.msg ~level:`Err "No such user";
- Lwt.return_unit
- | `Password_not_set ->
- Os_msg.msg ~level:`Err "User password not set";
- Lwt.return_unit)
- else Lwt.return_unit
+ then (
+ let password = (Js.Unsafe.coerce form)##.password##.value |> Js.to_string
+ and keepmeloggedin =
+ (Js.Unsafe.coerce form)##.keepmeloggedin##.checked |> Js.to_bool
+ in
+ Dom.preventDefault ev;
+ match Os_connect_phone.connect ~keepmeloggedin ~password number with
+ | `Login_ok -> Os_lib.reload ()
+ | `Wrong_password -> Os_msg.msg ~level:`Err "Wrong password"
+ | `No_such_user -> Os_msg.msg ~level:`Err "No such user"
+ | `Password_not_set -> Os_msg.msg ~level:`Err "User password not set")
let%shared
connect_form
@@ -302,29 +291,26 @@ let%shared
(a_onclick
[%client
(fun _ ->
- Lwt.async (fun () ->
+ Eio_js.start (fun () ->
~%onclick ();
let upload_service ?progress ?cropping file =
Ot_picture_uploader.ocaml_service_upload ?progress ?cropping
~service:~%service ~arg:() file
in
- Lwt.catch
- (fun () ->
- ignore
- @@ Ot_popup.popup
- ~close_button:[Os_icons.F.close ()]
- ~onclose:(fun () ->
- Eliom_client.change_page
- ~service:Eliom_service.reload_action () ())
- (fun close ->
- Ot_picture_uploader.mk_form ~crop:~%crop
- ~input:~%input ~submit:~%submit
- ~after_submit:close upload_service);
- Lwt.return_unit)
- (fun exn ->
- Os_msg.msg ~level:`Err "Error while uploading the picture";
- Logs.info (fun fmt -> fmt "→ %s" (Printexc.to_string exn));
- Lwt.return_unit))
+ try
+ ignore
+ @@ Ot_popup.popup
+ ~close_button:[Os_icons.F.close ()]
+ ~onclose:(fun () ->
+ Eliom_client.change_page
+ ~service:Eliom_service.reload_action () ())
+ (fun close ->
+ Ot_picture_uploader.mk_form ~crop:~%crop
+ ~input:~%input ~submit:~%submit
+ ~after_submit:close upload_service)
+ with exn ->
+ Os_msg.msg ~level:`Err "Error while uploading the picture";
+ Logs.info (fun fmt -> fmt "→ %s" (Printexc.to_string exn)))
: _)]
:: a)
content
@@ -339,12 +325,11 @@ let%shared
let l = D.Raw.a [txt text_link] in
ignore
[%client
- (Lwt_js_events.(
+ (Eio_js_events.(
async (fun () ->
- clicks (To_dom.of_element ~%l) (fun _ _ ->
+ clicks (To_dom.of_element ~%l) (fun _ ->
~%close ();
- Eliom_client.exit_to ~service:Os_tips.reset_tips_service () ();
- Lwt.return_unit)))
+ Eliom_client.exit_to ~service:Os_tips.reset_tips_service () ())))
: unit)];
l
@@ -352,9 +337,9 @@ let%shared disconnect_all_link ?(text_link = "Logout on all my devices") () =
let l = D.Raw.a [txt text_link] in
ignore
[%client
- (Lwt_js_events.(
+ (Eio_js_events.(
async (fun () ->
- clicks (To_dom.of_element ~%l) (fun _ _ ->
+ clicks (To_dom.of_element ~%l) (fun _ ->
Os_session.disconnect_all ())))
: unit)];
l
@@ -364,22 +349,21 @@ let%shared
?a
~button
~(popup_content :
- ((unit -> unit Lwt.t)
- -> [< Html_types.div_content] Eliom_content.Html.elt Lwt.t)
+ ((unit -> unit) -> [< Html_types.div_content] Eliom_content.Html.elt)
Eliom_client_value.t)
()
=
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%button)
- (fun _ _ ->
- let* _ =
+ (Eio_js_events.async (fun () ->
+ Eio_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%button)
+ (fun _ ->
+ let _ =
Ot_popup.popup ?a:~%a
~close_button:[Os_icons.F.close ()]
~%popup_content
in
- Lwt.return_unit))
+ ()))
: _)]
let%client
@@ -393,7 +377,7 @@ let%client
=
let popup_content _ =
let h = h2 [txt content_popup] in
- Lwt.return @@ div
+ div
@@
if !enable_phone
then
@@ -428,8 +412,7 @@ let%shared
let popup_content =
[%client
fun close ->
- Lwt.return
- @@ div
+ div
[ h2 [txt ~%text_button]
; connect_form ~a_placeholder_email:~%a_placeholder_email
~a_placeholder_phone:~%a_placeholder_phone
@@ -439,7 +422,7 @@ let%shared
; forgotpwd_button ~content_popup:~%content_popup_forgotpwd
~text_button:~%text_button_forgotpwd
~text_send_button:~%text_send_button
- ~close:(fun () -> Lwt.async close)
+ ~close:(fun () -> Eio_js.start close)
() ]]
in
let button_name = text_button in
@@ -465,7 +448,7 @@ let%shared
; sign_up_form ~a_placeholder_email:~%a_placeholder_email
~text:~%text_send_button () ]
in
- Lwt.return @@ div
+ div
@@
if !enable_phone
then
@@ -486,7 +469,7 @@ let%shared disconnect_link ?(text_logout = "Logout") ?(a = []) () =
(a_onclick
[%client
fun _ ->
- Lwt.async (fun () ->
+ Eio_js.start (fun () ->
Eliom_client.change_page ~service:Os_services.disconnect_service
() ())]
:: a)
@@ -518,7 +501,7 @@ let%shared
sign_up_button ~a_placeholder_email ~text_button:text_sign_up
~text_send_button ()
in
- Lwt.return @@ div ~a:[a_class ["os-connection-box"]] [sign_in; sign_up]
+ div ~a:[a_class ["os-connection-box"]] [sign_in; sign_up]
let%shared
user_box
@@ -538,6 +521,6 @@ let%shared
connection_box ~a_placeholder_email ~a_placeholder_pwd
~text_keep_me_logged_in ~content_popup_forgotpwd ~text_button_forgotpwd
~text_sign_in ~text_sign_up ~text_send_button ()
- | Some user -> Lwt.return (connected_user_box ~user)
+ | Some user -> connected_user_box ~user
let%shared enable_phone () = enable_phone := true
diff --git a/src/os_user_view.eliomi b/src/os_user_view.eliomi
index b6de330e..4c388794 100644
--- a/src/os_user_view.eliomi
+++ b/src/os_user_view.eliomi
@@ -315,7 +315,7 @@ val connection_box :
-> ?text_sign_up:string
-> ?text_send_button:string
-> unit
- -> [> Html_types.div] Eliom_content.Html.D.elt Lwt.t
+ -> [> Html_types.div] Eliom_content.Html.D.elt
(** A box (in a div with the CSS class ["os-connection-box"]) with a sign in and
a sign out button. [?text_sign_in] (resp. [text_sign_up]) is the text for the
sign in (resp. sign up) button, default is ["Sign in"] (resp. ["Sign up"]).
@@ -332,7 +332,7 @@ val user_box :
-> ?text_send_button:string
-> ?user:Os_types.User.t
-> unit
- -> [> Html_types.div] Eliom_content.Html.F.elt Lwt.t
+ -> [> Html_types.div] Eliom_content.Html.F.elt
(** Return {!connection_box} if no user is connected (i.e. [user] is [None]).
Else {!connected_user_box}.
*)
diff --git a/template.distillery/Makefile.mobile b/template.distillery/Makefile.mobile
index 780bfe54..7f8bb28e 100644
--- a/template.distillery/Makefile.mobile
+++ b/template.distillery/Makefile.mobile
@@ -239,7 +239,7 @@ $(CORDOVAPATH)/www/eliom.html: $(CORDOVAPATH) \
# Eliom loader is used in the index.html to retrieve update from the server.
mobile/eliom_loader.byte: mobile/eliom_loader.ml
ocamlfind ocamlc \
- -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt \
+ -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt,lwt_ppx \
-linkpkg -o mobile/eliom_loader.byte \
$<
diff --git a/template.distillery/PROJECT_NAME.conf.in b/template.distillery/PROJECT_NAME.conf.in
index 7ceaffc4..8525e286 100644
--- a/template.distillery/PROJECT_NAME.conf.in
+++ b/template.distillery/PROJECT_NAME.conf.in
@@ -27,11 +27,10 @@
-->
-
+
diff --git a/template.distillery/PROJECT_NAME.eliom b/template.distillery/PROJECT_NAME.eliom
index 999b00a5..d0696aa1 100644
--- a/template.distillery/PROJECT_NAME.eliom
+++ b/template.distillery/PROJECT_NAME.eliom
@@ -1,5 +1,3 @@
-open%shared Lwt.Syntax
-
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
@@ -32,8 +30,8 @@ let%shared () =
(Os_session.Opt.connected_fun %%%MODULE_NAME%%%_handlers.action_link_handler);
Eliom_registration.Action.register ~service:Os_services.add_email_service
(fun () email ->
- let* () = Os_handlers.add_email_handler () email in
- add_email_notif (); Lwt.return_unit);
+ let () = Os_handlers.add_email_handler () email in
+ add_email_notif ());
Eliom_registration.Action.register
~service:Os_services.update_language_service
%%%MODULE_NAME%%%_handlers.update_language_handler;
@@ -50,24 +48,29 @@ let%server () =
~service:%%%MODULE_NAME%%%_services.upload_user_avatar_service
(Os_session.connected_fun %%%MODULE_NAME%%%_handlers.upload_user_avatar_handler)
-(* Print more debugging information when is in config file
- (DEBUG = yes in Makefile.options).
- Example of use:
- let section = Logs.Src.create "%%%MODULE_NAME%%%:sectionname"
- ...
- Logs.info ~src:section (fun fmt -> "This is an information %i " 1);
- (or Logs.debug, Logs.err etc.)
+(* Print more debugging information when is in config file (DEBUG =
+ yes in Makefile.options). Example of use: let src = Logs.Src.create
+ "%%%MODULE_NAME%%%.sectionname" module Log = (val Logs.src_log src : Logs.LOG) ...
+ Log.info (fun m -> m "This is an information"); (or Log.debug, Log.warn,
+ Log.err etc.)
*)
+let%client () =
+ Js_of_ocaml.Console.console##log (Js_of_ocaml.Js.string "=== CLIENT MODULE INIT ===")
+
let%server _ =
if Eliom_config.get_debugmode ()
then (
ignore
[%client
- ((* Eliom_config.debug_timings := true; *)
- Logs.set_level (Some Logs.Debug)
+ (print_endline "hello";
+ (* Eliom_config.debug_timings := true; *)
+ (* Logs.Src.set_level (Logs.Src.create "eliom.client") (Some Logs.Debug); *)
+ (* Logs.Src.set_level (Logs.Src.create "os") (Some Logs.Debug); *)
+ Logs.Src.set_level (Logs.Src.create "%%%MODULE_NAME%%%") (Some Logs.Debug)
+ (* Logs.set_level (Some Logs.Debug) *)
: unit)];
- Logs.set_level (Some Logs.Debug))
-
+ (* Logs.set_level (Some Logs.Debug) *)
+ Logs.Src.set_level (Logs.Src.create "%%%MODULE_NAME%%%") (Some Logs.Debug))
(* The modules below are all the modules that needs to be explicitely
linked-in. *)
@@ -75,26 +78,26 @@ let%server _ =
[%%shared.start]
module Demo = Demo
+module Demo_rpc = Demo_rpc
+module Demo_ref = Demo_ref
+module Demo_popu = Demo_popup
+module Demo_spinner = Demo_spinner
+module Demo_pgocaml = Demo_pgocaml
+module Demo_users = Demo_users
+module Demo_links = Demo_links
+module Demo_i18n = Demo_i18n
module Demo_cache = Demo_cache
module Demo_calendar = Demo_calendar
module Demo_carousel1 = Demo_carousel1
module Demo_carousel2 = Demo_carousel2
module Demo_carousel3 = Demo_carousel3
-module Demo_i18n = Demo_i18n
-module Demo_links = Demo_links
+module Demo_timepicker = Demo_timepicker
+module Demo_tongue = Demo_tongue
module Demo_notif = Demo_notif
-module Demo_pagetransition = Demo_pagetransition
-module Demo_pgocaml = Demo_pgocaml
-module Demo_popup = Demo_popup
module Demo_pulltorefresh = Demo_pulltorefresh
module Demo_react = Demo_react
-module Demo_ref = Demo_ref
-module Demo_rpc = Demo_rpc
-module Demo_spinner = Demo_spinner
-module Demo_timepicker = Demo_timepicker
+module Demo_pagetransition = Demo_pagetransition
module Demo_tips = Demo_tips
-module Demo_tongue = Demo_tongue
-module Demo_users = Demo_users
module %%%MODULE_NAME%%%_config = %%%MODULE_NAME%%%_config
[%%client.start]
diff --git a/template.distillery/PROJECT_NAME.opam b/template.distillery/PROJECT_NAME.opam
index 707c0315..e27d7317 100644
--- a/template.distillery/PROJECT_NAME.opam
+++ b/template.distillery/PROJECT_NAME.opam
@@ -5,6 +5,6 @@ synopsis: "%%%PROJECT_NAME%%%"
depends: [
"eliom" {>= "11.0.0" & < "12.0.0"}
- "ocsipersist-pgsql-config" {>= "2.0" & < "3.0"}
+ "ocsipersist-sqlite-config" {>= "2.0" & < "3.0"}
"ocsigen-start" {>= "7.0.0" & < "8.0.0"}
]
diff --git a/template.distillery/PROJECT_NAME_container.eliom b/template.distillery/PROJECT_NAME_container.eliom
index ac29e152..0cbf8d2b 100644
--- a/template.distillery/PROJECT_NAME_container.eliom
+++ b/template.distillery/PROJECT_NAME_container.eliom
@@ -1,11 +1,9 @@
-open%shared Lwt.Syntax
-
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
let%shared os_header ?user () =
let open Eliom_content.Html.F in
- let* user_box =
+ let user_box =
Os_user_view.user_box ~a_placeholder_email:[%i18n S.your_email]
~a_placeholder_pwd:[%i18n S.your_password]
~text_keep_me_logged_in:[%i18n S.keep_logged_in]
@@ -15,15 +13,14 @@ let%shared os_header ?user () =
~text_sign_up:[%i18n S.sign_up ~capitalize:true]
~text_send_button:[%i18n S.send ~capitalize:true] ?user ()
in
- Lwt.return
- (header
- ~a:[a_class ["os-page-header"]]
- [ a
- ~a:[a_class ["os-page-header-app-name"]]
- ~service:Os_services.main_service
- [txt %%%MODULE_NAME%%%_base.displayed_app_name]
- ()
- ; user_box ])
+ header
+ ~a:[a_class ["os-page-header"]]
+ [ a
+ ~a:[a_class ["os-page-header-app-name"]]
+ ~service:Os_services.main_service
+ [txt %%%MODULE_NAME%%%_base.displayed_app_name]
+ ()
+ ; user_box ]
let%shared os_footer () =
let open Eliom_content.Html.F in
@@ -38,14 +35,12 @@ let%shared os_footer () =
; a ~service:%%%MODULE_NAME%%%_services.ocsigen_service [txt " Ocsigen "] ()
; txt [%i18n S.footer_technology] ] ]
-let%rpc get_wrong_pdata () :
- ((string * string) * (string * string)) option Lwt.t
- =
- Lwt.return @@ Eliom_reference.Volatile.get Os_msg.wrong_pdata
+let%rpc get_wrong_pdata () : ((string * string) * (string * string)) option =
+ Eliom_reference.Volatile.get Os_msg.wrong_pdata
let%shared connected_welcome_box () =
let open Eliom_content.Html.F in
- let* wrong_pdata = get_wrong_pdata () in
+ let wrong_pdata = get_wrong_pdata () in
let info, ((fn, ln), (p1, p2)) =
match wrong_pdata with
| None ->
@@ -56,37 +51,34 @@ let%shared connected_welcome_box () =
, (("", ""), ("", "")) )
| Some wpd -> p [txt [%i18n S.wrong_data_fix]], wpd
in
- Lwt.return
- @@ div
- ~a:[a_class ["os-welcome-box"]]
- [ div [h2 [%i18n welcome ~capitalize:true]; info]
- ; Os_user_view.information_form
- ~a_placeholder_password:[%i18n S.password]
- ~a_placeholder_retype_password:[%i18n S.retype_password]
- ~a_placeholder_firstname:[%i18n S.your_first_name]
- ~a_placeholder_lastname:[%i18n S.your_last_name]
- ~text_submit:[%i18n S.submit] ~firstname:fn ~lastname:ln
- ~password1:p1 ~password2:p2 () ]
+ div
+ ~a:[a_class ["os-welcome-box"]]
+ [ div [h2 [%i18n welcome ~capitalize:true]; info]
+ ; Os_user_view.information_form ~a_placeholder_password:[%i18n S.password]
+ ~a_placeholder_retype_password:[%i18n S.retype_password]
+ ~a_placeholder_firstname:[%i18n S.your_first_name]
+ ~a_placeholder_lastname:[%i18n S.your_last_name]
+ ~text_submit:[%i18n S.submit] ~firstname:fn ~lastname:ln ~password1:p1
+ ~password2:p2 () ]
let%shared get_user_data = function
- | None -> Lwt.return_none
+ | None -> None
| Some myid ->
- let* u = Os_user_proxy.get_data myid in
- Lwt.return_some u
+ let u = Os_user_proxy.get_data myid in
+ Some u
let%shared page ?html_a ?a ?title ?head myid_o content =
- let* me = get_user_data myid_o in
- let* content =
+ let me = get_user_data myid_o in
+ let content =
match me with
| Some me when not (Os_user.is_complete me) ->
- let* cwb = connected_welcome_box () in
- Lwt.return @@ (cwb :: content)
- | _ -> Lwt.return @@ content
+ let cwb = connected_welcome_box () in
+ cwb :: content
+ | _ -> content
in
- let* h = os_header ?user:me () in
- Lwt.return
- (Os_page.content ?html_a ?a ?title ?head
- [ h
- ; Eliom_content.Html.F.(div ~a:[a_class ["os-body"]] content)
- ; os_footer ()
- ; %%%MODULE_NAME%%%_drawer.make ?user:me () ])
+ let h = os_header ?user:me () in
+ Os_page.content ?html_a ?a ?title ?head
+ [ h
+ ; Eliom_content.Html.F.(div ~a:[a_class ["os-body"]] content)
+ ; os_footer ()
+ ; %%%MODULE_NAME%%%_drawer.make ?user:me () ]
diff --git a/template.distillery/PROJECT_NAME_container.eliomi b/template.distillery/PROJECT_NAME_container.eliomi
index 5997040c..22b5aed8 100644
--- a/template.distillery/PROJECT_NAME_container.eliomi
+++ b/template.distillery/PROJECT_NAME_container.eliomi
@@ -8,18 +8,15 @@
val os_header :
?user:Os_types.User.t
-> unit
- -> [> `Header] Eliom_content.Html.F.elt Lwt.t
+ -> [> `Header] Eliom_content.Html.F.elt
(** [os_header ?user ()] defines the header for all pages. In this
template, it's a userbox and the user name is displayed. *)
val os_footer : unit -> [> `Footer] Eliom_content.Html.F.elt
(** [os_footer ()] defines a footer for the page. *)
-val connected_welcome_box :
- unit
- -> [> Html_types.div] Eliom_content.Html.F.elt Lwt.t
-
-val get_user_data : Os_types.User.id option -> Os_types.User.t option Lwt.t
+val connected_welcome_box : unit -> [> Html_types.div] Eliom_content.Html.F.elt
+val get_user_data : Os_types.User.id option -> Os_types.User.t option
val page :
?html_a:Html_types.html_attrib Eliom_content.Html.attrib list
@@ -29,7 +26,7 @@ val page :
-> Os_types.User.id option
-> [< Html_types.div_content_fun > `Div] Eliom_content.Html.F.elt
Eliom_content.Html.F.list_wrap
- -> Os_page.content Lwt.t
+ -> Os_page.content
(** [page userid_o content] returns a page personalized for the user
with id [myid_o] and with the content [content]. It adds a header,
a footer, and a drawer menu. If the user profile is not
@@ -37,6 +34,4 @@ val page :
[%%shared.start]
-val get_wrong_pdata :
- unit
- -> ((string * string) * (string * string)) option Lwt.t
+val get_wrong_pdata : unit -> ((string * string) * (string * string)) option
diff --git a/template.distillery/PROJECT_NAME_drawer.eliom b/template.distillery/PROJECT_NAME_drawer.eliom
index 4c480f09..52a18fef 100644
--- a/template.distillery/PROJECT_NAME_drawer.eliom
+++ b/template.distillery/PROJECT_NAME_drawer.eliom
@@ -1,7 +1,7 @@
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
-[%%shared open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(** This module defines the drawer menu *)
diff --git a/template.distillery/PROJECT_NAME_handlers.eliom b/template.distillery/PROJECT_NAME_handlers.eliom
index 1b64986f..e162b54b 100644
--- a/template.distillery/PROJECT_NAME_handlers.eliom
+++ b/template.distillery/PROJECT_NAME_handlers.eliom
@@ -1,9 +1,7 @@
-open%shared Lwt.Syntax
-
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
-[%%shared open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Upload user avatar *)
let upload_user_avatar_handler myid () ((), (cropping, photo)) =
@@ -12,13 +10,16 @@ let upload_user_avatar_handler myid () ((), (cropping, photo)) =
(List.hd !%%%MODULE_NAME%%%_config.avatar_dir)
(List.tl !%%%MODULE_NAME%%%_config.avatar_dir)
in
- let* avatar = Os_uploader.record_image avatar_dir ~ratio:1. ?cropping photo in
- let* user = Os_user.user_of_userid myid in
+ let avatar = Os_uploader.record_image avatar_dir ~ratio:1. ?cropping photo in
+ let user = Os_user.user_of_userid myid in
let old_avatar = Os_user.avatar_of_user user in
- let* () = Os_user.update_avatar ~userid:myid ~avatar in
+ let () = Os_user.update_avatar ~userid:myid ~avatar in
match old_avatar with
- | None -> Lwt.return_unit
- | Some old_avatar -> Lwt_unix.unlink (Filename.concat avatar_dir old_avatar)
+ | None -> ()
+ | Some old_avatar ->
+ let env = Stdlib.Option.get (Eio.Fiber.get Ocsigen_lib.env) in
+ let fs = Eio.Stdenv.fs env in
+ Eio.Path.unlink Eio.Path.(fs / Filename.concat avatar_dir old_avatar)
(* Set personal data *)
@@ -26,7 +27,7 @@ let%server set_personal_data_handler =
Os_session.connected_fun Os_handlers.set_personal_data_handler
let%rpc set_personal_data_rpc (data : (string * string) * (string * string)) :
- unit Lwt.t
+ unit
=
set_personal_data_handler () data
@@ -37,7 +38,7 @@ let%client set_personal_data_handler () = set_personal_data_rpc
let%server forgot_password_handler =
Os_handlers.forgot_password_handler %%%MODULE_NAME%%%_services.settings_service
-let%rpc forgot_password_rpc (email : string) : unit Lwt.t =
+let%rpc forgot_password_rpc (email : string) : unit =
forgot_password_handler () email
let%client forgot_password_handler () = forgot_password_rpc
@@ -47,38 +48,37 @@ let%client forgot_password_handler () = forgot_password_rpc
password. You can create your own action links and define their
behavior here. *)
let%shared action_link_handler myid_o akey () =
- Lwt.catch
- (fun () ->
- (* We try first the default actions (activation link, reset
+ try
+ (* We try first the default actions (activation link, reset
password) *)
- Os_handlers.action_link_handler myid_o akey ())
- (function
- | Os_handlers.No_such_resource | Os_handlers.Invalid_action_key _ ->
- Os_msg.msg ~level:`Err ~onload:true [%i18n S.invalid_action_key];
- Eliom_registration.(appl_self_redirect Action.send) ()
- | e ->
- let* email, phantom_user =
- match e with
- | Os_handlers.Account_already_activated_unconnected
- { Os_types.Action_link_key.userid = _
- ; email
- ; validity = _
- ; action = _
- ; data = _
- ; autoconnect = _ } ->
- Lwt.return (email, false)
- | Os_handlers.Custom_action_link
- ( { Os_types.Action_link_key.userid = _
- ; email
- ; validity = _
- ; action = _
- ; data = _
- ; autoconnect = _ }
- , phantom_user ) ->
- Lwt.return (email, phantom_user)
- | _ -> Lwt.fail e
- in
- (* Define here your custom action links. If phantom_user is true,
+ Os_handlers.action_link_handler myid_o akey ()
+ with
+ | Os_handlers.No_such_resource | Os_handlers.Invalid_action_key _ ->
+ Os_msg.msg ~level:`Err ~onload:true [%i18n S.invalid_action_key];
+ Eliom_registration.(appl_self_redirect Action.send) ()
+ | e ->
+ let email, phantom_user =
+ match e with
+ | Os_handlers.Account_already_activated_unconnected
+ { Os_types.Action_link_key.userid = _
+ ; email
+ ; validity = _
+ ; action = _
+ ; data = _
+ ; autoconnect = _ } ->
+ email, false
+ | Os_handlers.Custom_action_link
+ ( { Os_types.Action_link_key.userid = _
+ ; email
+ ; validity = _
+ ; action = _
+ ; data = _
+ ; autoconnect = _ }
+ , phantom_user ) ->
+ email, phantom_user
+ | _ -> raise e
+ in
+ (* Define here your custom action links. If phantom_user is true,
it means the link has been created for an email that does not
correspond to an existing user. By default, we just display a
sign up form or phantom users, a login form for others. You
@@ -87,57 +87,54 @@ let%shared action_link_handler myid_o akey () =
Perhaps personalise the intended behavior for when you meet
[Account_already_activated_unconnected]. *)
- if myid_o = None (* Not currently connected, and no autoconnect *)
- then
- if phantom_user
- then
- let page =
- [ div
- ~a:[a_class ["login-signup-box"]]
- [ Os_user_view.sign_up_form
- ~a_placeholder_email:[%i18n S.your_email]
- ~text:[%i18n S.sign_up] ~email () ] ]
- in
- %%%MODULE_NAME%%%_base.App.send
- (%%%MODULE_NAME%%%_page.make_page (Os_page.content page))
- else
- let page =
- [ div
- ~a:[a_class ["login-signup-box"]]
- [ Os_user_view.connect_form
- ~a_placeholder_email:[%i18n S.your_email]
- ~a_placeholder_pwd:[%i18n S.your_password]
- ~text_keep_me_logged_in:[%i18n S.keep_logged_in]
- ~text_sign_in:[%i18n S.sign_in] ~email () ] ]
- in
- %%%MODULE_NAME%%%_base.App.send
- (%%%MODULE_NAME%%%_page.make_page (Os_page.content page))
- else
- (*VVV In that case we must do something more complex. Check
+ if myid_o = None (* Not currently connected, and no autoconnect *)
+ then
+ if phantom_user
+ then
+ let page =
+ [ div
+ ~a:[a_class ["login-signup-box"]]
+ [ Os_user_view.sign_up_form
+ ~a_placeholder_email:[%i18n S.your_email]
+ ~text:[%i18n S.sign_up] ~email () ] ]
+ in
+ %%%MODULE_NAME%%%_base.App.send
+ (%%%MODULE_NAME%%%_page.make_page (Os_page.content page))
+ else
+ let page =
+ [ div
+ ~a:[a_class ["login-signup-box"]]
+ [ Os_user_view.connect_form
+ ~a_placeholder_email:[%i18n S.your_email]
+ ~a_placeholder_pwd:[%i18n S.your_password]
+ ~text_keep_me_logged_in:[%i18n S.keep_logged_in]
+ ~text_sign_in:[%i18n S.sign_in] ~email () ] ]
+ in
+ %%%MODULE_NAME%%%_base.App.send
+ (%%%MODULE_NAME%%%_page.make_page (Os_page.content page))
+ else
+ (*VVV In that case we must do something more complex. Check
whether myid = userid and ask the user what he wants to
do. *)
- let open Eliom_registration in
- appl_self_redirect Redirection.send
- (Redirection Eliom_service.reload_action))
+ let open Eliom_registration in
+ appl_self_redirect Redirection.send
+ (Redirection Eliom_service.reload_action)
(* Set password *)
let%server set_password_handler =
Os_session.connected_fun (fun myid () (pwd, pwd2) ->
- let* () = Os_handlers.set_password_handler myid () (pwd, pwd2) in
- Lwt.return (Eliom_registration.Redirection Eliom_service.reload_action))
+ let () = Os_handlers.set_password_handler myid () (pwd, pwd2) in
+ Eliom_registration.Redirection Eliom_service.reload_action)
let%client set_password_handler () (pwd, pwd2) =
- let* () = Os_handlers.set_password_rpc (pwd, pwd2) in
- Lwt.return (Eliom_registration.Redirection Eliom_service.reload_action)
+ let () = Os_handlers.set_password_rpc (pwd, pwd2) in
+ Eliom_registration.Redirection Eliom_service.reload_action
(* Preregister *)
let%server preregister_handler = Os_handlers.preregister_handler
-
-let%rpc preregister_rpc (email : string) : unit Lwt.t =
- preregister_handler () email
-
+let%rpc preregister_rpc (email : string) : unit = preregister_handler () email
let%client preregister_handler () = preregister_rpc
let%shared main_service_handler myid_o () () =
@@ -167,10 +164,10 @@ let%shared about_handler myid_o () () =
; p [%i18n about_handler_license] ] ]
let%shared settings_handler myid_o () () =
- let* content =
+ let content =
match myid_o with
| Some _ -> %%%MODULE_NAME%%%_settings.settings_content ()
- | None -> Lwt.return [p [%i18n log_in_to_see_page ~capitalize:true]]
+ | None -> [p [%i18n log_in_to_see_page ~capitalize:true]]
in
%%%MODULE_NAME%%%_container.page myid_o content
diff --git a/template.distillery/PROJECT_NAME_handlers.eliomi b/template.distillery/PROJECT_NAME_handlers.eliomi
index 010709e9..12ea501b 100644
--- a/template.distillery/PROJECT_NAME_handlers.eliomi
+++ b/template.distillery/PROJECT_NAME_handlers.eliomi
@@ -14,7 +14,7 @@ val upload_user_avatar_handler :
-> unit
-> unit
* ((float * float * float * float) option * Ocsigen_extensions.file_info)
- -> unit Lwt.t
+ -> unit
(** Update new user avatar with cropping option. The new avatar is saved
and the old one is removed. *)
@@ -23,12 +23,12 @@ val upload_user_avatar_handler :
val set_personal_data_handler :
unit
-> (string * string) * (string * string)
- -> unit Lwt.t
+ -> unit
(** Update personal data. It uses the default OS handler
{!Os_handlers.set_personal_data_handler} and gets the user information
with {!Os_session.connected_fun}. *)
-val forgot_password_handler : unit -> string -> unit Lwt.t
+val forgot_password_handler : unit -> string -> unit
(** Reset forgotten password. It uses the default OS handler
{!Os_handlers.forgot_password_handler} with the main service. *)
@@ -36,17 +36,17 @@ val action_link_handler :
Os_types.User.id option
-> string
-> unit
- -> %%%MODULE_NAME%%%_base.App.result Lwt.t
+ -> %%%MODULE_NAME%%%_base.App.result
val set_password_handler :
unit
-> string * string
- -> Eliom_service.non_ocaml Eliom_registration.redirection Lwt.t
+ -> Eliom_service.non_ocaml Eliom_registration.redirection
(** Set a new password. It uses the default OS handler
{!Os_handlers.set_password_handler} and gets the user information
with {!Os_session.connected_fun}. *)
-val preregister_handler : unit -> string -> unit Lwt.t
+val preregister_handler : unit -> string -> unit
(** The following functions are the handlers for the three main pages.
They are created with {!%%%MODULE_NAME%%%_container.page} which
@@ -60,26 +60,19 @@ val main_service_handler :
Os_types.User.id option
-> unit
-> unit
- -> Os_page.content Lwt.t
+ -> Os_page.content
(** The first page of the application *)
-val about_handler :
- Os_types.User.id option
- -> unit
- -> unit
- -> Os_page.content Lwt.t
+val about_handler : Os_types.User.id option -> unit -> unit -> Os_page.content
(** About page *)
val settings_handler :
Os_types.User.id option
-> unit
-> unit
- -> Os_page.content Lwt.t
+ -> Os_page.content
(** Settings page. If the user is connected (see
{!%%%MODULE_NAME%%%_container.get_user_data}), a settings
container will be created. *)
-val update_language_handler :
- unit
- -> string
- -> Eliom_registration.Action.page Lwt.t
+val update_language_handler : unit -> string -> Eliom_registration.Action.page
diff --git a/template.distillery/PROJECT_NAME_icons.eliom b/template.distillery/PROJECT_NAME_icons.eliom
index 4d390862..2ec64bd1 100644
--- a/template.distillery/PROJECT_NAME_icons.eliom
+++ b/template.distillery/PROJECT_NAME_icons.eliom
@@ -15,8 +15,10 @@ module Make (A : module type of Eliom_content.Html.F) = struct
"i" is used because it is the de facto standard for icons. The
optional parameter ~a is at the end to be able to add other CSS
classes with predefined icons. *)
- let icon classes
- ?(a = ([] : Html_types.i_attrib Eliom_content.Html.attrib list)) ()
+ let icon
+ classes
+ ?(a = ([] : Html_types.i_attrib Eliom_content.Html.attrib list))
+ ()
=
A.i ~a:(A.a_class ("fa" :: classes) :: a) []
diff --git a/template.distillery/PROJECT_NAME_language.eliom b/template.distillery/PROJECT_NAME_language.eliom
index 1dfc11a8..e4f3ff65 100644
--- a/template.distillery/PROJECT_NAME_language.eliom
+++ b/template.distillery/PROJECT_NAME_language.eliom
@@ -1,5 +1,3 @@
-open%server Lwt.Syntax
-
(* This file was generated by Ocsigen-start.
Feel free to use it, modify it, and redistribute it as you wish. *)
@@ -12,8 +10,6 @@ let%server best_matched_language () =
in
(* Increasingly sort based on the quality *)
let lang = List.sort (fun (_, q1) (_, q2) -> compare q2 q1) lang in
- Lwt.return
- @@
(* The first language of the list is returned. If the list is empty,
the default language is returned. *)
let rec aux = function
@@ -32,28 +28,31 @@ let%server update_language lang =
ignore [%client (%%%MODULE_NAME%%%_i18n.set_language ~%lang : unit)];
(* Update in the database if a user is connected *)
match myid_o with
- | None -> Lwt.return_unit
+ | None -> ()
| Some userid -> Os_user.update_language ~userid ~language
let%server _ =
Os_session.on_start_process (fun _ ->
- let* (* Guess a default language. *)
- lang = best_matched_language () in
- ignore (update_language lang);
- Lwt.return_unit);
+ let
+ (* Guess a default language. *)
+ lang
+ =
+ best_matched_language ()
+ in
+ ignore (update_language lang));
Os_session.on_start_connected_process (fun userid ->
- let* (* Set language according to user preferences. *)
- language =
- Lwt.bind (Os_user.get_language userid) (function
- | Some lang ->
- Lwt.return (%%%MODULE_NAME%%%_i18n.guess_language_of_string lang)
- | None ->
- let* best_language = best_matched_language () in
- ignore
- (Os_user.update_language ~userid
- ~language:(%%%MODULE_NAME%%%_i18n.string_of_language best_language));
- Lwt.return best_language)
+ let
+ (* Set language according to user preferences. *)
+ language
+ =
+ match Os_user.get_language userid with
+ | Some lang -> %%%MODULE_NAME%%%_i18n.guess_language_of_string lang
+ | None ->
+ let best_language = best_matched_language () in
+ ignore
+ (Os_user.update_language ~userid
+ ~language:(%%%MODULE_NAME%%%_i18n.string_of_language best_language));
+ best_language
in
%%%MODULE_NAME%%%_i18n.set_language language;
- ignore [%client (%%%MODULE_NAME%%%_i18n.set_language ~%language : unit)];
- Lwt.return_unit)
+ ignore [%client (%%%MODULE_NAME%%%_i18n.set_language ~%language : unit)])
diff --git a/template.distillery/PROJECT_NAME_language.eliomi b/template.distillery/PROJECT_NAME_language.eliomi
index f0847b42..91b6e842 100644
--- a/template.distillery/PROJECT_NAME_language.eliomi
+++ b/template.distillery/PROJECT_NAME_language.eliomi
@@ -8,7 +8,7 @@
i18n-update] uses this module to create the i18n file for
translations (see [Makefile.options]). *)
-val update_language : %%%MODULE_NAME%%%_i18n.t -> unit Lwt.t
+val update_language : %%%MODULE_NAME%%%_i18n.t -> unit
(** [update_language language] updates the language (client and server
side) for the current user with the value [language]. It also
updates the value in the database if an user is connected. *)
diff --git a/template.distillery/PROJECT_NAME_mobile.eliom b/template.distillery/PROJECT_NAME_mobile.eliom
index e40f1cbe..8e1adea0 100644
--- a/template.distillery/PROJECT_NAME_mobile.eliom
+++ b/template.distillery/PROJECT_NAME_mobile.eliom
@@ -2,9 +2,9 @@
Feel free to use it, modify it, and redistribute it as you wish. *)
[%%client.start]
-[%%client open Lwt.Syntax]
-[%%client open Js_of_ocaml]
-[%%client open Js_of_ocaml_lwt]
+
+open%client Js_of_ocaml
+open%client Js_of_ocaml_eio
(* This RPC is called when client application is initialized. This
way, the server sends necessary cookies to the client (the mobile
@@ -14,28 +14,34 @@
The RPC only initializes Os_date by default, but you can add your
own actions to be performed server side on first client request, if
necessary. *)
-let%rpc init_request myid_o (tz : string) : unit Lwt.t =
- ignore myid_o; Os_date.initialize tz; Lwt.return_unit
-
-let to_lwt f =
- let wait, wakeup = Lwt.wait () in
- f (Lwt.wakeup wakeup);
- wait
-
-let ondeviceready =
- to_lwt (fun cont ->
- ignore
- @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
- (Js_of_ocaml.Dom_html.Event.make "deviceready")
- (Js_of_ocaml.Dom_html.handler (fun _ -> cont (); Js_of_ocaml.Js._true))
- Js_of_ocaml.Js._false)
+let%rpc init_request myid_o (tz : string) : unit =
+ ignore myid_o; Os_date.initialize tz
+
+(* Wait for an event using Eio. Must be called inside an Eio fiber. *)
+let await_event target event_name =
+ Eio_js_backend.await
+ ~setup:(fun ~resolve ~reject:_ ->
+ let handler = Js_of_ocaml.Dom_html.handler (fun _ ->
+ resolve ();
+ Js_of_ocaml.Js._true)
+ in
+ (* addEventListener returns an event_listener_id that can be used to remove it *)
+ Js_of_ocaml.Dom.addEventListener target
+ (Js_of_ocaml.Dom_html.Event.make event_name)
+ handler
+ Js_of_ocaml.Js._false)
+ ~cancel:(fun listener_id ->
+ Js_of_ocaml.Dom.removeEventListener listener_id)
+
+let ondeviceready () =
+ await_event Js_of_ocaml.Dom_html.document "deviceready"
let app_started = ref false
let initial_change_page = ref None
let change_page_gen action =
if !app_started
- then Lwt.async action
+ then Eio_js.start action
else if !initial_change_page = None
then initial_change_page := Some action
@@ -44,8 +50,8 @@ let change_page_uri uri =
let handle_initial_url () =
let tz = Os_date.user_tz () in
- let* () = init_request tz in
- let* () = ondeviceready in
+ let () = init_request tz in
+ let () = ondeviceready () in
app_started := true;
match !initial_change_page with
| None ->
@@ -54,15 +60,15 @@ let handle_initial_url () =
| Some action -> action ()
let () =
- Lwt.async @@ fun () ->
- if Eliom_client.is_client_app ()
- then (
- (* Initialize the application server-side; there should be a
+ Eio_js.start (fun () ->
+ if Eliom_client.is_client_app ()
+ then (
+ (* Initialize the application server-side; there should be a
single initial request for that. *)
- Os_date.disable_auto_init ();
- let* _ = Lwt_js_events.onload () in
- handle_initial_url ())
- else Lwt.return_unit
+ Os_date.disable_auto_init ();
+ let _ = Js_of_ocaml_eio.Eio_js_events.onload () in
+ handle_initial_url ())
+ else ())
(* Reactivate comet on resume and online events *)
@@ -110,9 +116,11 @@ type event =
Js_of_ocaml.Js.js_string Js_of_ocaml.Js.t Js_of_ocaml.Js.readonly_prop
; params : 'a. 'a Js_of_ocaml.Js.t Js_of_ocaml.Js.readonly_prop >
+(* Returns the universal links API if available. Must be called inside an Eio fiber
+ since it waits for deviceready. *)
let universal_links () =
- let* () = ondeviceready in
- Lwt.return @@ Js_of_ocaml.Js.Optdef.to_option
+ let () = ondeviceready () in
+ Js_of_ocaml.Js.Optdef.to_option
@@ (Js_of_ocaml.Js.Unsafe.global##.universalLinks
: < subscribe :
Js_of_ocaml.Js.js_string Js_of_ocaml.Js.opt
@@ -124,8 +132,9 @@ let universal_links () =
Js_of_ocaml.Js.t
Js_of_ocaml.Js.Optdef.t)
-let _ =
- Lwt.bind (universal_links ()) (function
+let () =
+ Eio_js.start (fun () ->
+ match universal_links () with
| Some universal_links ->
Js_of_ocaml.Console.console##log
(Js_of_ocaml.Js.string "Universal links: registering");
@@ -136,9 +145,8 @@ let _ =
ev##.url;
change_page_uri (Js_of_ocaml.Js.to_string ev##.url)));
Js_of_ocaml.Console.console##log
- (Js_of_ocaml.Js.string "Universal links: registered");
- Lwt.return_unit
- | None -> Lwt.return_unit)
+ (Js_of_ocaml.Js.string "Universal links: registered")
+ | None -> ())
(* Debugging *)
@@ -148,4 +156,5 @@ let _ =
debugger console, you can do so by uncommenting the following
lines. *)
(* let () = Eliom_config.debug_timings := true *)
-(* let () = Logs.set_level (Some Logs.Debug) *)
+(* let () = Logs.Src.set_level (Logs.Src.create "eliom.client") (Some Logs.Debug) *)
+(* let () = Logs.Src.set_level (Logs.Src.create "os") (Some Logs.Debug) *)
diff --git a/template.distillery/PROJECT_NAME_page.eliom b/template.distillery/PROJECT_NAME_page.eliom
index 698f9da1..b6df12d0 100644
--- a/template.distillery/PROJECT_NAME_page.eliom
+++ b/template.distillery/PROJECT_NAME_page.eliom
@@ -45,8 +45,8 @@ module Page_config = struct
:: css_name_script
@ app_js
- let default_predicate _ _ = Lwt.return_true
- let default_connected_predicate _ _ _ = Lwt.return_true
+ let default_predicate _ _ = true
+ let default_connected_predicate _ _ _ = true
let default_error_page _ _ exn =
%%%MODULE_NAME%%%_container.page None
diff --git a/template.distillery/PROJECT_NAME_page.eliomi b/template.distillery/PROJECT_NAME_page.eliomi
index 3ee5d3cd..35982927 100644
--- a/template.distillery/PROJECT_NAME_page.eliomi
+++ b/template.distillery/PROJECT_NAME_page.eliomi
@@ -16,48 +16,46 @@ module Page_config : sig
val local_js : 'a list
val local_css : string list list
val other_head : [> Html_types.head_content] Eliom_content.Html.F.elt list
- val default_predicate : 'a -> 'b -> bool Lwt.t
- val default_connected_predicate : 'a -> 'b -> 'c -> bool Lwt.t
- val default_error_page : 'a -> 'b -> exn -> Os_page.content Lwt.t
+ val default_predicate : 'a -> 'b -> bool
+ val default_connected_predicate : 'a -> 'b -> 'c -> bool
+ val default_error_page : 'a -> 'b -> exn -> Os_page.content
val default_connected_error_page :
Os_types.User.id option
-> 'a
-> 'b
-> exn
- -> Os_page.content Lwt.t
+ -> Os_page.content
end
val make_page : Os_page.content -> [> Html_types.html] Eliom_content.Html.elt
val page :
- ?predicate:('a -> 'b -> bool Lwt.t)
- -> ?fallback:('a -> 'b -> exn -> Os_page.content Lwt.t)
- -> ('a -> 'b -> Os_page.content Lwt.t)
+ ?predicate:('a -> 'b -> bool)
+ -> ?fallback:('a -> 'b -> exn -> Os_page.content)
+ -> ('a -> 'b -> Os_page.content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
module Opt : sig
val connected_page :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool Lwt.t)
- -> ?fallback:
- (Os_types.User.id option -> 'a -> 'b -> exn -> Os_page.content Lwt.t)
- -> (Os_types.User.id option -> 'a -> 'b -> Os_page.content Lwt.t)
+ -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool)
+ -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> Os_page.content)
+ -> (Os_types.User.id option -> 'a -> 'b -> Os_page.content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
end
val connected_page :
?allow:Os_types.Group.t list
-> ?deny:Os_types.Group.t list
- -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool Lwt.t)
- -> ?fallback:
- (Os_types.User.id option -> 'a -> 'b -> exn -> Os_page.content Lwt.t)
- -> (Os_types.User.id -> 'a -> 'b -> Os_page.content Lwt.t)
+ -> ?predicate:(Os_types.User.id option -> 'a -> 'b -> bool)
+ -> ?fallback:(Os_types.User.id option -> 'a -> 'b -> exn -> Os_page.content)
+ -> (Os_types.User.id -> 'a -> 'b -> Os_page.content)
-> 'a
-> 'b
- -> Html_types.html Eliom_content.Html.elt Lwt.t
+ -> Html_types.html Eliom_content.Html.elt
diff --git a/template.distillery/PROJECT_NAME_phone_connect.eliom b/template.distillery/PROJECT_NAME_phone_connect.eliom
index 5859727e..003d67d8 100644
--- a/template.distillery/PROJECT_NAME_phone_connect.eliom
+++ b/template.distillery/PROJECT_NAME_phone_connect.eliom
@@ -19,7 +19,7 @@ let%server () =
then
Os_connect_phone.set_send_sms_handler (fun ~number message ->
Printf.printf "Send SMS %s to %s\n%!" message number;
- Lwt.return (Ok ()))
+ Ok ())
let () =
if enable
diff --git a/template.distillery/PROJECT_NAME_settings.eliom b/template.distillery/PROJECT_NAME_settings.eliom
index c5ed9cda..34199ee5 100644
--- a/template.distillery/PROJECT_NAME_settings.eliom
+++ b/template.distillery/PROJECT_NAME_settings.eliom
@@ -1,9 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%client
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
-open Js_of_ocaml_lwt]
+
+open%client Js_of_ocaml_eio
let%shared update_main_email_button email =
let open Eliom_content.Html in
@@ -14,12 +12,12 @@ let%shared update_main_email_button email =
in
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%button)
- (fun _ _ ->
- let* () = Os_current_user.update_main_email ~%email in
- Eliom_client.change_page
- ~service:%%%MODULE_NAME%%%_services.settings_service () ()))
+ (Eio_js.start (fun () ->
+ Js_of_ocaml_eio.Eio_js_events.clicks
+ (Eliom_content.Html.To_dom.of_element ~%button) (fun _ ->
+ let () = Os_current_user.update_main_email ~%email in
+ Eliom_client.change_page
+ ~service:%%%MODULE_NAME%%%_services.settings_service () ()))
: unit)];
button
@@ -33,12 +31,12 @@ let%shared delete_email_button email =
in
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%button)
- (fun _ _ ->
- let* () = Os_current_user.remove_email_from_user ~%email in
- Eliom_client.change_page
- ~service:%%%MODULE_NAME%%%_services.settings_service () ()))
+ (Eio_js.start (fun () ->
+ Js_of_ocaml_eio.Eio_js_events.clicks
+ (Eliom_content.Html.To_dom.of_element ~%button) (fun _ ->
+ let () = Os_current_user.remove_email_from_user ~%email in
+ Eliom_client.change_page
+ ~service:%%%MODULE_NAME%%%_services.settings_service () ()))
: unit)];
button
@@ -81,25 +79,25 @@ let%shared li_of_email main_email (email, is_validated) =
let labels = labels_of_email is_main_email is_validated
and buttons = buttons_of_email is_main_email is_validated email
and email = span ~a:[a_class ["os-settings-email"]] [txt email] in
- Lwt.return (li ((email :: labels) @ buttons))
+ li ((email :: labels) @ buttons)
let%shared ul_of_emails (main_email, emails) =
let li_of_email = li_of_email main_email in
- let* li_list = Lwt_list.map_s li_of_email emails in
- Lwt.return Eliom_content.Html.D.(div ~a:[a_class ["os-emails"]] [ul li_list])
+ let li_list = List.map li_of_email emails in
+ Eliom_content.Html.D.(div ~a:[a_class ["os-emails"]] [ul li_list])
(* List with information about emails *)
-let%rpc get_emails myid () : (string option * (string * bool) list) Lwt.t =
- let* main_email = Os_db.User.email_of_userid myid in
- let* emails = Os_db.User.emails_of_userid myid in
- let* emails =
- Lwt_list.map_s
+let%rpc get_emails myid () : string option * (string * bool) list =
+ let main_email = Os_db.User.email_of_userid myid in
+ let emails = Os_db.User.emails_of_userid myid in
+ let emails =
+ List.map
(fun email ->
- let* v = Os_current_user.is_email_validated email in
- Lwt.return (email, v))
+ let v = Os_current_user.is_email_validated email in
+ email, v)
emails
in
- Lwt.return (main_email, emails)
+ main_email, emails
let%shared select_language_form select_language_name =
let open Eliom_content.Html in
@@ -125,34 +123,33 @@ let%shared select_language_form select_language_name =
D.Form.string ]
let%shared settings_content () =
- let* emails = get_emails () in
- let* emails = ul_of_emails emails in
- Lwt.return
- @@ Eliom_content.Html.D.
- [ div
- ~a:[a_class ["os-settings"]]
- [ p [%i18n change_password ~capitalize:true]
- ; Os_user_view.password_form ~a_placeholder_pwd:[%i18n S.password]
- ~a_placeholder_confirmation:[%i18n S.retype_password]
- ~text_send_button:[%i18n S.send]
- ~service:Os_services.set_password_service ()
- ; br ()
- ; Os_user_view.upload_pic_link
- ~submit:([a_class ["button"]], [txt "Submit"])
- ~content:[%i18n change_profile_picture]
- %%%MODULE_NAME%%%_services.upload_user_avatar_service
- ; br ()
- ; Os_user_view.reset_tips_link
- ~text_link:[%i18n S.see_help_again_from_beginning] ()
- ; br ()
- ; Os_user_view.disconnect_all_link
- ~text_link:[%i18n S.disconnect_all] ()
- ; br ()
- ; p [%i18n link_new_email]
- ; Os_user_view.generic_email_form
- ~a_placeholder_email:[%i18n S.email_address] ~text:[%i18n S.send]
- ~service:Os_services.add_email_service ()
- ; p [%i18n currently_registered_emails]
- ; div ~a:[a_class ["os-emails"]] [emails]
- ; Form.post_form ~service:Os_services.update_language_service
- select_language_form () ] ]
+ let emails = get_emails () in
+ let emails = ul_of_emails emails in
+ Eliom_content.Html.D.
+ [ div
+ ~a:[a_class ["os-settings"]]
+ [ p [%i18n change_password ~capitalize:true]
+ ; Os_user_view.password_form ~a_placeholder_pwd:[%i18n S.password]
+ ~a_placeholder_confirmation:[%i18n S.retype_password]
+ ~text_send_button:[%i18n S.send]
+ ~service:Os_services.set_password_service ()
+ ; br ()
+ ; Os_user_view.upload_pic_link
+ ~submit:([a_class ["button"]], [txt "Submit"])
+ ~content:[%i18n change_profile_picture]
+ %%%MODULE_NAME%%%_services.upload_user_avatar_service
+ ; br ()
+ ; Os_user_view.reset_tips_link
+ ~text_link:[%i18n S.see_help_again_from_beginning] ()
+ ; br ()
+ ; Os_user_view.disconnect_all_link ~text_link:[%i18n S.disconnect_all]
+ ()
+ ; br ()
+ ; p [%i18n link_new_email]
+ ; Os_user_view.generic_email_form
+ ~a_placeholder_email:[%i18n S.email_address] ~text:[%i18n S.send]
+ ~service:Os_services.add_email_service ()
+ ; p [%i18n currently_registered_emails]
+ ; div ~a:[a_class ["os-emails"]] [emails]
+ ; Form.post_form ~service:Os_services.update_language_service
+ select_language_form () ] ]
diff --git a/template.distillery/PROJECT_NAME_static_config.eliom.in b/template.distillery/PROJECT_NAME_static_config.eliom.in
index 206cc258..bb58b025 100644
--- a/template.distillery/PROJECT_NAME_static_config.eliom.in
+++ b/template.distillery/PROJECT_NAME_static_config.eliom.in
@@ -13,10 +13,8 @@ let%server set_static_config () =
Ocsigen_config.set_usedefaulthostname true;
Ocsigen_config.set_command_pipe "local/var/run/%%%PROJECT_NAME%%%-cmd";
Ocsigen_config.set_default_charset (Some "utf-8");
- Ocsipersist_settings.set_host "%%PGHOST%%";
- Ocsipersist_settings.set_port %%PGPORT%%;
- Ocsipersist_settings.set_database "ocsipersist_%%%PROJECT_NAME%%%";
- Ocsipersist.init ();
+ Ocsipersist_settings.set_db_file "local/var/data/ocsipersist-sqlite";
+ Ocsipersist.init ~env:(Option.get (Eio.Fiber.get Ocsigen_lib.env));
%%%MODULE_NAME%%%_config.os_db_database := Some "%%PGDATABASE%%";
%%%MODULE_NAME%%%_config.os_db_host := Some "%%PGHOST%%";
%%%MODULE_NAME%%%_config.os_db_user :=
diff --git a/template.distillery/demo.eliom b/template.distillery/demo.eliom
index 771dd124..6ca63ec3 100644
--- a/template.distillery/demo.eliom
+++ b/template.distillery/demo.eliom
@@ -1,7 +1,7 @@
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
-[%%shared open Eliom_content.Html.D]
+open%shared Eliom_content.Html.D
(* drawer / demo welcome page ***********************************************)
diff --git a/template.distillery/demo_cache.eliom b/template.distillery/demo_cache.eliom
index 85789677..751d251c 100644
--- a/template.distillery/demo_cache.eliom
+++ b/template.distillery/demo_cache.eliom
@@ -1,22 +1,18 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Eliom_cscache demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Page for this demo *)
let%shared page () =
- Lwt.return
- [ h1 [%i18n Demo.cache_1]
- ; p
- [%i18n
- Demo.cache_2
- ~eliom_cscache:[code [txt "Eliom_cscache"]]
- ~os_user_proxy:[code [txt "Os_user_proxy"]]]
- ; p [%i18n Demo.cache_3 ~eliom_cscache:[code [txt "Eliom_cscache"]]]
- ; p [%i18n Demo.cache_4 ~eliom_cscache:[code [txt "Eliom_cscache"]]] ]
+ [ h1 [%i18n Demo.cache_1]
+ ; p
+ [%i18n
+ Demo.cache_2
+ ~eliom_cscache:[code [txt "Eliom_cscache"]]
+ ~os_user_proxy:[code [txt "Os_user_proxy"]]]
+ ; p [%i18n Demo.cache_3 ~eliom_cscache:[code [txt "Eliom_cscache"]]]
+ ; p [%i18n Demo.cache_4 ~eliom_cscache:[code [txt "Eliom_cscache"]]] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -25,5 +21,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_cache
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-cache"]] myid_o p )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-cache"]] myid_o p
+ )
diff --git a/template.distillery/demo_calendar.eliom b/template.distillery/demo_calendar.eliom
index d62a4c73..ff832712 100644
--- a/template.distillery/demo_calendar.eliom
+++ b/template.distillery/demo_calendar.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Calendar demo *)
-open Eliom_content.Html.D]
+open%shared Eliom_content.Html.D
(* A reactive value containing the currently selected date *)
(* NOTE: in this example, we define a shared signal on the server side. Its
@@ -21,10 +18,7 @@ open Eliom_content.Html.D]
signals can't be inferred (it remains unknown at the end of the typing pass)
since it's never used throughout the program. *)
let%server s, f = Eliom_shared.React.S.create None
-
-let%client action y m d =
- ~%f (Some (y, m, d));
- Lwt.return_unit
+let%client action y m d = ~%f (Some (y, m, d))
let%shared string_of_date = function
| Some (y, m, d) ->
@@ -36,20 +30,18 @@ let%shared string_of_date = function
let%server date_as_string () : string Eliom_shared.React.S.t =
Eliom_shared.React.S.map [%shared string_of_date] s
-let%rpc date_reactive () : string Eliom_shared.React.S.t Lwt.t =
- Lwt.return @@ date_as_string ()
+let%rpc date_reactive () : string Eliom_shared.React.S.t = date_as_string ()
(* Page for this demo *)
let%shared page () =
let calendar =
Ot_calendar.make ~click_non_highlighted:true ~action:[%client action] ()
in
- let* dr = date_reactive () in
- Lwt.return
- [ h1 [%i18n Demo.calendar]
- ; p [%i18n Demo.this_page_show_calendar]
- ; div ~a:[a_class ["os-calendar"]] [calendar]
- ; p [Eliom_content.Html.R.txt dr] ]
+ let dr = date_reactive () in
+ [ h1 [%i18n Demo.calendar]
+ ; p [%i18n Demo.this_page_show_calendar]
+ ; div ~a:[a_class ["os-calendar"]] [calendar]
+ ; p [Eliom_content.Html.R.txt dr] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -58,6 +50,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_calendar
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-calendar"]] myid_o p
- )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page
+ ~a:[a_class ["os-page-demo-calendar"]]
+ myid_o p )
diff --git a/template.distillery/demo_carousel1.eliom b/template.distillery/demo_carousel1.eliom
index 349ed8f0..a7847b58 100644
--- a/template.distillery/demo_carousel1.eliom
+++ b/template.distillery/demo_carousel1.eliom
@@ -1,34 +1,32 @@
-open%shared Lwt.Syntax
-
-[%%client
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Carousel demo *)
-open Eliom_content.Html]
-
-[%%shared open Eliom_content.Html.F]
+open%client Eliom_content.Html
+open%client Js_of_ocaml_eio
+open%shared Eliom_content.Html.F
(* Bind arrow keys *)
-let%shared bind_keys
- (change : ([`Goto of int | `Next | `Prev] -> unit) Eliom_client_value.t)
- (carousel : [`Div] Eliom_content.Html.elt)
+let%shared
+ bind_keys
+ (change : ([`Goto of int | `Next | `Prev] -> unit) Eliom_client_value.t)
+ (carousel : [`Div] Eliom_content.Html.elt)
=
ignore
[%client
- (let arrow_thread =
- let*
- (* Wait for the carousel to be in the page
+ (Eio_js.start (fun () ->
+ Eio.Switch.run (fun sw ->
+ let
+ (* Wait for the carousel to be in the page
(in the case the page is generated client side): *)
- ()
- =
- Ot_nodeready.nodeready (To_dom.of_element ~%carousel)
- in
- Ot_carousel.bind_arrow_keys ~change:~%change
- Js_of_ocaml.Dom_html.document##.body
- in
- (* Do not forget to cancel the thread when we remove the carousel
+ ()
+ =
+ Ot_nodeready.nodeready (To_dom.of_element ~%carousel)
+ in
+ Ot_carousel.bind_arrow_keys ~change:~%change
+ Js_of_ocaml.Dom_html.document##.body;
+ (* Do not forget to cancel the thread when we remove the carousel
(here, when we go to another page): *)
- Eliom_client.onunload (fun () -> Lwt.cancel arrow_thread)
+ Eliom_client.onunload (fun () -> Eio.Switch.fail sw Exit)))
: unit)]
(* Page for this demo *)
@@ -60,16 +58,15 @@ let%shared page () =
let prev = Ot_carousel.previous ~change ~pos [] in
let next = Ot_carousel.next ~change ~pos ~vis_elts ~length [] in
bind_keys change carousel;
- Lwt.return
- [ h1 [%i18n Demo.carousel_1]
- ; p [%i18n Demo.ot_carousel_first_example_1]
- ; p [%i18n Demo.ot_carousel_first_example_2]
- ; p [%i18n Demo.ot_carousel_first_example_3]
- ; p [%i18n Demo.ot_carousel_first_example_4]
- ; div
- ~a:[a_class ["demo-carousel1"]]
- [div ~a:[a_class ["demo-carousel1-box"]] [carousel; prev; next; bullets]]
- ]
+ [ h1 [%i18n Demo.carousel_1]
+ ; p [%i18n Demo.ot_carousel_first_example_1]
+ ; p [%i18n Demo.ot_carousel_first_example_2]
+ ; p [%i18n Demo.ot_carousel_first_example_3]
+ ; p [%i18n Demo.ot_carousel_first_example_4]
+ ; div
+ ~a:[a_class ["demo-carousel1"]]
+ [div ~a:[a_class ["demo-carousel1-box"]] [carousel; prev; next; bullets]]
+ ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -78,7 +75,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_carousel1
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-carousel1"]]
myid_o p )
diff --git a/template.distillery/demo_carousel2.eliom b/template.distillery/demo_carousel2.eliom
index e50872ed..aa39b443 100644
--- a/template.distillery/demo_carousel2.eliom
+++ b/template.distillery/demo_carousel2.eliom
@@ -1,12 +1,9 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Page with several tabs *)
-open Eliom_content.Html]
-
-[%%shared open Eliom_content.Html.F]
+open%shared Eliom_content.Html
+open%client Js_of_ocaml_eio
+open%shared Eliom_content.Html.F
let%shared lorem_ipsum =
[ p
@@ -69,18 +66,17 @@ let%shared page () =
*)
ignore
[%client
- (Lwt.async (fun () ->
- Lwt.map ignore
+ (Eio_js.start (fun () ->
+ ignore
(Ot_sticky.make_sticky ~ios_html_scroll_hack:true ~dir:`Top ~%tabs))
: unit)];
- Lwt.return
- [ h1 [%i18n Demo.carousel_2]
- ; p [%i18n Demo.ot_carousel_second_example_1]
- ; p [%i18n Demo.ot_carousel_second_example_2]
- ; p [%i18n Demo.ot_carousel_second_example_3]
- ; div
- ~a:[a_class ["demo-carousel2"]]
- [div ~a:[a_class ["demo-carousel2-box"]] [tabs; carousel]] ]
+ [ h1 [%i18n Demo.carousel_2]
+ ; p [%i18n Demo.ot_carousel_second_example_1]
+ ; p [%i18n Demo.ot_carousel_second_example_2]
+ ; p [%i18n Demo.ot_carousel_second_example_3]
+ ; div
+ ~a:[a_class ["demo-carousel2"]]
+ [div ~a:[a_class ["demo-carousel2-box"]] [tabs; carousel]] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -89,7 +85,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_carousel2
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-carousel2"]]
myid_o p )
diff --git a/template.distillery/demo_carousel3.eliom b/template.distillery/demo_carousel3.eliom
index 92221463..1482f8bf 100644
--- a/template.distillery/demo_carousel3.eliom
+++ b/template.distillery/demo_carousel3.eliom
@@ -1,12 +1,8 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Wheel demo *)
-open Eliom_content.Html]
-
-[%%shared open Eliom_content.Html.F]
+open%shared Eliom_content.Html
+open%shared Eliom_content.Html.F
(* Page for this demo *)
let%shared page () =
@@ -63,17 +59,16 @@ let%shared page () =
~update ~vertical:true ~inertia:1. ~position:10 ~transition_duration:3.
~face_size:25 carousel_content
in
- Lwt.return
- [ h1 [%i18n Demo.carousel_wheel]
- ; p [%i18n Demo.carousel_third_example_1]
- ; carousel
- ; div
- [ Ot_carousel.previous ~a:[a_class ["demo-prev"]] ~change ~pos []
- ; Ot_carousel.next
- ~a:[a_class ["demo-next"]]
- ~change ~pos
- ~vis_elts:(Eliom_shared.React.S.const 1)
- ~length [] ] ]
+ [ h1 [%i18n Demo.carousel_wheel]
+ ; p [%i18n Demo.carousel_third_example_1]
+ ; carousel
+ ; div
+ [ Ot_carousel.previous ~a:[a_class ["demo-prev"]] ~change ~pos []
+ ; Ot_carousel.next
+ ~a:[a_class ["demo-next"]]
+ ~change ~pos
+ ~vis_elts:(Eliom_shared.React.S.const 1)
+ ~length [] ] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -82,7 +77,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_carousel3
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-carousel3"]]
myid_o p )
diff --git a/template.distillery/demo_i18n.eliom b/template.distillery/demo_i18n.eliom
index 92a3c0d7..544c506a 100644
--- a/template.distillery/demo_i18n.eliom
+++ b/template.distillery/demo_i18n.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Ocsigen_i18n demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Page for this demo *)
let%shared page () =
@@ -17,20 +14,19 @@ let%shared page () =
assets/%%%PROJECT_NAME%%%_Demo_i18n.tsv
to see how to write the corresponding translations.
*)
- Lwt.return
- [ h1 [%i18n Demo.internationalization ~capitalize:true]
- ; p [%i18n Demo.internationalization_1]
- ; p
- [%i18n
- Demo.internationalization_2
- ~f1:[code [txt "assets/%%%PROJECT_NAME%%%_i18n.tsv"]]
- ~f2:[code [txt "%%%PROJECT_NAME%%%_i18n.eliom"]]]
- ; p [txt [%i18n Demo.S.internationalization_3]]
- ; p
- [%i18n
- Demo.internationalization_4
- ~f:[code [txt "assets/%%%PROJECT_NAME%%%_Demo_i18n.tsv"]]
- ~demo_prefix:[code [txt "demo_"]]] ]
+ [ h1 [%i18n Demo.internationalization ~capitalize:true]
+ ; p [%i18n Demo.internationalization_1]
+ ; p
+ [%i18n
+ Demo.internationalization_2
+ ~f1:[code [txt "assets/%%%PROJECT_NAME%%%_i18n.tsv"]]
+ ~f2:[code [txt "%%%PROJECT_NAME%%%_i18n.eliom"]]]
+ ; p [txt [%i18n Demo.S.internationalization_3]]
+ ; p
+ [%i18n
+ Demo.internationalization_4
+ ~f:[code [txt "assets/%%%PROJECT_NAME%%%_Demo_i18n.tsv"]]
+ ~demo_prefix:[code [txt "demo_"]]] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -39,5 +35,5 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_i18n
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-i18n"]] myid_o p )
diff --git a/template.distillery/demo_links.eliom b/template.distillery/demo_links.eliom
index 91860c4d..92610c80 100644
--- a/template.distillery/demo_links.eliom
+++ b/template.distillery/demo_links.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Static files demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* An example of external service: *)
let%server ocsigen_service =
@@ -16,48 +13,46 @@ let%client ocsigen_service = ~%ocsigen_service
(* Page for this demo *)
let%shared page () =
- Lwt.return
- [ h1 [%i18n Demo.links_and_static_files]
- ; h2 [%i18n Demo.services]
- ; p
- [%i18n
- Demo.services_1
- ~f1:[code [txt "%%%PROJECT_NAME%%%_services.eliom"]]
- ~f2:[code [txt "%%%PROJECT_NAME%%%_handlers.eliom"]]
- ~f3:[code [txt "%%%PROJECT_NAME%%%.eliom"]]]
- ; h2 [%i18n Demo.links_and_forms]
- ; p
- [%i18n
- Demo.links_and_forms_1
- ~t1:
- [a ~service:Os_services.main_service [%i18n Demo.internal_link] ()]
- ~t2:[a ~service:ocsigen_service [%i18n Demo.external_service] ()]]
- ; h2 [%i18n Demo.static_files]
- ; p
- [%i18n
- Demo.static_files_1
- ~static:[code [txt "static"]]
- ~static_dir:[code [txt "static_dir"]]]
- ; img
- ~a:[a_class ["demo-static-img"]]
- ~alt:"local_img"
- ~src:
- (Eliom_content.Html.F.make_uri
- ~absolute:false (* We want local file on mobile app *)
- ~service:(Eliom_service.static_dir ())
- ["images"; "ocsigen.png"])
- ()
- ; p [%i18n Demo.static_files_2]
- ; img
- ~a:[a_class ["demo-static-img"]]
- ~alt:"distant_img"
- ~src:
- (Eliom_content.Html.F.make_uri
- (* We want a distant file:
+ [ h1 [%i18n Demo.links_and_static_files]
+ ; h2 [%i18n Demo.services]
+ ; p
+ [%i18n
+ Demo.services_1
+ ~f1:[code [txt "%%%PROJECT_NAME%%%_services.eliom"]]
+ ~f2:[code [txt "%%%PROJECT_NAME%%%_handlers.eliom"]]
+ ~f3:[code [txt "%%%PROJECT_NAME%%%.eliom"]]]
+ ; h2 [%i18n Demo.links_and_forms]
+ ; p
+ [%i18n
+ Demo.links_and_forms_1
+ ~t1:[a ~service:Os_services.main_service [%i18n Demo.internal_link] ()]
+ ~t2:[a ~service:ocsigen_service [%i18n Demo.external_service] ()]]
+ ; h2 [%i18n Demo.static_files]
+ ; p
+ [%i18n
+ Demo.static_files_1
+ ~static:[code [txt "static"]]
+ ~static_dir:[code [txt "static_dir"]]]
+ ; img
+ ~a:[a_class ["demo-static-img"]]
+ ~alt:"local_img"
+ ~src:
+ (Eliom_content.Html.F.make_uri
+ ~absolute:false (* We want local file on mobile app *)
+ ~service:(Eliom_service.static_dir ())
+ ["images"; "ocsigen.png"])
+ ()
+ ; p [%i18n Demo.static_files_2]
+ ; img
+ ~a:[a_class ["demo-static-img"]]
+ ~alt:"distant_img"
+ ~src:
+ (Eliom_content.Html.F.make_uri
+ (* We want a distant file:
keep the default value of ~absolute *)
- ~service:(Eliom_service.static_dir ())
- ["images"; "ocsigen.png"])
- () ]
+ ~service:(Eliom_service.static_dir ())
+ ["images"; "ocsigen.png"])
+ () ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -66,5 +61,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_links
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-links"]] myid_o p )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-links"]] myid_o p
+ )
diff --git a/template.distillery/demo_notif.eliom b/template.distillery/demo_notif.eliom
index 8f9d6afa..ef816ab8 100644
--- a/template.distillery/demo_notif.eliom
+++ b/template.distillery/demo_notif.eliom
@@ -1,13 +1,10 @@
-open%shared Lwt.Syntax
-
-[%%client
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Notification demo *)
-open Js_of_ocaml_lwt]
-[%%shared open Eliom_content]
-[%%shared open Html.D]
+open%shared Eliom_content
+open%shared Html.D
+open%client Js_of_ocaml_eio
(* Instantiate function Os_notif.Simple for each kind of notification
you need.
@@ -15,7 +12,7 @@ open Js_of_ocaml_lwt]
messaging application, it can be the chatroom ID
(for example type key = int64).
*)
-module Notif = Os_notif.Make_Simple (struct
+module%server Notif = Os_notif.Make_Simple (struct
type key = unit
(* The resources identifiers.
@@ -25,18 +22,17 @@ module Notif = Os_notif.Make_Simple (struct
end)
(* Broadcast message [v] *)
-let%rpc notify (v : string) : unit Lwt.t =
+let%rpc notify (v : string) : unit =
(* Notify all client processes listening on this resource
(identified by its key, given as first parameter)
by sending them message v. *)
- Notif.notify (* ~notfor:`Me *) (() : Notif.key) v;
- (* Use ~notfor:`Me to avoid receiving the message in this tab,
+ Notif.notify (* ~notfor:`Me *) (() : Notif.key) v
+(* Use ~notfor:`Me to avoid receiving the message in this tab,
or ~notfor:(`User myid) to avoid sending to the current user.
(Where myid is Os_current_user.get_current_userid ())
*)
- Lwt.return_unit
-let%rpc listen () : unit Lwt.t = Notif.listen (); Lwt.return_unit
+let%rpc listen () : unit = Notif.listen ()
(* Display a message every time the React event [e = Notif.client_ev ()]
happens. *)
@@ -52,8 +48,7 @@ let%server () =
(* Eliom_lib.alert "%s" msg *)
Os_msg.msg ~level:`Msg (Printf.sprintf "%s" msg))
~%e)
- : unit)];
- Lwt.return_unit)
+ : unit)])
(* Make a text input field that calls [f s] for each [s] submitted *)
let%shared make_form msg f =
@@ -63,41 +58,43 @@ let%shared make_form msg f =
in
ignore
[%client
- (Lwt.async @@ fun () ->
- let btn = Eliom_content.Html.To_dom.of_element ~%btn
- and inp = Eliom_content.Html.To_dom.of_input ~%inp in
- Lwt_js_events.clicks btn @@ fun _ _ ->
- let v = Js_of_ocaml.Js.to_string inp##.value in
- let* () = ~%f v in
- inp##.value := Js_of_ocaml.Js.string "";
- Lwt.return_unit
+ (Eio_js.start (fun () ->
+ let btn = Eliom_content.Html.To_dom.of_element ~%btn
+ and inp = Eliom_content.Html.To_dom.of_input ~%inp in
+ Js_of_ocaml_eio.Eio_js_events.clicks btn (fun _ ->
+ let v = Js_of_ocaml.Js.to_string inp##.value in
+ let () = ~%f v in
+ inp##.value := Js_of_ocaml.Js.string ""))
: unit)];
Eliom_content.Html.D.div [inp; btn]
-let%rpc unlisten () : unit Lwt.t = Notif.unlisten (); Lwt.return_unit
+let%rpc unlisten () : unit = Notif.unlisten ()
(* Page for this demo *)
let%shared page () =
- let* (* Subscribe to notifications when entering this page: *)
- () =
+ let
+ (* Subscribe to notifications when entering this page: *)
+ ()
+ =
listen ()
in
(* Unsubscribe from notifications when user leaves this page *)
let (_ : unit Eliom_client_value.t) =
- [%client Eliom_client.Page_status.ondead (fun () -> Lwt.async unlisten)]
+ [%client
+ Eliom_client.Page_status.ondead (fun () ->
+ Eio_js.start (fun () -> unlisten ()))]
in
- Lwt.return
- Eliom_content.Html.F.
- [ h1 [%i18n Demo.notification]
- ; p
- ([%i18n
- Demo.exchange_msg_between_users ~os_notif:[code [txt "Os_notif"]]]
- @ [ br ()
- ; txt [%i18n Demo.S.open_multiple_tabs_browsers]
- ; br ()
- ; txt [%i18n Demo.S.fill_input_form_send_message] ])
- ; make_form [%i18n Demo.S.send_message]
- [%client (notify : string -> unit Lwt.t)] ]
+ Eliom_content.Html.F.
+ [ h1 [%i18n Demo.notification]
+ ; p
+ ([%i18n
+ Demo.exchange_msg_between_users ~os_notif:[code [txt "Os_notif"]]]
+ @ [ br ()
+ ; txt [%i18n Demo.S.open_multiple_tabs_browsers]
+ ; br ()
+ ; txt [%i18n Demo.S.fill_input_form_send_message] ])
+ ; make_form [%i18n Demo.S.send_message] [%client (notify : string -> unit)]
+ ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -106,5 +103,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_notif
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-notif"]] myid_o p )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-notif"]] myid_o p
+ )
diff --git a/template.distillery/demo_pagetransition.eliom b/template.distillery/demo_pagetransition.eliom
index 6df9c3a0..00bb63c1 100644
--- a/template.distillery/demo_pagetransition.eliom
+++ b/template.distillery/demo_pagetransition.eliom
@@ -1,6 +1,3 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This demo illustrates Eliom's DOM caching feature.
By running [Eliom_client.onload Eliom_client.push_history_dom] one
@@ -9,11 +6,10 @@ open%shared Lwt.Syntax
cache instead of being charged from the server or regenerated by
the client. Also the scroll position is restored that the page had
at the end of the last visit. *)
-open Eliom_content]
-
-[%%shared open Html]
-[%%shared open Html.D]
-[%%client open Js_of_ocaml_lwt]
+open%shared Eliom_content
+open%shared Html
+open%shared Html.D
+open%client Js_of_ocaml_eio
let%shared create_item index =
let open F in
@@ -50,15 +46,13 @@ let%shared page () =
r := !r + 1;
!r
in
- Lwt_js_events.clicks (To_dom.of_element ~%add_button) (fun _ _ ->
- Html.Manip.appendChild ~%l (create_item (counter ()));
- Lwt.return_unit)
- : unit Lwt.t)];
- Lwt.return
- [ h1 [%i18n Demo.pagetransition_list_page]
- ; p [%i18n Demo.pagetransition_intro]
- ; l
- ; add_button ]
+ Js_of_ocaml_eio.Eio_js_events.clicks (To_dom.of_element ~%add_button)
+ (fun _ -> Html.Manip.appendChild ~%l (create_item (counter ())))
+ : unit)];
+ [ h1 [%i18n Demo.pagetransition_list_page]
+ ; p [%i18n Demo.pagetransition_intro]
+ ; l
+ ; add_button ]
let%shared make_detail_page page () =
let back_button =
@@ -66,10 +60,9 @@ let%shared make_detail_page page () =
in
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_js_events.clicks (To_dom.of_element ~%back_button) (fun _ _ ->
- Js_of_ocaml.Dom_html.window##.history##back;
- Lwt.return_unit))
+ (Eio_js.start (fun () ->
+ Js_of_ocaml_eio.Eio_js_events.clicks (To_dom.of_element ~%back_button)
+ (fun _ -> Js_of_ocaml.Dom_html.window##.history##back))
: unit)];
[ h1
([%i18n Demo.pagetransition_detail_page]
@@ -83,7 +76,7 @@ let%shared make_detail_page page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_pagetransition
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-pagetransition"]]
myid_o p )
diff --git a/template.distillery/demo_pgocaml.eliom b/template.distillery/demo_pgocaml.eliom
index cad1effa..ba2fd99a 100644
--- a/template.distillery/demo_pgocaml.eliom
+++ b/template.distillery/demo_pgocaml.eliom
@@ -1,41 +1,37 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* PGOcaml demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Fetch users in database *)
-let%rpc get_users () : string list Lwt.t =
- let*
+let%rpc get_users () : string list =
+ let
(* For this demo, we add a delay to simulate a network or db latency: *)
- ()
+ ()
=
- Lwt_unix.sleep 2.
+ Eio_unix.sleep 2.
in
Demo_pgocaml_db.get ()
(* Generate page for this demo *)
let%shared page () =
- let* user_block =
- Ot_spinner.with_spinner
- (let* users = get_users () in
- let users =
- List.map
- (fun u -> if u = "" then li [em [txt "new user"]] else li [txt u])
- users
- in
- if users = []
- then Lwt.return [p [em [%i18n Demo.no_user_create_accounts]]]
- else Lwt.return [p [%i18n Demo.pgocaml_users]; ul users])
+ let user_block =
+ Ot_spinner.with_spinner (fun () ->
+ let users = get_users () in
+ let users =
+ List.map
+ (fun u -> if u = "" then li [em [txt "new user"]] else li [txt u])
+ users
+ in
+ if users = []
+ then [p [em [%i18n Demo.no_user_create_accounts]]]
+ else [p [%i18n Demo.pgocaml_users]; ul users])
in
- Lwt.return
- [ h1 [%i18n Demo.pgocaml]
- ; p [%i18n Demo.pgocaml_description_1]
- ; p [%i18n Demo.pgocaml_description_2]
- ; p [%i18n Demo.pgocaml_description_3]
- ; user_block ]
+ [ h1 [%i18n Demo.pgocaml]
+ ; p [%i18n Demo.pgocaml_description_1]
+ ; p [%i18n Demo.pgocaml_description_2]
+ ; p [%i18n Demo.pgocaml_description_3]
+ ; user_block ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -44,6 +40,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_pgocaml
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-pgocaml"]] myid_o p
)
diff --git a/template.distillery/demo_pgocaml_db.ml b/template.distillery/demo_pgocaml_db.ml
index 4d0b396a..33ff265c 100644
--- a/template.distillery/demo_pgocaml_db.ml
+++ b/template.distillery/demo_pgocaml_db.ml
@@ -10,4 +10,4 @@ open Os_db
let get () =
full_transaction_block (fun dbh ->
- [%pgsql dbh "SELECT lastname FROM ocsigen_start.users"])
+ [%pgsql dbh "SELECT lastname FROM ocsigen_start.users"])
diff --git a/template.distillery/demo_popup.eliom b/template.distillery/demo_popup.eliom
index 9d80915b..1076ce0c 100644
--- a/template.distillery/demo_popup.eliom
+++ b/template.distillery/demo_popup.eliom
@@ -1,5 +1,3 @@
-open%shared Lwt.Syntax
-
[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
@@ -7,7 +5,7 @@ open%shared Lwt.Syntax
open Eliom_content.Html]
[%%shared open Eliom_content.Html.F]
-[%%client open Js_of_ocaml_lwt]
+[%%client open Js_of_ocaml_eio]
(* Name for demo menu. This value is defined both server and client-side. *)
let%shared name () = [%i18n Demo.S.popup]
@@ -28,11 +26,8 @@ let%shared page () =
in
(* Every time this page is generated,
we want to execute the following piece of client-side code.
- Lwt_js_events.clicks means "For each click on ... do ...".
- It creates an Lwt thread that never returns.
- We run it asynchronously using Lwt.async.
- Lwt_js_events.clicks is expecting a DOM node
- (i.e. an actual part of the current page).
+ Eio_js_events.clicks means "For each click on ... do ...".
+ It runs a callback for each click event.
To_dom.of_element will return the DOM node corresponding to the
OCaml value ~%button.
~%button refers to the value button, defined outside [%client ] section
@@ -41,23 +36,18 @@ let%shared page () =
ignore
[%client
(* This client section will be executed after the page is
- displayed by the browser. *)
- (Lwt.async (fun () ->
- (* Lwt_js_events.clicks returns a Lwt thread, which never terminates.
- We run it asynchronously. *)
- Lwt_js_events.clicks (To_dom.of_element ~%button) (fun _ _ ->
- let* _ =
- Ot_popup.popup
- ~close_button:[Os_icons.F.close ()]
- (fun _ -> Lwt.return @@ p [%i18n Demo.popup_message])
- in
- Lwt.return_unit))
+ displayed by the browser. *)
+ (Eio_js.start (fun () ->
+ Eio_js_events.clicks (To_dom.of_element ~%button) (fun _ ->
+ ignore (Ot_popup.popup
+ ~close_button:[Os_icons.F.close ()]
+ (fun _ -> p [%i18n Demo.popup_message]))))
: unit)];
(* Page elements, using module Eliom_content.Html.F
(as we don't want to add a unique identifier).
See internationalization demo for i18n syntax.
*)
- Lwt.return [h1 [%i18n Demo.popup]; p [%i18n Demo.popup_content]; p [button]]
+ [h1 [%i18n Demo.popup]; p [%i18n Demo.popup_content]; p [button]]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -66,5 +56,5 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_popup
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-popup"]] myid_o p )
diff --git a/template.distillery/demo_pulltorefresh.eliom b/template.distillery/demo_pulltorefresh.eliom
index f4dfb218..a021111b 100644
--- a/template.distillery/demo_pulltorefresh.eliom
+++ b/template.distillery/demo_pulltorefresh.eliom
@@ -1,22 +1,20 @@
-open%shared Lwt.Syntax
-
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(** Demo for refreshable content *)
-[%%shared open Eliom_content.Html]
-[%%shared open Eliom_content.Html.D]
+open%shared Eliom_content.Html
+open%shared Eliom_content.Html.D
let%shared page () =
let counter_sig, set_counter = Eliom_shared.React.S.create 0 in
let reload =
[%client
fun () ->
- let* _ = Js_of_ocaml_lwt.Lwt_js.sleep 1. in
+ let _ = Js_of_ocaml_eio.Eio_js.sleep 1. in
let n = Eliom_shared.React.S.value ~%counter_sig in
~%set_counter (n + 1);
- Lwt.return_true]
+ true]
in
let counter_node_sig =
Eliom_shared.React.S.map
@@ -34,7 +32,7 @@ let%shared page () =
; F.p [%i18n Demo.pull_to_refresh_2]
; R.node counter_node_sig ]
in
- Lwt.return @@ [Ot_pulltorefresh.make ~dragThreshold:15. ~content reload]
+ [Ot_pulltorefresh.make ~dragThreshold:15. ~content reload]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -43,7 +41,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_pulltorefresh
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-pulltorefresh"]]
myid_o p )
diff --git a/template.distillery/demo_react.eliom b/template.distillery/demo_react.eliom
index 6980fb23..0e3a400b 100644
--- a/template.distillery/demo_react.eliom
+++ b/template.distillery/demo_react.eliom
@@ -1,13 +1,11 @@
-open%shared Lwt.Syntax
-
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(** Demo for shared reactive content *)
-[%%client open Js_of_ocaml_lwt]
-[%%shared open Eliom_content]
-[%%shared open Html.D]
+open%shared Eliom_content
+open%shared Html.D
+open%client Js_of_ocaml_eio
(* Make a text input field that calls [f s] for each [s] submitted *)
let%shared make_form msg f =
@@ -17,14 +15,13 @@ let%shared make_form msg f =
in
ignore
[%client
- (Lwt.async @@ fun () ->
- let btn = Eliom_content.Html.To_dom.of_element ~%btn
- and inp = Eliom_content.Html.To_dom.of_input ~%inp in
- Lwt_js_events.clicks btn @@ fun _ _ ->
- let v = Js_of_ocaml.Js.to_string inp##.value in
- let* () = ~%f v in
- inp##.value := Js_of_ocaml.Js.string "";
- Lwt.return_unit
+ (Eio_js.start (fun () ->
+ let btn = Eliom_content.Html.To_dom.of_element ~%btn
+ and inp = Eliom_content.Html.To_dom.of_input ~%inp in
+ Js_of_ocaml_eio.Eio_js_events.clicks btn (fun _ ->
+ let v = Js_of_ocaml.Js.to_string inp##.value in
+ let () = ~%f v in
+ inp##.value := Js_of_ocaml.Js.string ""))
: unit)];
Eliom_content.Html.D.div [inp; btn]
@@ -41,8 +38,7 @@ let%shared page () =
(* Form that performs a cons (client-side). *)
make_form [%i18n Demo.S.reactive_programming_button]
[%client
- (fun v -> Lwt.return (Eliom_shared.ReactiveData.RList.cons v ~%h)
- : string -> unit Lwt.t)]
+ (fun v -> Eliom_shared.ReactiveData.RList.cons v ~%h : string -> unit)]
and l =
(* Produce items from l contents.
The shared function will first be called once server or client-side
@@ -53,14 +49,13 @@ let%shared page () =
[%shared (fun s -> Eliom_content.Html.(D.li [D.txt s]) : _ -> _)]
l
in
- Lwt.return
- Eliom_content.Html.
- [ F.h1 [%i18n Demo.reactive_programming]
- ; F.p [F.txt [%i18n Demo.S.reactive_programming_1]]
- ; F.p [F.txt [%i18n Demo.S.reactive_programming_2]]
- ; F.p [F.txt [%i18n Demo.S.reactive_programming_3]]
- ; inp
- ; F.div [R.ul l] ]
+ Eliom_content.Html.
+ [ F.h1 [%i18n Demo.reactive_programming]
+ ; F.p [F.txt [%i18n Demo.S.reactive_programming_1]]
+ ; F.p [F.txt [%i18n Demo.S.reactive_programming_2]]
+ ; F.p [F.txt [%i18n Demo.S.reactive_programming_3]]
+ ; inp
+ ; F.div [R.ul l] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -69,5 +64,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_react
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-react"]] myid_o p )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-react"]] myid_o p
+ )
diff --git a/template.distillery/demo_ref.eliom b/template.distillery/demo_ref.eliom
index d93ee200..4444075e 100644
--- a/template.distillery/demo_ref.eliom
+++ b/template.distillery/demo_ref.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Demo for Eliom references and Os_date *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* An Eliom reference storing the last time the user visited the current
page. It has scope Eliom_common.default_group_scope, which means that
@@ -17,30 +14,28 @@ let%server last_visit =
~scope:Eliom_common.default_group_scope None
(* Read & reset last_visit *)
-let%rpc get_reset_last_visit () : Os_date.local_calendar option Lwt.t =
- let* v = Eliom_reference.get last_visit in
- let* () = Eliom_reference.set last_visit (Some (Os_date.now ())) in
- Lwt.return v
+let%rpc get_reset_last_visit () : Os_date.local_calendar option =
+ let v = Eliom_reference.get last_visit in
+ let () = Eliom_reference.set last_visit (Some (Os_date.now ())) in
+ v
(* Call get_reset_last_visit and produce pretty message *)
let%shared get_reset_last_visit_message () =
- let* last_visit = get_reset_last_visit () in
+ let last_visit = get_reset_last_visit () in
match last_visit with
- | None -> Lwt.return [%i18n Demo.eliom_ref_first_visit]
+ | None -> [%i18n Demo.eliom_ref_first_visit]
| Some last_visit ->
- Lwt.return
- ([%i18n Demo.eliom_ref_last_visit]
- @ [txt " "; txt (Os_date.smart_time last_visit)])
+ [%i18n Demo.eliom_ref_last_visit]
+ @ [txt " "; txt (Os_date.smart_time last_visit)]
(* Generate page for this demo *)
let%shared page () =
- let* last_visit_message = get_reset_last_visit_message () in
- Lwt.return
- [ h1 [%i18n Demo.eliom_ref]
- ; p [txt [%i18n Demo.S.eliom_ref_1]]
- ; p [txt [%i18n Demo.S.eliom_ref_2]]
- ; p last_visit_message
- ; p [txt [%i18n Demo.S.eliom_ref_3]] ]
+ let last_visit_message = get_reset_last_visit_message () in
+ [ h1 [%i18n Demo.eliom_ref]
+ ; p [txt [%i18n Demo.S.eliom_ref_1]]
+ ; p [txt [%i18n Demo.S.eliom_ref_2]]
+ ; p last_visit_message
+ ; p [txt [%i18n Demo.S.eliom_ref_3]] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -49,5 +44,5 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_ref
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-ref"]] myid_o p )
diff --git a/template.distillery/demo_rpc.eliom b/template.distillery/demo_rpc.eliom
index d5a03f05..999bf2df 100644
--- a/template.distillery/demo_rpc.eliom
+++ b/template.distillery/demo_rpc.eliom
@@ -1,13 +1,10 @@
-open%shared Lwt.Syntax
-
-[%%client
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* RPC button demo *)
-open Js_of_ocaml_lwt]
-[%%shared open Eliom_content]
-[%%shared open Html.D]
+open%shared Eliom_content
+open%shared Html.D
+open%client Js_of_ocaml_eio
(* A server-side reference that stores data for the current browser
(scope = session).
@@ -18,11 +15,11 @@ let%server my_ref =
Eliom_reference.eref ~scope:Eliom_common.default_session_scope 0
(* Server-side function that increments my_ref and returns new val *)
-let%rpc incr_my_ref () : int Lwt.t =
- let* v = Eliom_reference.get my_ref in
+let%rpc incr_my_ref () : int =
+ let v = Eliom_reference.get my_ref in
let v = v + 1 in
- let* () = Eliom_reference.set my_ref v in
- Lwt.return v
+ let () = Eliom_reference.set my_ref v in
+ v
let%shared button msg f =
let btn =
@@ -30,9 +27,9 @@ let%shared button msg f =
in
ignore
[%client
- (Lwt.async @@ fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%btn)
- (fun _ _ -> ~%f ())
+ (Eio_js.start (fun () ->
+ Js_of_ocaml_eio.Eio_js_events.clicks
+ (Eliom_content.Html.To_dom.of_element ~%btn) (fun _ -> ~%f ()))
: unit)];
btn
@@ -42,16 +39,14 @@ let%shared page () =
button [%i18n Demo.S.rpc_button_click_increase]
[%client
(fun () ->
- let* v = incr_my_ref () in
- Eliom_lib.alert "Update: %d" v;
- Lwt.return_unit
- : unit -> unit Lwt.t)]
+ let v = incr_my_ref () in
+ Eliom_lib.alert "Update: %d" v
+ : unit -> unit)]
in
- Lwt.return
- Eliom_content.Html.
- [ F.h1 [%i18n Demo.rpc_button]
- ; F.p [F.txt [%i18n Demo.S.rpc_button_description]]
- ; F.p [btn] ]
+ Eliom_content.Html.
+ [ F.h1 [%i18n Demo.rpc_button]
+ ; F.p [F.txt [%i18n Demo.S.rpc_button_description]]
+ ; F.p [btn] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -60,5 +55,5 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_rpc
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-rpc"]] myid_o p )
diff --git a/template.distillery/demo_services.eliom b/template.distillery/demo_services.eliom
index 9f1826aa..67127386 100644
--- a/template.distillery/demo_services.eliom
+++ b/template.distillery/demo_services.eliom
@@ -16,12 +16,6 @@ let%server demo =
let%client demo = ~%demo
-let%server demo_popup =
- Eliom_service.create ~path:(Eliom_service.Path ["demo-popup"])
- ~meth:(Eliom_service.Get Eliom_parameter.unit) ()
-
-let%client demo_popup = ~%demo_popup
-
let%server demo_rpc =
Eliom_service.create ~path:(Eliom_service.Path ["demo-rpc"])
~meth:(Eliom_service.Get Eliom_parameter.unit) ()
@@ -64,6 +58,12 @@ let%server demo_i18n =
let%client demo_i18n = ~%demo_i18n
+let%server demo_popup =
+ Eliom_service.create ~path:(Eliom_service.Path ["demo-popup"])
+ ~meth:(Eliom_service.Get Eliom_parameter.unit) ()
+
+let%client demo_popup = ~%demo_popup
+
let%server demo_tips =
Eliom_service.create ~path:(Eliom_service.Path ["demo-tips"])
~meth:(Eliom_service.Get Eliom_parameter.unit) ()
diff --git a/template.distillery/demo_spinner.eliom b/template.distillery/demo_spinner.eliom
index 804b9297..9bb56c42 100644
--- a/template.distillery/demo_spinner.eliom
+++ b/template.distillery/demo_spinner.eliom
@@ -1,38 +1,33 @@
-open%shared Lwt.Syntax
-
-[%%client
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Spinner demo *)
-open Js_of_ocaml_lwt]
-[%%shared open Eliom_content]
-[%%shared open Html.D]
+open%shared Eliom_content
+open%shared Html.D
(* Build the spinner *)
let%client make_spinner () =
- (* [Ot_spinner.with_spinner_no_lwt] accepts an Lwt thread "slowly"
+ (* [Ot_spinner.with_spinner] accepts a thunk "slowly"
producing HTML content *)
- Ot_spinner.with_spinner_no_lwt
+ Ot_spinner.with_spinner
(* sleep for 5 seconds to simulate a delay, then return content *)
- (let* () = Lwt_js.sleep 5. in
- Lwt.return
+ (fun () ->
+ let () = Js_of_ocaml_eio.Eio_js.sleep 5. in
Eliom_content.Html.D.
[ txt [%i18n Demo.S.spinner_content_ready]
; txt " "
; txt [%i18n Demo.S.spinner_message_replace_spinner] ])
(* Page for this demo *)
-let%shared page () : Html_types.div_content Eliom_content.Html.elt list Lwt.t =
- Lwt.return
- Eliom_content.Html.
- [ F.h1 [%i18n Demo.spinner]
- ; F.p [F.txt [%i18n Demo.S.spinner_description_ot]]
- ; F.p [F.txt [%i18n Demo.S.spinner_description_1]]
- ; F.p [F.txt [%i18n Demo.S.spinner_description_2]]
- ; F.p [F.txt [%i18n Demo.S.spinner_description_3]]
- ; F.p [F.txt [%i18n Demo.S.spinner_generated_client_side]]
- ; C.node [%client (make_spinner () : [> `Div] Eliom_content.Html.elt)] ]
+let%shared page () : Html_types.div_content Eliom_content.Html.elt list =
+ Eliom_content.Html.
+ [ F.h1 [%i18n Demo.spinner]
+ ; F.p [F.txt [%i18n Demo.S.spinner_description_ot]]
+ ; F.p [F.txt [%i18n Demo.S.spinner_description_1]]
+ ; F.p [F.txt [%i18n Demo.S.spinner_description_2]]
+ ; F.p [F.txt [%i18n Demo.S.spinner_description_3]]
+ ; F.p [F.txt [%i18n Demo.S.spinner_generated_client_side]]
+ ; C.node [%client (make_spinner () : [> `Div] Eliom_content.Html.elt)] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -41,6 +36,6 @@ let%shared page () : Html_types.div_content Eliom_content.Html.elt list Lwt.t =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_spinner
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-spinner"]] myid_o p
)
diff --git a/template.distillery/demo_timepicker.eliom b/template.distillery/demo_timepicker.eliom
index 8428406c..a5d74d4d 100644
--- a/template.distillery/demo_timepicker.eliom
+++ b/template.distillery/demo_timepicker.eliom
@@ -1,19 +1,12 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
-open Eliom_content.Html.D]
-
-[%%client open Js_of_ocaml_lwt]
+open%shared Eliom_content.Html.D
+open%client Js_of_ocaml_eio
(* Timepicker demo *)
let%server s, f = Eliom_shared.React.S.create None
-
-let%client action (h, m) =
- ~%f (Some (h, m));
- Lwt.return_unit
+let%client action (h, m) = ~%f (Some (h, m))
let%shared string_of_time = function
| Some (h, m) ->
@@ -23,8 +16,7 @@ let%shared string_of_time = function
let%server time_as_string () : string Eliom_shared.React.S.t =
Eliom_shared.React.S.map [%shared string_of_time] s
-let%rpc time_reactive () : string Eliom_shared.React.S.t Lwt.t =
- Lwt.return @@ time_as_string ()
+let%rpc time_reactive () : string Eliom_shared.React.S.t = time_as_string ()
(* Page for this demo *)
let%shared page () =
@@ -36,17 +28,17 @@ let%shared page () =
in
ignore
[%client
- (Lwt.async (fun () ->
- Lwt_js_events.clicks (Eliom_content.Html.To_dom.of_element ~%button)
- (fun _ _ -> ~%back_f (); Lwt.return_unit))
+ (Eio_js.start (fun () ->
+ Js_of_ocaml_eio.Eio_js_events.clicks
+ (Eliom_content.Html.To_dom.of_element ~%button) (fun _ ->
+ ~%back_f ()))
: _)];
- let* tr = time_reactive () in
- Lwt.return
- [ h1 [%i18n Demo.timepicker]
- ; p [%i18n Demo.timepicker_description]
- ; div [time_picker]
- ; p [Eliom_content.Html.R.txt tr]
- ; div [button] ]
+ let tr = time_reactive () in
+ [ h1 [%i18n Demo.timepicker]
+ ; p [%i18n Demo.timepicker_description]
+ ; div [time_picker]
+ ; p [Eliom_content.Html.R.txt tr]
+ ; div [button] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -55,7 +47,7 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_timepicker
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page
~a:[a_class ["os-page-demo-timepicker"]]
myid_o p )
diff --git a/template.distillery/demo_tips.eliom b/template.distillery/demo_tips.eliom
index 9c3866e4..4817e089 100644
--- a/template.distillery/demo_tips.eliom
+++ b/template.distillery/demo_tips.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Os_tips demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Here is an example of tip. Call this function while generating the
widget concerned by the explanation it contains. *)
@@ -16,27 +13,26 @@ let%shared example_tip () =
~content:
[%client
fun _ ->
- Lwt.return
- Eliom_content.Html.F.
- [p [%i18n Demo.example_tip]; p [%i18n Demo.look_module_tip]]]
+ Eliom_content.Html.F.
+ [p [%i18n Demo.example_tip]; p [%i18n Demo.look_module_tip]]]
(* Page for this demo *)
let%shared page () =
- let* (* Call the function defining the tip from the server or the client: *)
- ()
+ let
+ (* Call the function defining the tip from the server or the client: *)
+ ()
=
example_tip ()
in
- Lwt.return
- [ h1 [%i18n Demo.tips1]
- ; p [%i18n Demo.tips2 ~os_tips:[code [txt "Os_tips"]]]
- ; p [%i18n Demo.tips3]
- ; p
- [%i18n
- Demo.tips4
- ~set_page:
- [ a ~service:%%%MODULE_NAME%%%_services.settings_service
- [%i18n Demo.tips5] () ]] ]
+ [ h1 [%i18n Demo.tips1]
+ ; p [%i18n Demo.tips2 ~os_tips:[code [txt "Os_tips"]]]
+ ; p [%i18n Demo.tips3]
+ ; p
+ [%i18n
+ Demo.tips4
+ ~set_page:
+ [ a ~service:%%%MODULE_NAME%%%_services.settings_service
+ [%i18n Demo.tips5] () ]] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -45,5 +41,5 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_tips
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-tips"]] myid_o p )
diff --git a/template.distillery/demo_tongue.eliom b/template.distillery/demo_tongue.eliom
index ebae0af2..eeddb5e9 100644
--- a/template.distillery/demo_tongue.eliom
+++ b/template.distillery/demo_tongue.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Tongue demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
(* Page for this demo *)
let%shared page () =
@@ -21,10 +18,9 @@ let%shared page () =
~stops:[`Px 70; `Interval (`Percent 100, `Full_content)]
~init:(`Px 70) content
in
- Lwt.return
- [ h1 [%i18n Demo.tongue_1]
- ; p [%i18n Demo.ot_tongue_1]
- ; div ~a:[a_class ["demo-tongue"]] [tongue.Ot_tongue.elt] ]
+ [ h1 [%i18n Demo.tongue_1]
+ ; p [%i18n Demo.ot_tongue_1]
+ ; div ~a:[a_class ["demo-tongue"]] [tongue.Ot_tongue.elt] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -33,6 +29,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_tongue
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
+ let p = page () in
%%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-tongue"]] myid_o p
)
diff --git a/template.distillery/demo_tools.eliom b/template.distillery/demo_tools.eliom
index db81dc32..7cff5b3e 100644
--- a/template.distillery/demo_tools.eliom
+++ b/template.distillery/demo_tools.eliom
@@ -4,15 +4,16 @@
[%%shared.start]
let demos =
- [ (fun () -> [%i18n Demo.S.rpc_button]), Demo_services.demo_rpc
+ [ (fun () -> [%i18n Demo.S.tips]), Demo_services.demo_tips
+ ; (fun () -> [%i18n Demo.S.rpc_button]), Demo_services.demo_rpc
; (fun () -> [%i18n Demo.S.eliom_ref]), Demo_services.demo_ref
; (fun () -> [%i18n Demo.S.spinner]), Demo_services.demo_spinner
+ ; (fun () -> [%i18n Demo.S.popup]), Demo_services.demo_popup
; (fun () -> [%i18n Demo.S.pgocaml]), Demo_services.demo_pgocaml
; (fun () -> [%i18n Demo.S.users]), Demo_services.demo_users
; (fun () -> [%i18n Demo.S.links_and_static_files]), Demo_services.demo_links
; ( (fun () -> [%i18n Demo.S.internationalization ~capitalize:true])
, Demo_services.demo_i18n )
- ; (fun () -> [%i18n Demo.S.tips]), Demo_services.demo_tips
; (fun () -> [%i18n Demo.S.carousel_1]), Demo_services.demo_carousel1
; (fun () -> [%i18n Demo.S.carousel_2]), Demo_services.demo_carousel2
; (fun () -> [%i18n Demo.S.carousel_wheel]), Demo_services.demo_carousel3
diff --git a/template.distillery/demo_users.eliom b/template.distillery/demo_users.eliom
index 7ed0d23f..78f62a0a 100644
--- a/template.distillery/demo_users.eliom
+++ b/template.distillery/demo_users.eliom
@@ -1,10 +1,7 @@
-open%shared Lwt.Syntax
-
-[%%shared
(* This file was generated by Ocsigen Start.
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Os_current_user demo *)
-open Eliom_content.Html.F]
+open%shared Eliom_content.Html.F
let%shared display_user_name = function
| None -> p [%i18n Demo.you_are_not_connected]
@@ -30,19 +27,18 @@ let%shared page () =
*)
let myid_o = Os_current_user.Opt.get_current_userid () in
let me_o = Os_current_user.Opt.get_current_user () in
- Lwt.return
- [ h1 [%i18n Demo.users]
- ; p
- [ txt [%i18n Demo.S.the_module]
- ; code [txt " Os_current_user "]
- ; txt [%i18n Demo.S.allows_get_information_currently_connected_user] ]
- ; display_user_name me_o
- ; display_user_id myid_o
- ; p [txt [%i18n Demo.S.these_functions_called_server_or_client_side]]
- ; p
- [ txt [%i18n Demo.S.always_get_current_user_using_module]
- ; code [txt " Os_current_user. "]
- ; txt [%i18n Demo.S.never_trust_client_pending_user_id] ] ]
+ [ h1 [%i18n Demo.users]
+ ; p
+ [ txt [%i18n Demo.S.the_module]
+ ; code [txt " Os_current_user "]
+ ; txt [%i18n Demo.S.allows_get_information_currently_connected_user] ]
+ ; display_user_name me_o
+ ; display_user_id myid_o
+ ; p [txt [%i18n Demo.S.these_functions_called_server_or_client_side]]
+ ; p
+ [ txt [%i18n Demo.S.always_get_current_user_using_module]
+ ; code [txt " Os_current_user. "]
+ ; txt [%i18n Demo.S.never_trust_client_pending_user_id] ] ]
(* Service registration is done on both sides (shared section),
so that pages can be generated from the server
@@ -51,5 +47,6 @@ let%shared page () =
let%shared () =
%%%MODULE_NAME%%%_base.App.register ~service:Demo_services.demo_users
( %%%MODULE_NAME%%%_page.Opt.connected_page @@ fun myid_o () () ->
- let* p = page () in
- %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-users"]] myid_o p )
+ let p = page () in
+ %%%MODULE_NAME%%%_container.page ~a:[a_class ["os-page-demo-users"]] myid_o p
+ )
diff --git a/template.distillery/dune b/template.distillery/dune
index 79103112..ac16b7c8 100644
--- a/template.distillery/dune
+++ b/template.distillery/dune
@@ -6,13 +6,17 @@
(name %%%PROJECT_NAME%%%)
(modules
(:standard \ %%%MODULE_NAME%%%_main))
- (libraries eliom.server ocsigen-start.server ocsipersist-pgsql ocsipersist-pgsql.settings)
+ (libraries
+ eliom.server
+ ocsigen-start.server
+ ocsipersist-sqlite
+ ocsipersist-sqlite.settings)
(library_flags
(:standard -linkall))
(wrapped false)
(preprocess
(pps
- pgocaml_ppx
+ pgocaml_ppx
js_of_ocaml-ppx_deriving_json
ocsigen-i18n
ocsigen-ppx-rpc
@@ -34,13 +38,13 @@
(libraries
eliom.server
ocsigen-start.server
- ocsipersist-pgsql
+ ocsipersist-sqlite
ocsigenserver.ext.staticmod
%%%PROJECT_NAME%%%)
(modules %%%MODULE_NAME%%%_main)
(preprocess
(pps
- pgocaml_ppx
+ pgocaml_ppx
js_of_ocaml-ppx_deriving_json
ocsigen-i18n
ocsigen-ppx-rpc
@@ -130,7 +134,7 @@
(preprocess
(pps
js_of_ocaml-ppx
- ocsigen-i18n
+ ocsigen-i18n
--
--prefix
%%%MODULE_NAME%%%_
@@ -139,13 +143,15 @@
--default-module
%%%MODULE_NAME%%%_i18n))
(js_of_ocaml
- (build_runtime_flags :standard --enable use-js-string)
+ (build_runtime_flags :standard --enable use-js-string --enable effects)
(flags
:standard
--enable
with-js-error
--enable
use-js-string
+ --enable
+ effects
--no-source-map))
; source maps are slow...
(libraries eliom.client ocsigen-start.client))
diff --git a/template.distillery/mobile!eliom_loader.ml b/template.distillery/mobile!eliom_loader.ml
index 4870322e..767d61a1 100644
--- a/template.distillery/mobile!eliom_loader.ml
+++ b/template.distillery/mobile!eliom_loader.ml
@@ -2,18 +2,18 @@
Feel free to use it, modify it, and redistribute it as you wish. *)
(* Load Eliom client-side program after storing global data in
- localStorage. Compile as follos:
+ localStorage. Compile as follows:
ocamlfind ocamlc \
- -package js_of_ocaml,js_of_ocaml.ppx \
+ -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-eio \
-linkpkg -o eliom_loader.byte \
eliom_loader.ml
- js_of_ocaml eliom_loader.byte
+ js_of_ocaml --effects=cps eliom_loader.byte
*)
-open Lwt.Syntax
-module XmlHttpRequest = Js_of_ocaml_lwt.XmlHttpRequest
+module XmlHttpRequest = Js_of_ocaml_eio.XmlHttpRequest
+module Eio_js_events = Js_of_ocaml_eio.Eio_js_events
(* Debug mode. Set to true if you want to use the debug mode. Used by "log".
*)
@@ -24,14 +24,14 @@ let debug = false
*)
let log =
if debug then (fun s ->
- Js_of_ocaml.Firebug.console##log (Js_of_ocaml.Js.string s);
+ Js_of_ocaml.Console.console##log (Js_of_ocaml.Js.string s);
let p = Js_of_ocaml.Dom_html.createP Js_of_ocaml.Dom_html.document in
p##.style##.color := Js_of_ocaml.Js.string "#64b5f6";
Js_of_ocaml.Dom.appendChild p
(Js_of_ocaml.Dom_html.document##createTextNode (Js_of_ocaml.Js.string s));
let container = Js_of_ocaml.Dom_html.getElementById "app-container" in
Js_of_ocaml.Dom.appendChild container p)
- else fun s -> ()
+ else fun _ -> ()
(* Reference used by the binding to fetchUpdate to know if update has been done
* or if it failed.
@@ -80,28 +80,27 @@ let rec add_retry_button wake msg =
ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate);
if !data_upload_failed then (
data_upload_failed := false;
- Lwt.async (fun () -> get_data wake));
+ Eio_js_events.async (fun () -> get_data wake));
Js_of_ocaml.Js._false);
btn##.id := Js_of_ocaml.Js.string "retry-button";
Js_of_ocaml.Dom.appendChild p btn;
Js_of_ocaml.Dom.appendChild container p
and get_data wake =
- let* { XmlHttpRequest.content; code } = XmlHttpRequest.get url in
+ let { XmlHttpRequest.content; code; _ } = XmlHttpRequest.get url in
if code = 200 then (
log "Got global data";
(storage ())##setItem
(Js_of_ocaml.Js.string "__global_data")
(Js_of_ocaml.Js.string content);
- Lwt.wakeup wake ())
+ Eio.Promise.resolve wake ())
else (
log "Could not get global data";
if not (!update_failed || !data_upload_failed) then (
data_upload_failed := true;
add_retry_button wake
"Cannot connect to the server. Please make sure that this app has \
- access to a data connection."));
- Lwt.return_unit
+ access to a data connection."))
(* Get the URL saved in the JavaScript variables "___eliom_html_url_" defined in
* index.html and go this location.
@@ -120,9 +119,9 @@ let _ =
ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate;
Js_of_ocaml.Js._true))
Js_of_ocaml.Js._false;
- (* Create two threads for success callbacks and error callbacks. *)
- let wait_success, wake_success = Lwt.wait () in
- let wait_error, wake_error = Lwt.wait () in
+ (* Create two promises for success callbacks and error callbacks. *)
+ let wait_success, wake_success = Eio.Promise.create () in
+ let wait_error, wake_error = Eio.Promise.create () in
(* Callback when success.
* [callback ev] will print the event if debug mode is activated.
* Calls by the event chcp_nothingToUpdate.
@@ -131,7 +130,7 @@ let _ =
Js_of_ocaml.Dom.handler (fun _ ->
log ev;
update_failed := false;
- Lwt.wakeup wake_success ();
+ Eio.Promise.resolve wake_success ();
Js_of_ocaml.Js._true)
in
(* Callback when errors.
@@ -151,7 +150,7 @@ let _ =
in
(* Callback to print a message *)
let status_callback name =
- Js_of_ocaml.Dom.handler (fun ev ->
+ Js_of_ocaml.Dom.handler (fun _ ->
log name;
Js_of_ocaml.Js.bool true)
in
@@ -194,9 +193,9 @@ let _ =
"chcp_beforeAssetsInstalledOnExternalStorage";
"chcp_assetsInstalledOnExternalStorage";
];
- Lwt.async @@ fun () ->
- let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in
- let* _ = get_data wake_error in
- let* _ = wait_error in
- let* _ = wait_success in
- Lwt.return (redirect ())
+ Js_of_ocaml_eio.Eio_js.start @@ fun () ->
+ let _ = Eio_js_events.onload () in
+ get_data wake_error;
+ let _ = Eio.Promise.await wait_error in
+ let _ = Eio.Promise.await wait_success in
+ redirect ()
diff --git a/template.distillery/tools!dune b/template.distillery/tools!dune
index dce4adbe..b666c362 100644
--- a/template.distillery/tools!dune
+++ b/template.distillery/tools!dune
@@ -2,7 +2,7 @@
(name eliom_ppx_client)
(modes native)
(modules eliom_ppx_client)
- (libraries ocsigen-ppx-rpc eliom.ppx.client))
+ (libraries ocsigen-ppx-rpc eliom.ppx.client))
(rule
(action (with-stdout-to eliom_ppx_client.ml