diff --git a/.ocamlformat b/.ocamlformat
index a84459a472..7f5bf133b6 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,34 +1,17 @@
-version=0.28.1
+version=0.29.0
parse-docstrings = false
wrap-comments = false
-break-cases = fit
-break-collection-expressions = fit-or-vertical
-break-fun-decl = wrap
-break-fun-sig = wrap
-break-infix = wrap
-break-infix-before-func = false
break-sequences = false
break-separators = before
break-string-literals = never
-break-struct = force
cases-matching-exp-indent = compact
-doc-comments = after-when-possible
dock-collection-brackets = false
-indicate-multiline-delimiters = no
-infix-precedence = indent
-let-and = compact
-let-binding-spacing = compact
-module-item-spacing = compact
parens-tuple = multi-line-only
-parens-tuple-patterns = multi-line-only
-sequence-style = terminator
sequence-blank-line = compact
-single-case = compact
-type-decl = compact
if-then-else = keyword-first
-field-space = loose
space-around-arrays = false
space-around-records = false
space-around-lists = false
space-around-variants = false
-ocp-indent-compat = true
+function-indent-nested = always
+indicate-multiline-delimiters = closing-on-separate-line
diff --git a/build/build.ml b/build/build.ml
index 44995935d4..4df031afb0 100644
--- a/build/build.ml
+++ b/build/build.ml
@@ -15,7 +15,8 @@ module Intern = struct
Some
(function
| `Client -> "src/ppx/ppx_eliom_client_ex." ^ best
- | `Server -> "src/ppx/ppx_eliom_server_ex." ^ best)
+ | `Server -> "src/ppx/ppx_eliom_server_ex." ^ best
+ )
let with_package = function
| "eliom.ppx.type" -> "pkg_ppx_eliom_types"
@@ -35,8 +36,8 @@ let _ =
Doc.init ();
let link source dest =
rule (Printf.sprintf "%s -> %s" source dest) ~dep:source ~prod:dest
- (fun env _ ->
- Cmd (S [A "ln"; A "-f"; P (env source); P (env dest)]))
+ (fun env _ -> Cmd (S [A "ln"; A "-f"; P (env source); P (env dest)])
+ )
in
(* add I pflag *)
pflag ["ocaml"; "compile"] "I" (fun x -> S [A "-I"; A x]);
@@ -51,18 +52,24 @@ let _ =
["ocaml"; "compile"; "pkg_" ^ name]
(S
[ A "-ppx"
- ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"]) ]);
+ ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"])
+ ]
+ );
flag
["ocaml"; "ocamldep"; "pkg_" ^ name]
(S
[ A "-ppx"
- ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"]) ]);
+ ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"])
+ ]
+ );
dep ["ocaml"; "ocamldep"; "pkg_" ^ name] [path ^ name ^ "_ex." ^ best];
flag_and_dep
["ocaml"; "infer_interface"; "pkg_" ^ name]
(S
[ A "-ppx"
- ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"]) ]);
+ ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"])
+ ]
+ );
dep
["ocaml"; "infer_interface"; "pkg_" ^ name]
[path ^ name ^ "_ex." ^ best];
@@ -70,7 +77,9 @@ let _ =
["doc"; "pkg_" ^ name]
(S
[ A "-ppx"
- ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"]) ]);
+ ; Quote (S [P (path ^ name ^ "_ex." ^ best); A "-as-ppx"])
+ ]
+ );
dep ["doc"; "pkg_" ^ name] [path ^ name ^ "_ex." ^ best]
in
add_syntax "ppx_eliom_utils" "src/ppx/";
@@ -86,7 +95,8 @@ let _ =
in
List.iter (link_exec "eliomc") ["eliomopt"; "eliomcp"; "js_of_eliom"];
link_exec "distillery" "eliom-distillery"
- | _ -> ())
+ | _ -> ()
+ )
let _ =
Options.make_links := false;
diff --git a/build/doc.ml b/build/doc.ml
index 9ffdc744cd..d505ce3164 100644
--- a/build/doc.ml
+++ b/build/doc.ml
@@ -32,11 +32,13 @@ let init_wikidoc () =
~stamp:"%.wikidocdir/wiki.stamp" ~dep:"%.odocl"
(Ocamlbuild_pack.Ocaml_tools.document_ocaml_project
~ocamldoc:ocamldoc_wiki "%.odocl" "%.wikidocdir/index.wiki"
- "%.wikidocdir");
+ "%.wikidocdir"
+ );
flag ["wikidoc"]
& S [A "-colorize-code"; A "-i"; A wikidoc_dir; A "-g"; A "odoc_wiki.cma"];
pflag ["wikidoc"] "subproject" (fun sub ->
- S [A "-passopt"; A "-subproject"; A sub])
+ S [A "-passopt"; A "-subproject"; A sub]
+ )
with Failure e -> ()
(* Silently fail if the package wikidoc isn't available *)
@@ -46,12 +48,15 @@ let init_mandoc () =
~prod:"%.mandocdir/man.%(ext)" ~stamp:"%.mandocdir/man.%(ext).stamp"
~dep:"%.odocl"
(Ocamlbuild_pack.Ocaml_tools.document_ocaml_project ~ocamldoc:ocamldoc_man
- "%.odocl" "%.mandocdir/man.%(ext)" "%.mandocdir");
+ "%.odocl" "%.mandocdir/man.%(ext)" "%.mandocdir"
+ );
pflag ["apiref"] "man_ext" (fun ext ->
- S [A "-man-mini"; A "-man-section"; A ext; A "-man-suffix"; A ext])
+ S [A "-man-mini"; A "-man-section"; A ext; A "-man-suffix"; A ext]
+ )
let init () =
init_wikidoc ();
init_mandoc ();
(* ocamldoc intro *)
- pflag_and_dep ["doc"] "with_intro" (fun f -> S [A "-intro"; P f])
+ pflag_and_dep ["doc"] "with_intro" (fun f -> S [A "-intro"; P f]
+ )
diff --git a/pkg/build.ml b/pkg/build.ml
old mode 100755
new mode 100644
index cad36985c3..ba9f213d4c
--- a/pkg/build.ml
+++ b/pkg/build.ml
@@ -91,7 +91,8 @@ let () =
"src/ppx/ppx_eliom_server"
; Pkg.bin ~auto:true ~dst:"ppx_eliom_client" "src/ppx/ppx_eliom_client_ex"
; Pkg.bin ~auto:true ~dst:"ppx_eliom_server" "src/ppx/ppx_eliom_server_ex"
- ; Pkg.bin ~auto:true ~dst:"ppx_eliom_types" "src/ppx/ppx_eliom_types_ex" ]
+ ; Pkg.bin ~auto:true ~dst:"ppx_eliom_types" "src/ppx/ppx_eliom_types_ex"
+ ]
(* CLIENT LIBS *)
@ Pkg.lib ~dst:"client/client" ~exts:[".cma"] "src/lib/client/client"
:: Pkg.lib ~dst:"client/eliom_client_main.cmo"
@@ -102,7 +103,8 @@ let () =
:: Pkg.stublibs "src/lib/client/dlleliom_stubs.so"
:: List.map
(fun x ->
- Pkg.lib ~dst:(spf "client/%s" x) (spf "src/lib/client/%s" x))
+ Pkg.lib ~dst:(spf "client/%s" x) (spf "src/lib/client/%s" x)
+ )
client_extra
(* SERVER LIBS *)
@ Pkg.lib ~dst:"server/monitor/eliom_monitor" ~exts:Exts.module_library
@@ -112,19 +114,25 @@ let () =
:: Pkg.lib ~dst:"server/server" ~exts:exts_lib "src/lib/server/server"
:: List.map
(fun x ->
- Pkg.lib ~dst:(spf "server/%s" x) (spf "src/lib/server/%s" x))
+ Pkg.lib ~dst:(spf "server/%s" x) (spf "src/lib/server/%s" x)
+ )
server_extra
@ [ (* MISC *)
Pkg.doc "README.md"
; Pkg.doc "CHANGES"
- ; Pkg.etc "pkg/etc/mime.types" ]
+ ; Pkg.etc "pkg/etc/mime.types"
+ ]
@ List.flatten
(List.map
(fun (name, files) ->
- List.map
- (fun file ->
- Pkg.lib
- ~dst:(spf "templates/%s/%s" name file)
- (spf "%s/%s/%s" templates_dir name file))
- files)
- templates_files))
+ List.map
+ (fun file ->
+ Pkg.lib
+ ~dst:(spf "templates/%s/%s" name file)
+ (spf "%s/%s/%s" templates_dir name file)
+ )
+ files
+ )
+ templates_files
+ )
+ )
diff --git a/pkg/filelist.ml b/pkg/filelist.ml
index d3601f5a90..82734c067c 100644
--- a/pkg/filelist.ml
+++ b/pkg/filelist.ml
@@ -8,7 +8,8 @@ let server =
; "eliom_parameter_sigs"
; "eliom_registration_sigs"
; "eliom_service_sigs"
- ; "eliom_shared_sigs" ]
+ ; "eliom_shared_sigs"
+ ]
; interface =
[ "eliom_bus"
; "eliom_client_value"
@@ -34,7 +35,8 @@ let server =
; "eliom_tools"
; "eliom_types"
; "eliom_uri"
- ; "eliom_wrap" ]
+ ; "eliom_wrap"
+ ]
; internal =
[ "eliom_comet_base"
; "eliom_common_base"
@@ -66,7 +68,9 @@ let server =
; "eliommod_sessadmin"
; "eliommod_sessexpl"
; "eliommod_sessiongroups"
- ; "eliommod_timeouts" ] }
+ ; "eliommod_timeouts"
+ ]
+ }
let client =
{ interface_only =
@@ -75,7 +79,8 @@ let client =
; "eliom_parameter_sigs"
; "eliom_registration_sigs"
; "eliom_service_sigs"
- ; "eliom_shared_sigs" ]
+ ; "eliom_shared_sigs"
+ ]
; interface =
[ "eliom_bus"
; "eliom_client_value"
@@ -96,7 +101,8 @@ let client =
; "eliom_tools"
; "eliom_types"
; "eliom_unwrap"
- ; "eliom_uri" ]
+ ; "eliom_uri"
+ ]
; internal =
[ "eliom_comet_base"
; "eliom_common"
@@ -117,12 +123,15 @@ let client =
; "eliom_types_base"
; "eliommod_cookies"
; "eliommod_dom"
- ; "eliommod_parameters" ] }
+ ; "eliommod_parameters"
+ ]
+ }
let server_ext =
{ interface_only = []
; interface = ["atom_feed"; "eliom_atom"; "eliom_openid"; "eliom_s2s"]
- ; internal = [] }
+ ; internal = []
+ }
let ocamlbuild =
{interface_only = []; interface = ["ocamlbuild_eliom"]; internal = []}
@@ -131,7 +140,8 @@ let ppx =
{ interface_only = []
; interface =
["ppx_eliom"; "ppx_eliom_client"; "ppx_eliom_type"; "ppx_eliom_server"]
- ; internal = ["ppx_eliom_utils"] }
+ ; internal = ["ppx_eliom_utils"]
+ }
let ( -.- ) name ext = name ^ "." ^ ext
diff --git a/pkg/topkg.ml b/pkg/topkg.ml
index 9bf11f5e25..e1f77d1ba8 100644
--- a/pkg/topkg.ml
+++ b/pkg/topkg.ml
@@ -45,7 +45,7 @@ module type Pkg = sig
(** The type for install moves. *)
type field =
- ?cond:bool
+ ?cond:bool
-> ?exts:string list
-> ?dst:string
-> ?target:string
@@ -128,7 +128,8 @@ end = struct
ignore (List.assoc key acc);
err_mdef key
with Not_found -> parse_env ((key, bool) :: acc) args
- with Invalid_argument _ | Not_found | Exit -> err_parse arg)
+ with Invalid_argument _ | Not_found | Exit -> err_parse arg
+ )
| [] -> acc
in
match List.tl (Array.to_list Sys.argv) with
@@ -174,7 +175,7 @@ module Pkg : Pkg = struct
type moves = move list
type field =
- ?cond:bool
+ ?cond:bool
-> ?exts:string list
-> ?dst:string
-> ?target:string
@@ -235,8 +236,9 @@ module Pkg : Pkg = struct
let l = List.filter (fun f -> has_suffix f s_suffix) l in
List.map
(fun s ->
- ( str "%s/%s%s" bdir s_path s
- , str "%s%s%s" d_path (Filename.chop_suffix s s_suffix) d_suffix ))
+ ( str "%s/%s%s" bdir s_path s
+ , str "%s%s%s" d_path (Filename.chop_suffix s s_suffix) d_suffix )
+ )
l
let build_install bdir mvs =
@@ -251,8 +253,9 @@ module Pkg : Pkg = struct
in
List.iter
(fun (src, dst) ->
- Buffer.add_string install
- (str "\n \"%s%s\" {\"%s\"}" option src dst))
+ Buffer.add_string install
+ (str "\n \"%s%s\" {\"%s\"}" option src dst)
+ )
(list_files bdir src dst);
add_mvs current mvs
| {field_name = field} :: _ as mvs ->
diff --git a/src/lib/client/eliommod_cookies.ml b/src/lib/client/eliommod_cookies.ml
index 33900a74ed..2edb668b58 100644
--- a/src/lib/client/eliommod_cookies.ml
+++ b/src/lib/client/eliommod_cookies.ml
@@ -24,17 +24,16 @@ include Eliom_cookies_base
(* CCC The tables are indexed by the hostname, not the port appear.
there are no particular reason. If needed it is possible to add it *)
let cookie_tables :
- (float option * string * bool) Ocsigen_cookie_map.Map_inner.t
+ (float option * string * bool) Ocsigen_cookie_map.Map_inner.t
Ocsigen_cookie_map.Map_path.t
- Jstable.t
- =
+ Jstable.t =
Jstable.create ()
module Map (Ord : sig
- type key [@@deriving json]
+ type key [@@deriving json]
- val compare : key -> key -> int
- end) =
+ val compare : key -> key -> int
+end) =
struct
type 'a t =
| Empty
@@ -60,7 +59,8 @@ struct
match lr with
| Empty -> invalid_arg "Map.bal"
| Node {l = lrl; v = lrv; d = lrd; r = lrr; _} ->
- create (create ll lv ld lrl) lrv lrd (create lrr x d r))
+ create (create ll lv ld lrl) lrv lrd (create lrr x d r)
+ )
else if hr > hl + 2
then
match r with
@@ -72,7 +72,8 @@ struct
match rl with
| Empty -> invalid_arg "Map.bal"
| Node {l = rll; v = rlv; d = rld; r = rlr; _} ->
- create (create l x d rll) rlv rld (create rlr rv rd rr))
+ create (create l x d rll) rlv rld (create rlr rv rd rr)
+ )
else Node {l; v = x; d; r; h = (if hl >= hr then hl + 1 else hr + 1)}
let rec add x data = function
@@ -100,16 +101,16 @@ end
[@@@warning "-39"]
module Map_path = Map (struct
- type key = string list [@@deriving json]
+ type key = string list [@@deriving json]
- let compare = compare
- end)
+ let compare = compare
+end)
module Map_inner = Map (struct
- type key = string [@@deriving json]
+ type key = string [@@deriving json]
- let compare = compare
- end)
+ let compare = compare
+end)
[@@@warning "+39"]
@@ -119,18 +120,21 @@ let json_cookies =
let extern_cookies c =
Ocsigen_cookie_map.Map_path.fold
(fun path inner m ->
- Map_path.add path
- (Ocsigen_cookie_map.Map_inner.fold Map_inner.add inner Map_inner.empty)
- m)
+ Map_path.add path
+ (Ocsigen_cookie_map.Map_inner.fold Map_inner.add inner Map_inner.empty)
+ m
+ )
c Map_path.empty
let intern_cookies c =
Map_path.fold
(fun path inner m ->
- Ocsigen_cookie_map.Map_path.add path
- (Map_inner.fold Ocsigen_cookie_map.Map_inner.add inner
- Ocsigen_cookie_map.Map_inner.empty)
- m)
+ Ocsigen_cookie_map.Map_path.add path
+ (Map_inner.fold Ocsigen_cookie_map.Map_inner.add inner
+ Ocsigen_cookie_map.Map_inner.empty
+ )
+ m
+ )
c Ocsigen_cookie_map.Map_path.empty
(** [in_local_storage] implements cookie substitutes for iOS WKWebView *)
@@ -144,11 +148,13 @@ let get_table ?(in_local_storage = false) = function
Dom_html.window##.localStorage
(fun () -> Ocsigen_cookie_map.Map_path.empty)
(fun st ->
- Js.Opt.case
- st##(getItem host)
- (fun () -> Ocsigen_cookie_map.Map_path.empty)
- (fun v ->
- intern_cookies (of_json ~typ:json_cookies (Js.to_string v))))
+ Js.Opt.case
+ st##(getItem host)
+ (fun () -> Ocsigen_cookie_map.Map_path.empty)
+ (fun v ->
+ intern_cookies (of_json ~typ:json_cookies (Js.to_string v))
+ )
+ )
else
Js.Optdef.get
(Jstable.find cookie_tables (Js.string host))
@@ -166,8 +172,10 @@ let set_table ?(in_local_storage = false) host t =
Dom_html.window##.localStorage
(fun () -> ())
(fun st ->
- st##(setItem host
- (Js.string (to_json ~typ:json_cookies (extern_cookies t)))))
+ st##(setItem host
+ (Js.string (to_json ~typ:json_cookies (extern_cookies t)))
+ )
+ )
else Jstable.add cookie_tables (Js.string host) t
let now () =
@@ -179,21 +187,26 @@ let update_cookie_table ?(in_local_storage = false) host cookies =
let now = now () in
Ocsigen_cookie_map.Map_path.iter
(fun path table ->
- Ocsigen_cookie_map.Map_inner.iter
- (fun name -> function
- | OSet (Some exp, _, _) when exp <= now ->
- set_table ~in_local_storage host
- (Ocsigen_cookie_map.Poly.remove ~path name
- (get_table ~in_local_storage host))
- | OUnset ->
- set_table ~in_local_storage host
- (Ocsigen_cookie_map.Poly.remove ~path name
- (get_table ~in_local_storage host))
- | OSet (exp, value, secure) ->
- set_table ~in_local_storage host
- (Ocsigen_cookie_map.Poly.add ~path name (exp, value, secure)
- (get_table ~in_local_storage host)))
- table)
+ Ocsigen_cookie_map.Map_inner.iter
+ (fun name -> function
+ | OSet (Some exp, _, _) when exp <= now ->
+ set_table ~in_local_storage host
+ (Ocsigen_cookie_map.Poly.remove ~path name
+ (get_table ~in_local_storage host)
+ )
+ | OUnset ->
+ set_table ~in_local_storage host
+ (Ocsigen_cookie_map.Poly.remove ~path name
+ (get_table ~in_local_storage host)
+ )
+ | OSet (exp, value, secure) ->
+ set_table ~in_local_storage host
+ (Ocsigen_cookie_map.Poly.add ~path name (exp, value, secure)
+ (get_table ~in_local_storage host)
+ )
+ )
+ table
+ )
cookies
(** [in_local_storage] implements cookie substitutes for iOS WKWebView *)
@@ -201,25 +214,28 @@ let get_cookies_to_send ?(in_local_storage = false) host https path =
let now = now () in
Ocsigen_cookie_map.Map_path.fold
(fun cpath t cookies_to_send ->
- if
- Url.is_prefix_skip_end_slash
- (Url.remove_slash_at_beginning cpath)
- (Url.remove_slash_at_beginning path)
- then
- Ocsigen_cookie_map.Map_inner.fold
- (fun name (exp, value, secure) cookies_to_send ->
- match exp with
- | Some exp when exp <= now ->
- set_table ~in_local_storage host
- (Ocsigen_cookie_map.Poly.remove ~path:cpath name
- (get_table ~in_local_storage host));
- cookies_to_send
- | _ ->
- if (not secure) || https
- then (name, value) :: cookies_to_send
- else cookies_to_send)
- t cookies_to_send
- else cookies_to_send)
+ if
+ Url.is_prefix_skip_end_slash
+ (Url.remove_slash_at_beginning cpath)
+ (Url.remove_slash_at_beginning path)
+ then
+ Ocsigen_cookie_map.Map_inner.fold
+ (fun name (exp, value, secure) cookies_to_send ->
+ match exp with
+ | Some exp when exp <= now ->
+ set_table ~in_local_storage host
+ (Ocsigen_cookie_map.Poly.remove ~path:cpath name
+ (get_table ~in_local_storage host)
+ );
+ cookies_to_send
+ | _ ->
+ if (not secure) || https
+ then (name, value) :: cookies_to_send
+ else cookies_to_send
+ )
+ t cookies_to_send
+ else cookies_to_send
+ )
(get_table ~in_local_storage host)
[]
diff --git a/src/lib/client/eliommod_dom.ml b/src/lib/client/eliommod_dom.ml
index 8d17b6fa94..71f58cef06 100644
--- a/src/lib/client/eliommod_dom.ml
+++ b/src/lib/client/eliommod_dom.ml
@@ -30,10 +30,8 @@ let iter_nodeList nodeList f =
f (Js.Unsafe.get nodeList i)
done
-let iter_attrList
- (attrList : Dom.attr Dom.namedNodeMap Js.t)
- (f : Dom.attr Js.t -> unit)
- =
+let iter_attrList (attrList : Dom.attr Dom.namedNodeMap Js.t)
+ (f : Dom.attr Js.t -> unit) =
for i = 0 to attrList##.length - 1 do
(* Unsafe.get is ten time faster than nodeList##item.
Is it the same for attrList ? *)
@@ -100,37 +98,42 @@ let ancessor =
let fast_select_request_nodes root =
root##(querySelectorAll
- (Js.string ("." ^ Eliom_runtime.RawXML.request_node_class)))
+ (Js.string ("." ^ Eliom_runtime.RawXML.request_node_class))
+ )
let fast_select_nodes root =
if !Eliom_config.debug_timings
then Console.console##(time (Js.string "fast_select_nodes"));
let a_nodeList : Dom_html.element Dom.nodeList Js.t =
root##(querySelectorAll
- (Js.string ("a." ^ Eliom_runtime.RawXML.ce_call_service_class)))
+ (Js.string ("a." ^ Eliom_runtime.RawXML.ce_call_service_class))
+ )
in
let a_nodeList : Dom_html.anchorElement Dom.nodeList Js.t =
Js.Unsafe.coerce a_nodeList
in
let form_nodeList : Dom_html.element Dom.nodeList Js.t =
root##(querySelectorAll
- (Js.string ("form." ^ Eliom_runtime.RawXML.ce_call_service_class)))
+ (Js.string ("form." ^ Eliom_runtime.RawXML.ce_call_service_class))
+ )
in
let form_nodeList : Dom_html.formElement Dom.nodeList Js.t =
Js.Unsafe.coerce form_nodeList
in
let process_node_nodeList =
root##(querySelectorAll
- (Js.string ("." ^ Eliom_runtime.RawXML.process_node_class)))
+ (Js.string ("." ^ Eliom_runtime.RawXML.process_node_class))
+ )
in
let closure_nodeList =
root##(querySelectorAll
- (Js.string
- ("." ^ Eliom_runtime.RawXML.ce_registered_closure_class)))
+ (Js.string ("." ^ Eliom_runtime.RawXML.ce_registered_closure_class))
+ )
in
let attrib_nodeList =
root##(querySelectorAll
- (Js.string ("." ^ Eliom_runtime.RawXML.ce_registered_attr_class)))
+ (Js.string ("." ^ Eliom_runtime.RawXML.ce_registered_attr_class))
+ )
in
if !Eliom_config.debug_timings
then Console.console##(timeEnd (Js.string "fast_select_nodes"));
@@ -192,23 +195,30 @@ let slow_has_request_class (node : Dom_html.element Js.t) =
let fast_has_classes (node : Dom_html.element Js.t) =
( Js.to_bool
node##.classList##(contains
- (Js.string Eliom_runtime.RawXML.ce_call_service_class))
+ (Js.string Eliom_runtime.RawXML.ce_call_service_class)
+ )
, Js.to_bool
node##.classList##(contains
- (Js.string Eliom_runtime.RawXML.process_node_class))
+ (Js.string Eliom_runtime.RawXML.process_node_class)
+ )
, Js.to_bool
node##.classList##(contains
(Js.string
- Eliom_runtime.RawXML.ce_registered_closure_class))
+ Eliom_runtime.RawXML.ce_registered_closure_class
+ )
+ )
, Js.to_bool
node##.classList##(contains
(Js.string
- Eliom_runtime.RawXML.ce_registered_attr_class)) )
+ Eliom_runtime.RawXML.ce_registered_attr_class
+ )
+ ) )
let fast_has_request_class (node : Dom_html.element Js.t) =
Js.to_bool
node##.classList##(contains
- (Js.string Eliom_runtime.RawXML.request_node_class))
+ (Js.string Eliom_runtime.RawXML.request_node_class)
+ )
let has_classes : Dom_html.element Js.t -> bool * bool * bool * bool =
if test_classList () then fast_has_classes else slow_has_classes
@@ -240,14 +250,15 @@ let slow_select_nodes (root : Dom_html.element Js.t) =
| Dom.ELEMENT ->
let node = (Js.Unsafe.coerce node : Dom_html.element Js.t) in
let call_service, process_node, closure, attrib = has_classes node in
- (if call_service
- then
- match Dom_html.tagged node with
- | Dom_html.A e -> ignore a_array##(push e)
- | Dom_html.Form e -> ignore form_array##(push e)
- | _ ->
- raise_error ~section "%s element tagged as eliom link"
- (Js.to_string node##.tagName));
+ ( if call_service
+ then
+ match Dom_html.tagged node with
+ | Dom_html.A e -> ignore a_array##(push e)
+ | Dom_html.Form e -> ignore form_array##(push e)
+ | _ ->
+ raise_error ~section "%s element tagged as eliom link"
+ (Js.to_string node##.tagName)
+ );
if process_node then ignore node_array##(push node);
if closure then ignore closure_array##(push node);
if attrib then ignore attrib_array##(push node);
@@ -306,14 +317,13 @@ let get_body (page : 'element #get_tag Js.t) : 'element Js.t =
page##(getElementsByTagName (Js.string "body"))##(item 0)
(fun () -> raise_error ~section "get_body")
-let iter_dom_array
- (f : 'a -> unit)
- (a :
- < length : < get : int ; .. > Js.gen_prop
- ; item : int -> 'a Js.opt Js.meth
- ; .. >
- Js.t)
- =
+let iter_dom_array (f : 'a -> unit)
+ (a :
+ < length : < get : int ; .. > Js.gen_prop
+ ; item : int -> 'a Js.opt Js.meth
+ ; .. >
+ Js.t
+ ) =
let length = a##.length in
for i = 0 to length - 1 do
Js.Opt.iter a##(item i) f
@@ -365,20 +375,20 @@ let add_childrens (elt : Dom_html.element Js.t) (sons : Dom.node Js.t list) =
let d = Dom_html.createHead Dom_html.document in
Dom.appendChild d elt;
(Js.Unsafe.coerce elt)##.styleSheet##.cssText := concat sons
- | _ -> raise_error ~section ~exn "add_childrens: can't appendChild")
+ | _ -> raise_error ~section ~exn "add_childrens: can't appendChild"
+ )
(* END IE HACK *)
-let copy_element
- (e : Dom.element Js.t)
- (registered_process_node : Js.js_string Js.t -> bool) :
- Dom_html.element Js.t
- =
+let copy_element (e : Dom.element Js.t)
+ (registered_process_node : Js.js_string Js.t -> bool) :
+ Dom_html.element Js.t =
let rec aux (e : Dom.element Js.t) =
let copy = Dom_html.document##(createElement e##.tagName) in
(* IE<9: Copy className separately, it's not updated when displayed *)
Js.Opt.iter (Dom_html.CoerceTo.element e) (fun e ->
- copy##.className := e##.className);
+ copy##.className := e##.className
+ );
let node_id =
Js.Opt.to_option
e##(getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))
@@ -395,16 +405,18 @@ let copy_element
Js.Opt.iter (Dom.CoerceTo.attr a)
(* we don't use copy##attributes##setNameditem:
in ie 9 it fail setting types of buttons... *)
- (fun a -> copy##(setAttribute a##.name a##.value))
+ (fun a -> copy##(setAttribute a##.name a##.value)
+ )
in
iter_dom_array add_attribute e##.attributes;
let child_copies =
List.map_filter
(fun child ->
- match Dom.nodeType child with
- | Dom.Text t -> Some (copy_text t :> Dom.node Js.t)
- | Dom.Element child -> (aux child :> Dom.node Js.t option)
- | _ -> None)
+ match Dom.nodeType child with
+ | Dom.Text t -> Some (copy_text t :> Dom.node Js.t)
+ | Dom.Element child -> (aux child :> Dom.node Js.t option)
+ | _ -> None
+ )
(Dom.list_of_nodeList e##.childNodes)
in
add_childrens copy child_copies;
@@ -413,8 +425,7 @@ let copy_element
match aux e with None -> raise_error ~section "copy_element" | Some e -> e
let html_document (src : Dom.element Dom.document Js.t) registered_process_node
- : Dom_html.element Js.t
- =
+ : Dom_html.element Js.t =
let content = src##.documentElement in
match Js.Opt.to_option (Dom_html.CoerceTo.element content) with
| Some e -> (
@@ -423,17 +434,22 @@ let html_document (src : Dom.element Dom.document Js.t) registered_process_node
Logs.debug ~src:section (fun fmt ->
fmt
("can't adopt node, import instead" ^^ "@\n%s")
- (Printexc.to_string exn));
+ (Printexc.to_string exn)
+ );
try Dom_html.document##(importNode (e :> Dom.element Js.t) Js._true)
with exn ->
Logs.debug ~src:section (fun fmt ->
fmt
("can't import node, copy instead" ^^ "@\n%s")
- (Printexc.to_string exn));
- copy_element content registered_process_node))
+ (Printexc.to_string exn)
+ );
+ copy_element content registered_process_node
+ )
+ )
| None ->
Logs.debug ~src:section (fun fmt ->
- fmt "can't adopt node, document not parsed as html. copy instead");
+ fmt "can't adopt node, document not parsed as html. copy instead"
+ );
copy_element content registered_process_node
(** CSS preloading. *)
@@ -446,10 +462,11 @@ let is_stylesheet e =
(Dom_html.CoerceTo.link (Js.Unsafe.coerce e))
(fun _ -> false)
(fun e ->
- List.exists
- (fun s -> s = "stylesheet")
- (Regexp.split spaces_re (Js.to_string e##.rel))
- && e##._type == Js.string "text/css")
+ List.exists
+ (fun s -> s = "stylesheet")
+ (Regexp.split spaces_re (Js.to_string e##.rel))
+ && e##._type == Js.string "text/css"
+ )
let basedir_re = Regexp.regexp "^(([^/?]*/)*)([^/?]*)(\\?.*)?$"
@@ -459,11 +476,14 @@ let basedir path =
| Some res -> (
match Regexp.matched_group res 1 with
| None -> (
- match Regexp.matched_group res 3 with Some ".." -> "../" | _ -> "/")
+ match Regexp.matched_group res 3 with Some ".." -> "../" | _ -> "/"
+ )
| Some dir -> (
match Regexp.matched_group res 3 with
| Some ".." -> dir ^ "../"
- | _ -> dir))
+ | _ -> dir
+ )
+ )
let fetch_linked_css e =
let rec extract acc (e : Dom.node Js.t) =
@@ -498,7 +518,8 @@ let quoted_url_raw = "'(([^\\\\']|\\\\.)*)'"
let url_re =
Regexp.regexp
(Printf.sprintf "url\\s*\\(\\s*(%s|%s|%s)\\s*\\)\\s*" dbl_quoted_url_raw
- quoted_url_raw url_content_raw)
+ quoted_url_raw url_content_raw
+ )
let raw_url_re =
Regexp.regexp
@@ -519,8 +540,10 @@ let parse_absolute ~prefix href =
| Some (i, res) when i = 0 -> (
match Regexp.matched_group res 1 with
| Some href -> (* absolute URL -> do not rewrite *) href
- | None -> raise Incorrect_url)
- | _ -> prefix ^ href)
+ | None -> raise Incorrect_url
+ )
+ | _ -> prefix ^ href
+ )
let parse_url ~prefix css pos =
match Regexp.search url_re css pos with
@@ -534,15 +557,20 @@ let parse_url ~prefix css pos =
| None -> (
match Regexp.matched_group res 4 with
| Some href -> parse_absolute ~prefix href
- | None -> raise Incorrect_url)) ))
+ | None -> raise Incorrect_url
+ )
+ ) )
+ )
| _ -> (
match Regexp.search raw_url_re css pos with
| Some (i, res) when i = pos -> (
( i + String.length (Regexp.matched_string res)
, match Regexp.matched_group res 1 with
| Some href -> parse_absolute ~prefix href
- | None -> raise Incorrect_url ))
- | _ -> raise Incorrect_url)
+ | None -> raise Incorrect_url )
+ )
+ | _ -> raise Incorrect_url
+ )
let parse_media css pos =
let i =
@@ -571,7 +599,8 @@ let rewrite_css_url ~prefix css pos =
Buffer.add_string buf "')";
rewrite i
with Incorrect_url ->
- Buffer.add_substring buf css i (String.length css - i))
+ Buffer.add_substring buf css i (String.length css - i)
+ )
in
rewrite pos; Buffer.contents buf
@@ -580,17 +609,18 @@ let import_re = Regexp.regexp "@import\\s*"
let rec rewrite_css ~max (media, href, css) =
Lwt.catch
(fun () ->
- css >>= function
- | None -> Lwt.return_nil
- | Some css ->
- if !Eliom_config.debug_timings
- then Console.console##(time (Js.string ("rewrite_CSS: " ^ href)));
- let* imports, css =
- rewrite_css_import ~max ~prefix:(basedir href) ~media css 0
- in
- if !Eliom_config.debug_timings
- then Console.console##(timeEnd (Js.string ("rewrite_CSS: " ^ href)));
- Lwt.return (imports @ [media, css]))
+ css >>= function
+ | None -> Lwt.return_nil
+ | Some css ->
+ if !Eliom_config.debug_timings
+ then Console.console##(time (Js.string ("rewrite_CSS: " ^ href)));
+ let* imports, css =
+ rewrite_css_import ~max ~prefix:(basedir href) ~media css 0
+ in
+ if !Eliom_config.debug_timings
+ then Console.console##(timeEnd (Js.string ("rewrite_CSS: " ^ href)));
+ Lwt.return (imports @ [media, css])
+ )
(fun _ -> Lwt.return [media, Printf.sprintf "@import url(%s);" href])
and rewrite_css_import ?(charset = "") ~max ~prefix ~media css pos =
@@ -634,10 +664,10 @@ and rewrite_css_import ?(charset = "") ~max ~prefix ~media css pos =
| Incorrect_url -> Lwt.return ([], rewrite_css_url ~prefix css pos)
| exn ->
Logs.info ~src:section (fun fmt ->
- fmt
- ("Error while importing css" ^^ "@\n%s")
- (Printexc.to_string exn));
- Lwt.return ([], rewrite_css_url ~prefix css pos))
+ fmt ("Error while importing css" ^^ "@\n%s") (Printexc.to_string exn)
+ );
+ Lwt.return ([], rewrite_css_url ~prefix css pos)
+ )
let max_preload_depth = ref 4
@@ -646,16 +676,17 @@ let build_style (e, css) =
(* lwt css = *)
Lwt_list.map_p
(fun (media, css) ->
- let style = Dom_html.createStyle Dom_html.document in
- style##._type := Js.string "text/css";
- style##.media := media;
- (* IE8: Assigning to style##innerHTML results in
+ let style = Dom_html.createStyle Dom_html.document in
+ style##._type := Js.string "text/css";
+ style##.media := media;
+ (* IE8: Assigning to style##innerHTML results in
"Unknown runtime error" *)
- let styleSheet = Js.Unsafe.(get style (Js.string "styleSheet")) in
- if Js.Optdef.test styleSheet
- then Js.Unsafe.(set styleSheet (Js.string "cssText") (Js.string css))
- else style##.innerHTML := Js.string css;
- Lwt.return (e, (style :> Dom.node Js.t)))
+ let styleSheet = Js.Unsafe.(get style (Js.string "styleSheet")) in
+ if Js.Optdef.test styleSheet
+ then Js.Unsafe.(set styleSheet (Js.string "cssText") (Js.string css))
+ else style##.innerHTML := Js.string css;
+ Lwt.return (e, (style :> Dom.node Js.t))
+ )
css
(* IE8 doesn't allow appendChild on noscript-elements *)
@@ -673,13 +704,15 @@ let preload_css (doc : Dom_html.element Js.t) =
let css = List.concat css in
List.iter
(fun (e, css) ->
- try Dom.replaceChild (get_head doc) css e
- with _ ->
- Logs.info
- ~src:
- (* Node was a unique node that has been removed...
+ try Dom.replaceChild (get_head doc) css e
+ with _ ->
+ Logs.info
+ ~src:
+ (* Node was a unique node that has been removed...
in a perfect settings we won't have parsed it... *)
- section (fun fmt -> fmt "Unique CSS skipped..."))
+ section (fun fmt -> fmt "Unique CSS skipped..."
+ )
+ )
css;
if !Eliom_config.debug_timings
then Console.console##(timeEnd (Js.string "preload_css (fetch+rewrite)"));
@@ -705,7 +738,8 @@ let createDocumentScroll () =
{ html_top = Js.to_float Dom_html.document##.documentElement##.scrollTop
; html_left = Js.to_float Dom_html.document##.documentElement##.scrollLeft
; body_top = Js.to_float Dom_html.document##.body##.scrollTop
- ; body_left = Js.to_float Dom_html.document##.body##.scrollLeft }
+ ; body_left = Js.to_float Dom_html.document##.body##.scrollLeft
+ }
(* With firefox, the scroll position is restored before to fire the
popstate event. We maintain our own position. *)
@@ -716,12 +750,15 @@ let _ =
(* HACK: Remove this when js_of_ocaml 1.1.2 or greater is released... *)
(* window##onscroll <- *)
ignore
- (Dom.addEventListener Dom_html.document (Dom.Event.make "scroll")
- (Dom_html.handler (fun _event ->
- current_position := createDocumentScroll ();
- Js._false))
- Js._true
- : Dom_html.event_listener_id)
+ ( Dom.addEventListener Dom_html.document (Dom.Event.make "scroll")
+ (Dom_html.handler (fun _event ->
+ current_position := createDocumentScroll ();
+ Js._false
+ )
+ )
+ Js._true
+ : Dom_html.event_listener_id
+ )
let getDocumentScroll () = !current_position
@@ -739,11 +776,14 @@ let touch_base () =
Js.Opt.iter
(Js.Opt.bind
Dom_html.document##(getElementById
- (Js.string Eliom_common_base.base_elt_id))
- Dom_html.CoerceTo.base)
+ (Js.string Eliom_common_base.base_elt_id)
+ )
+ Dom_html.CoerceTo.base
+ )
(fun e ->
- let href = e##.href in
- e##.href := href)
+ let href = e##.href in
+ e##.href := href
+ )
(* BEGIN FORMDATA HACK: This is only needed if FormData is not available in the browser.
When it will be commonly available, remove all sections marked by "FORMDATA HACK" !
@@ -761,21 +801,23 @@ let touch_base () =
* in js_of_ocaml, module Form: the code to emulate FormData *)
let onclick_on_body_handler event =
- (match Dom_html.tagged (Dom_html.eventTarget event) with
+ ( match Dom_html.tagged (Dom_html.eventTarget event) with
| Dom_html.Button button -> Js.Unsafe.global##.eliomLastButton := Some button
| Dom_html.Input input when input##._type = Js.string "submit" ->
Js.Unsafe.global##.eliomLastButton := Some input
- | _ -> Js.Unsafe.global##.eliomLastButton := None);
+ | _ -> Js.Unsafe.global##.eliomLastButton := None
+ );
Js._true
let add_formdata_hack_onclick_handler () =
ignore
- (Dom_html.addEventListener
- Dom_html.window##.document##.body
- Dom_html.Event.click
- (Dom_html.handler onclick_on_body_handler)
- Js._true
- : Dom_html.event_listener_id)
+ ( Dom_html.addEventListener
+ Dom_html.window##.document##.body
+ Dom_html.Event.click
+ (Dom_html.handler onclick_on_body_handler)
+ Js._true
+ : Dom_html.event_listener_id
+ )
(* END FORMDATA HACK *)
@@ -787,20 +829,25 @@ let onhashchange f =
if test_onhashchange ()
then
ignore
- (Dom.addEventListener Dom_html.window hashchange
- (Dom_html.handler (fun _ ->
- f Dom_html.window##.location##.hash;
- Js._false))
- Js._true
- : Dom_html.event_listener_id)
+ ( Dom.addEventListener Dom_html.window hashchange
+ (Dom_html.handler (fun _ ->
+ f Dom_html.window##.location##.hash;
+ Js._false
+ )
+ )
+ Js._true
+ : Dom_html.event_listener_id
+ )
else
let last_fragment = ref Dom_html.window##.location##.hash in
let check () =
if not (Js.equals !last_fragment Dom_html.window##.location##.hash)
then (
last_fragment := Dom_html.window##.location##.hash;
- f Dom_html.window##.location##.hash)
+ f Dom_html.window##.location##.hash
+ )
in
ignore
Dom_html.window##(setInterval (Js.wrap_callback check)
- (Js.float (0.2 *. 1000.)))
+ (Js.float (0.2 *. 1000.))
+ )
diff --git a/src/lib/client/eliommod_dom.mli b/src/lib/client/eliommod_dom.mli
index 6f58ad8ce5..7684d8c331 100644
--- a/src/lib/client/eliommod_dom.mli
+++ b/src/lib/client/eliommod_dom.mli
@@ -38,7 +38,7 @@ val get_head : 'element #get_tag Js.t -> 'element Js.t
* nodes with attributes *)
val select_nodes :
- Dom_html.element Js.t
+ Dom_html.element Js.t
-> Dom_html.anchorElement Dom.nodeList Js.t
* Dom_html.formElement Dom.nodeList Js.t
* Dom_html.element Dom.nodeList Js.t
@@ -46,8 +46,7 @@ val select_nodes :
* Dom_html.element Dom.nodeList Js.t
val select_request_nodes :
- Dom_html.element Js.t
- -> Dom_html.element Dom.nodeList Js.t
+ Dom_html.element Js.t -> Dom_html.element Dom.nodeList Js.t
(** [select_request_nodes root] finds the nodes below [root]
in the page annotated to be:
* request unique nodes *)
@@ -58,14 +57,12 @@ val ancessor : #Dom.node Js.t -> #Dom.node Js.t -> bool
val createEvent : Js.js_string Js.t -> #Dom_html.event Js.t
val copy_element :
- Dom.element Js.t
- -> (Js.js_string Js.t -> bool)
- -> Dom_html.element Js.t
+ Dom.element Js.t -> (Js.js_string Js.t -> bool) -> Dom_html.element Js.t
(** [copy_element e] creates recursively a fresh html from any xml
element avoiding browser bugs *)
val html_document :
- Dom.element Dom.document Js.t
+ Dom.element Dom.document Js.t
-> (Js.js_string Js.t -> bool)
-> Dom_html.element Js.t
(** Assuming [d] has a body and head element, [html_document d] will
@@ -79,9 +76,7 @@ val preload_css : Dom_html.element Js.t -> unit Lwt.t
val iter_nodeList : 'a Dom.nodeList Js.t -> ('a Js.t -> unit) -> unit
val iter_attrList :
- Dom.attr Dom.namedNodeMap Js.t
- -> (Dom.attr Js.t -> unit)
- -> unit
+ Dom.attr Dom.namedNodeMap Js.t -> (Dom.attr Js.t -> unit) -> unit
(** Window scrolling. *)
diff --git a/src/lib/eliom.server.ml b/src/lib/eliom.server.ml
index 44b317d596..aa46938358 100644
--- a/src/lib/eliom.server.ml
+++ b/src/lib/eliom.server.ml
@@ -1,55 +1,42 @@
let default_app_name = Eliom_common.default_app_name
let set_app_name = Eliommod.set_app_name
-let run
- ?(app = default_app_name)
- ?xhr_links
- ?data_timeout
- ?service_timeout
- ?persistent_timeout
- ?max_service_sessions_per_group
- ?max_volatile_data_sessions_per_group
- ?max_persistent_data_sessions_per_group
- ?max_service_tab_sessions_per_group
- ?max_volatile_data_tab_sessions_per_group
- ?max_persistent_data_tab_sessions_per_group
- ?max_anonymous_services_per_session
- ?secure_cookies
- ?application_script
- ?enable_wasm
- ?global_data_caching
- ?html_content_type
- ?ignored_get_params
- ?ignored_post_params
- ?omitpersistentstorage
- ()
- vh
- conf_info
- site_dir
- =
+let run ?(app = default_app_name) ?xhr_links ?data_timeout ?service_timeout
+ ?persistent_timeout ?max_service_sessions_per_group
+ ?max_volatile_data_sessions_per_group
+ ?max_persistent_data_sessions_per_group ?max_service_tab_sessions_per_group
+ ?max_volatile_data_tab_sessions_per_group
+ ?max_persistent_data_tab_sessions_per_group
+ ?max_anonymous_services_per_session ?secure_cookies ?application_script
+ ?enable_wasm ?global_data_caching ?html_content_type ?ignored_get_params
+ ?ignored_post_params ?omitpersistentstorage () vh conf_info site_dir =
let sitedata = Eliommod.update_sitedata app vh site_dir conf_info in
(* customize sitedata according to optional parameters: *)
Option.iter
(fun v ->
- sitedata.Eliom_common.default_links_xhr#set ~override_tenable:true v)
+ sitedata.Eliom_common.default_links_xhr#set ~override_tenable:true v
+ )
xhr_links;
Option.iter
(fun (level, hierarchyname, v) ->
- Eliommod.set_timeout
- (Eliommod_timeouts.set_global_ ~kind:`Data)
- sitedata level hierarchyname v)
+ Eliommod.set_timeout
+ (Eliommod_timeouts.set_global_ ~kind:`Data)
+ sitedata level hierarchyname v
+ )
data_timeout;
Option.iter
(fun (level, hierarchyname, v) ->
- Eliommod.set_timeout
- (Eliommod_timeouts.set_global_ ~kind:`Service)
- sitedata level hierarchyname v)
+ Eliommod.set_timeout
+ (Eliommod_timeouts.set_global_ ~kind:`Service)
+ sitedata level hierarchyname v
+ )
service_timeout;
Option.iter
(fun (level, hierarchyname, v) ->
- Eliommod.set_timeout
- (Eliommod_timeouts.set_global_ ~kind:`Persistent)
- sitedata level hierarchyname v)
+ Eliommod.set_timeout
+ (Eliommod_timeouts.set_global_ ~kind:`Persistent)
+ sitedata level hierarchyname v
+ )
persistent_timeout;
Option.iter
(fun v -> sitedata.max_service_sessions_per_group <- v)
@@ -68,7 +55,8 @@ let run
max_volatile_data_tab_sessions_per_group;
Option.iter
(fun v ->
- sitedata.max_persistent_data_tab_sessions_per_group <- Some v, true)
+ sitedata.max_persistent_data_tab_sessions_per_group <- Some v, true
+ )
max_persistent_data_tab_sessions_per_group;
Option.iter
(fun v -> sitedata.max_anonymous_services_per_session <- v)
diff --git a/src/lib/eliom.server.mli b/src/lib/eliom.server.mli
index 09d0144b6a..a4bf981b2a 100644
--- a/src/lib/eliom.server.mli
+++ b/src/lib/eliom.server.mli
@@ -9,7 +9,7 @@ val default_app_name : string
(** The default application name, if you don't specify any *)
val run :
- ?app:string
+ ?app:string
-> ?xhr_links:bool
-> ?data_timeout:
[< Eliom_common.cookie_level]
diff --git a/src/lib/eliom_bus.client.ml b/src/lib/eliom_bus.client.ml
index bb2474995f..1321df0982 100644
--- a/src/lib/eliom_bus.client.ml
+++ b/src/lib/eliom_bus.client.ml
@@ -36,7 +36,8 @@ type ('a, 'b) t =
; mutable waiter : unit -> unit Lwt.t
; mutable last_wait : unit Lwt.t
; mutable original_stream_available : bool
- ; error_h : 'b option Lwt.t * exn Lwt.u }
+ ; error_h : 'b option Lwt.t * exn Lwt.u
+ }
(* clone streams such that each clone of the original stream raise the same exceptions *)
let consume (t, u) s =
@@ -44,8 +45,9 @@ let consume (t, u) s =
Lwt.catch
(fun () -> Lwt_stream.iter (fun _ -> ()) s)
(fun e ->
- (match Lwt.state t with Lwt.Sleep -> Lwt.wakeup_exn u e | _ -> ());
- Lwt.fail e)
+ (match Lwt.state t with Lwt.Sleep -> Lwt.wakeup_exn u e | _ -> ());
+ Lwt.fail e
+ )
in
Lwt.choose [Lwt.bind t (fun _ -> Lwt.return_unit); t']
@@ -55,43 +57,49 @@ let clone_exn (t, u) s =
Lwt.catch
(fun () -> Lwt.choose [Lwt_stream.get s'; t])
(fun e ->
- (match Lwt.state t with Lwt.Sleep -> Lwt.wakeup_exn u e | _ -> ());
- Lwt.fail e))
+ (match Lwt.state t with Lwt.Sleep -> Lwt.wakeup_exn u e | _ -> ());
+ Lwt.fail e
+ )
+ )
type ('a, 'att, 'co, 'ext, 'reg) callable_bus_service =
( unit
- , 'a list
- , Eliom_service.post
- , 'att
- , 'co
- , 'ext
- , 'reg
- , [`WithoutSuffix]
- , unit
- , [`One of 'a list Eliom_parameter.ocaml] Eliom_parameter.param_name
- , Eliom_registration.Action.return )
- Eliom_service.t
+ , 'a list
+ , Eliom_service.post
+ , 'att
+ , 'co
+ , 'ext
+ , 'reg
+ , [`WithoutSuffix]
+ , unit
+ , [`One of 'a list Eliom_parameter.ocaml] Eliom_parameter.param_name
+ , Eliom_registration.Action.return
+ )
+ Eliom_service.t
let create service channel waiter =
let write x =
Lwt.catch
(fun () ->
- let* _ =
- Eliom_client.call_service
- ~service:(service :> ('a, _, _, _, _) callable_bus_service)
- () x
- in
- Lwt.return_unit)
+ let* _ =
+ Eliom_client.call_service
+ ~service:(service :> ('a, _, _, _, _) callable_bus_service)
+ () x
+ in
+ Lwt.return_unit
+ )
(function
| Eliom_request.Failed_request 204 -> Lwt.return_unit
- | exc -> Lwt.reraise exc)
+ | exc -> Lwt.reraise exc
+ )
in
let error_h =
let t, u = Lwt.wait () in
( Lwt.catch
(fun () ->
- let* _ = t in
- assert false)
+ let* _ = t in
+ assert false
+ )
(fun e -> Lwt.fail e)
, u )
in
@@ -100,7 +108,8 @@ let create service channel waiter =
(let stream = Eliom_comet.register channel in
(* iterate on the stream to consume messages: avoid memory leak *)
let _ = consume error_h stream in
- stream)
+ stream
+ )
in
let t =
{ channel
@@ -111,7 +120,8 @@ let create service channel waiter =
; waiter
; last_wait = Lwt.return_unit
; original_stream_available = true
- ; error_h }
+ ; error_h
+ }
in
(* the comet channel start receiving after the load phase, so the
original channel (i.e. without message lost) is only available in
diff --git a/src/lib/eliom_bus.server.ml b/src/lib/eliom_bus.server.ml
index c7814ceab2..4e6513511b 100644
--- a/src/lib/eliom_bus.server.ml
+++ b/src/lib/eliom_bus.server.ml
@@ -31,16 +31,17 @@ type ('a, 'b) t =
; service : 'a Ecb.bus_send_service
; service_registered : bool Eliom_state.volatile_table option
; size : int option
- ; bus_mark : ('a, 'b) t Eliom_common.wrapper (* must be the last field ! *) }
+ ; bus_mark : ('a, 'b) t Eliom_common.wrapper (* must be the last field ! *)
+ }
[@@warning "-69"]
let register_sender scope service write =
Eliom_registration.Action.register ~scope ~options:`NoReload ~service
- (fun () x -> Lwt_list.iter_s write x)
+ (fun () x -> Lwt_list.iter_s write x
+ )
let internal_wrap (bus : ('a, 'b) t) :
- ('a, 'b) Ecb.wrapped_bus * Eliom_common.unwrapper
- =
+ ('a, 'b) Ecb.wrapped_bus * Eliom_common.unwrapper =
let channel =
match bus.channel with
| None ->
@@ -49,7 +50,7 @@ let internal_wrap (bus : ('a, 'b) t) :
(Lwt_stream.clone bus.stream)
| Some c -> c
in
- (match bus.service_registered with
+ ( match bus.service_registered with
| None -> ()
| Some table -> (
match Eliom_state.get_volatile_data ~table () with
@@ -57,21 +58,25 @@ let internal_wrap (bus : ('a, 'b) t) :
| _ ->
let {service = Ecb.Bus_send_service srv; _} = bus in
register_sender bus.scope
- (srv
+ ( srv
:> ( _
- , _ list
- , _
- , _
- , _
- , Eliom_service.non_ext
- , _
- , _
- , _
- , _
- , _ )
- Eliom_service.t)
+ , _ list
+ , _
+ , _
+ , _
+ , Eliom_service.non_ext
+ , _
+ , _
+ , _
+ , _
+ , _
+ )
+ Eliom_service.t
+ )
bus.write;
- Eliom_state.set_volatile_data ~table true));
+ Eliom_state.set_volatile_data ~table true
+ )
+ );
( (Eliom_comet.Channel.get_wrapped channel, bus.service)
, Eliom_common.make_unwrapper Eliom_common.bus_unwrap_id )
@@ -79,16 +84,16 @@ let bus_mark () = Eliom_common.make_wrapper internal_wrap
let deriving_to_list : 'a Deriving_Json.t -> 'a list Deriving_Json.t =
fun (type typ) typ ->
- let (typ_list : typ list Deriving_Json.t) =
- let module M = Deriving_Json.Json_list (Deriving_Json.Defaults'' (struct
- type a = typ
+ let (typ_list : typ list Deriving_Json.t) =
+ let module M = Deriving_Json.Json_list (Deriving_Json.Defaults'' (struct
+ type a = typ
- let t = typ
- end))
- in
- M.t
- in
- typ_list
+ let t = typ
+ end))
+ in
+ M.t
+ in
+ typ_list
let create_filtered ?scope ?name ?size ~filter typ =
(*The stream*)
@@ -107,14 +112,16 @@ let create_filtered ?scope ?name ?size ~filter typ =
| `Site ->
Some
(Eliom_comet.Channel.create ~scope ?name ?size
- (Lwt_stream.clone stream))
+ (Lwt_stream.clone stream)
+ )
| `Client_process _ -> None
in
let typ_list = deriving_to_list typ in
(*The service*)
let post_params =
- (Eliom_parameter.ocaml "bus_write" typ_list
- : ('a, 'aa, 'aaa) Eliom_parameter.params_type)
+ ( Eliom_parameter.ocaml "bus_write" typ_list
+ : ('a, 'aa, 'aaa) Eliom_parameter.params_type
+ )
in
let distant_write =
Eliom_service.create ?name
@@ -139,7 +146,8 @@ let create_filtered ?scope ?name ?size ~filter typ =
; service = Eliom_comet_base.Bus_send_service distant_write
; service_registered
; bus_mark = bus_mark ()
- ; size }
+ ; size
+ }
in
bus
diff --git a/src/lib/eliom_bus.server.mli b/src/lib/eliom_bus.server.mli
index 7a716f2e52..69196cefe6 100644
--- a/src/lib/eliom_bus.server.mli
+++ b/src/lib/eliom_bus.server.mli
@@ -36,7 +36,7 @@ type ('a, 'b) t
participants. *)
val create :
- ?scope:[< Eliom_comet.Channel.comet_scope]
+ ?scope:[< Eliom_comet.Channel.comet_scope]
-> ?name:string
-> ?size:int
-> 'a Deriving_Json.t
@@ -53,7 +53,7 @@ val create :
*)
val create_filtered :
- ?scope:[< Eliom_comet.Channel.comet_scope]
+ ?scope:[< Eliom_comet.Channel.comet_scope]
-> ?name:string
-> ?size:int
-> filter:('a -> 'b Lwt.t)
diff --git a/src/lib/eliom_client.client.ml b/src/lib/eliom_client.client.ml
index 7b156aca74..9cc2eeeeb7 100644
--- a/src/lib/eliom_client.client.ml
+++ b/src/lib/eliom_client.client.ml
@@ -37,24 +37,23 @@ type changepage_event =
; origin_uri : string
; target_uri : string
; origin_id : int
- ; target_id : int option }
+ ; target_id : int option
+ }
let run_lwt_callbacks : 'a -> ('a -> unit Lwt.t) list -> unit Lwt.t =
fun ev handlers -> Lwt_list.iter_s (fun h -> h ev) handlers
let (onload, _, flush_onload, _push_onload) :
- ((unit -> unit) -> unit)
- * (unit -> (unit -> unit) list)
- * (unit -> (unit -> unit) list)
- * (unit -> unit)
- =
+ ((unit -> unit) -> unit)
+ * (unit -> (unit -> unit) list)
+ * (unit -> (unit -> unit) list)
+ * (unit -> unit) =
Eliom_client_core.create_buffer ()
let ( (onchangepage : (changepage_event -> unit Lwt.t) -> unit)
, _
, (flush_onchangepage : unit -> (changepage_event -> unit Lwt.t) list)
- , _ )
- =
+ , _ ) =
Eliom_client_core.create_buffer ()
let onunload, _, flush_onunload, _ = Eliom_client_core.create_buffer ()
@@ -64,7 +63,9 @@ let onbeforeunload, run_onbeforeunload, flush_onbeforeunload =
let rec run lst =
match lst with
| [] -> None
- | f :: rem -> ( match f () with None -> run rem | Some s -> Some s)
+ | f :: rem -> (
+ match f () with None -> run rem | Some s -> Some s
+ )
in
add, (fun () -> run (get ())), flush
@@ -87,24 +88,25 @@ let check_global_data global_data =
let missing_client_values = ref [] in
let missing_injections = ref [] in
String_map.iter
- (fun compilation_unit_id
- {Eliom_client_core.server_section; client_section} ->
- List.iter
- (fun data ->
- missing_client_values :=
- List.rev_append
- (List.map
- (fun cv -> compilation_unit_id, cv)
- (Array.to_list data))
- !missing_client_values)
- server_section;
- List.iter
- (fun data ->
- missing_injections :=
- List.rev_append (Array.to_list data) !missing_injections)
- client_section)
+ (fun compilation_unit_id {Eliom_client_core.server_section; client_section}
+ ->
+ List.iter
+ (fun data ->
+ missing_client_values :=
+ List.rev_append
+ (List.map (fun cv -> compilation_unit_id, cv) (Array.to_list data))
+ !missing_client_values
+ )
+ server_section;
+ List.iter
+ (fun data ->
+ missing_injections :=
+ List.rev_append (Array.to_list data) !missing_injections
+ )
+ client_section
+ )
global_data;
- (match !missing_client_values with
+ ( match !missing_client_values with
| [] -> ()
| l ->
Printf.ksprintf
@@ -112,19 +114,24 @@ let check_global_data global_data =
"Code generating the following client values is not linked on the client:\n%s"
(String.concat "\n"
(List.rev_map
- (fun (compilation_unit_id, {Eliom_runtime.closure_id; value; _}) ->
- let instance_id =
- Eliom_runtime.Client_value_server_repr.instance_id value
- in
- match Eliom_runtime.Client_value_server_repr.loc value with
- | None ->
- Printf.sprintf "%s:%s/%d" compilation_unit_id closure_id
- instance_id
- | Some pos ->
- Printf.sprintf "%s:%s/%d at %s" compilation_unit_id
- closure_id instance_id
- (Eliom_lib.pos_to_string pos))
- l)));
+ (fun (compilation_unit_id, {Eliom_runtime.closure_id; value; _})
+ ->
+ let instance_id =
+ Eliom_runtime.Client_value_server_repr.instance_id value
+ in
+ match Eliom_runtime.Client_value_server_repr.loc value with
+ | None ->
+ Printf.sprintf "%s:%s/%d" compilation_unit_id closure_id
+ instance_id
+ | Some pos ->
+ Printf.sprintf "%s:%s/%d at %s" compilation_unit_id
+ closure_id instance_id
+ (Eliom_lib.pos_to_string pos)
+ )
+ l
+ )
+ )
+ );
match !missing_injections with
| [] -> ()
| l ->
@@ -134,20 +141,23 @@ let check_global_data global_data =
(String.concat "\n"
(List.rev_map
(fun d ->
- let id = d.Eliom_runtime.injection_id in
- match d.Eliom_runtime.injection_dbg with
- | None -> Printf.sprintf "%d" id
- | Some (pos, Some i) ->
- Printf.sprintf "%d (%s at %s)" id i
- (Eliom_lib.pos_to_string pos)
- | Some (pos, None) ->
- Printf.sprintf "%d (at %s)" id
- (Eliom_lib.pos_to_string pos))
- l))
+ let id = d.Eliom_runtime.injection_id in
+ match d.Eliom_runtime.injection_dbg with
+ | None -> Printf.sprintf "%d" id
+ | Some (pos, Some i) ->
+ Printf.sprintf "%d (%s at %s)" id i
+ (Eliom_lib.pos_to_string pos)
+ | Some (pos, None) ->
+ Printf.sprintf "%d (at %s)" id (Eliom_lib.pos_to_string pos)
+ )
+ l
+ )
+ )
let do_request_data request_data =
Logs.debug ~src:section (fun fmt ->
- fmt "Do request data (%d)" (Array.length request_data));
+ fmt "Do request data (%d)" (Array.length request_data)
+ );
(* On a request, i.e. after running the toplevel definitions, global_data
must contain at most empty sections_data lists, which stem from server-
only eliom files. *)
@@ -166,20 +176,24 @@ let get_element_cookies_info elt =
Js.Opt.to_option
(Js.Opt.map
elt##(getAttribute
- (Js.string Eliom_runtime.RawXML.ce_call_service_attrib))
- (fun s -> of_json ~typ:[%json: bool * string list] (Js.to_string s)))
+ (Js.string Eliom_runtime.RawXML.ce_call_service_attrib)
+ )
+ (fun s -> of_json ~typ:[%json: bool * string list] (Js.to_string s))
+ )
let get_element_template elt =
Js.Opt.to_option
(Js.Opt.map
elt##(getAttribute (Js.string Eliom_runtime.RawXML.ce_template_attrib))
- (fun s -> Js.to_string s))
+ (fun s -> Js.to_string s)
+ )
let a_handler =
Dom_html.full_handler (fun node ev ->
let node =
Js.Opt.get (Dom_html.CoerceTo.a node) (fun () ->
- raise_error ~section "not an anchor element")
+ raise_error ~section "not an anchor element"
+ )
in
(* We prevent default behaviour
only if raw_a_handler has taken the change page itself *)
@@ -188,15 +202,17 @@ let a_handler =
(Eliom_client_core.raw_a_handler node
(get_element_cookies_info node)
(get_element_template node)
- ev))
+ ev
+ )
+ )
let form_handler :
- (Dom_html.element Js.t, #Dom_html.event Js.t) Dom_html.event_listener
- =
+ (Dom_html.element Js.t, #Dom_html.event Js.t) Dom_html.event_listener =
Dom_html.full_handler (fun node ev ->
let form =
Js.Opt.get (Dom_html.CoerceTo.form node) (fun () ->
- raise_error ~section "not a form element")
+ raise_error ~section "not a form element"
+ )
in
let kind =
if String.lowercase_ascii (Js.to_string form##._method) = "get"
@@ -207,7 +223,9 @@ let form_handler :
(Eliom_client_core.raw_form_handler form kind
(get_element_cookies_info form)
(get_element_template node)
- ev f))
+ ev f
+ )
+ )
let relink_process_node (node : Dom_html.element Js.t) =
let id =
@@ -218,21 +236,27 @@ let relink_process_node (node : Dom_html.element Js.t) =
Js.Optdef.case
(Eliom_client_core.find_process_node id)
(fun () ->
- Logs.debug ~src:section (fun fmt ->
- fmt "Relink process node: did not find %s. Will add it."
- (Js.to_string id));
- Eliom_client_core.register_process_node id (node :> Dom.node Js.t))
+ Logs.debug ~src:section (fun fmt ->
+ fmt "Relink process node: did not find %s. Will add it."
+ (Js.to_string id)
+ );
+ Eliom_client_core.register_process_node id (node :> Dom.node Js.t)
+ )
(fun pnode ->
- Logs.debug ~src:section (fun fmt ->
- fmt "Relink process node: found %s" (Js.to_string id));
- Js.Opt.iter node##.parentNode (fun parent ->
- Dom.replaceChild parent pnode node);
- if String.sub (Js.to_bytestring id) 0 7 <> "global_"
- then (
- let childrens = Dom.list_of_nodeList pnode##.childNodes in
- List.iter (fun c -> ignore pnode##(removeChild c)) childrens;
- let childrens = Dom.list_of_nodeList node##.childNodes in
- List.iter (fun c -> ignore pnode##(appendChild c)) childrens))
+ Logs.debug ~src:section (fun fmt ->
+ fmt "Relink process node: found %s" (Js.to_string id)
+ );
+ Js.Opt.iter node##.parentNode (fun parent ->
+ Dom.replaceChild parent pnode node
+ );
+ if String.sub (Js.to_bytestring id) 0 7 <> "global_"
+ then (
+ let childrens = Dom.list_of_nodeList pnode##.childNodes in
+ List.iter (fun c -> ignore pnode##(removeChild c)) childrens;
+ let childrens = Dom.list_of_nodeList node##.childNodes in
+ List.iter (fun c -> ignore pnode##(appendChild c)) childrens
+ )
+ )
let relink_request_node (node : Dom_html.element Js.t) =
let id =
@@ -243,15 +267,20 @@ let relink_request_node (node : Dom_html.element Js.t) =
Js.Optdef.case
(Eliom_client_core.find_request_node id)
(fun () ->
- Logs.debug ~src:section (fun fmt ->
- fmt "Relink request node: did not find %s. Will add it."
- (Js.to_string id));
- Eliom_client_core.register_request_node id (node :> Dom.node Js.t))
+ Logs.debug ~src:section (fun fmt ->
+ fmt "Relink request node: did not find %s. Will add it."
+ (Js.to_string id)
+ );
+ Eliom_client_core.register_request_node id (node :> Dom.node Js.t)
+ )
(fun pnode ->
- Logs.debug ~src:section (fun fmt ->
- fmt "Relink request node: found %s" (Js.to_string id));
- Js.Opt.iter node##.parentNode (fun parent ->
- Dom.replaceChild parent pnode node))
+ Logs.debug ~src:section (fun fmt ->
+ fmt "Relink request node: found %s" (Js.to_string id)
+ );
+ Js.Opt.iter node##.parentNode (fun parent ->
+ Dom.replaceChild parent pnode node
+ )
+ )
let relink_request_nodes root =
Logs.debug ~src:section (fun fmt -> fmt "Relink request nodes");
@@ -273,14 +302,13 @@ let relink_page_but_client_values (root : Dom_html.element Js.t) =
, form_nodeList
, process_nodeList
, closure_nodeList
- , attrib_nodeList )
- =
+ , attrib_nodeList ) =
Eliommod_dom.select_nodes root
in
- Eliommod_dom.iter_nodeList a_nodeList (fun node ->
- node##.onclick := a_handler);
+ Eliommod_dom.iter_nodeList a_nodeList (fun node -> node##.onclick := a_handler);
Eliommod_dom.iter_nodeList form_nodeList (fun node ->
- node##.onsubmit := form_handler);
+ node##.onsubmit := form_handler
+ );
Eliommod_dom.iter_nodeList process_nodeList relink_process_node;
closure_nodeList, attrib_nodeList
@@ -304,7 +332,8 @@ let is_closure_attrib, get_closure_name, get_closure_id =
let n_prefix_js = Js.string n_prefix in
( (fun attr ->
attr##.value##(substring 0 v_len) = v_prefix_js
- && attr##.name##(substring 0 n_len) = n_prefix_js)
+ && attr##.name##(substring 0 n_len) = n_prefix_js
+ )
, (fun attr -> attr##.name##(substring_toEnd n_len))
, fun attr -> attr##.value##(substring_toEnd v_len) )
@@ -323,26 +352,27 @@ let relink_closure_node root onload table (node : Dom_html.element Js.t) =
if
Eliommod_dom.ancessor root node
(* if not inside a unique node replaced by an older one *)
- then onload := closure :: !onload)
+ then onload := closure :: !onload
+ )
else
Js.Unsafe.set node name
(Dom_html.handler (fun ev -> Js.bool (closure ev)))
with Not_found ->
Logs.err ~src:section (fun fmt ->
- fmt "relink_closure_node: client value %s not found" cid)
+ fmt "relink_closure_node: client value %s not found" cid
+ )
in
Eliommod_dom.iter_attrList node##.attributes aux
-let relink_closure_nodes
- (root : Dom_html.element Js.t)
- event_handlers
- closure_nodeList
- =
+let relink_closure_nodes (root : Dom_html.element Js.t) event_handlers
+ closure_nodeList =
Logs.debug ~src:section (fun fmt ->
- fmt "Relink %i closure nodes" closure_nodeList##.length);
+ fmt "Relink %i closure nodes" closure_nodeList##.length
+ );
let onload = ref [] in
Eliommod_dom.iter_nodeList closure_nodeList (fun node ->
- relink_closure_node root onload event_handlers node);
+ relink_closure_node root onload event_handlers node
+ );
fun () ->
let ev = Eliommod_dom.createEvent (Js.string "load") in
ignore (List.for_all (fun f -> f ev) (List.rev !onload))
@@ -356,7 +386,8 @@ let is_attrib_attrib, get_attrib_id =
let n_prefix_js = Js.string n_prefix in
( (fun attr ->
attr##.value##(substring 0 v_len) = v_prefix_js
- && attr##.name##(substring 0 n_len) = n_prefix_js)
+ && attr##.name##(substring 0 n_len) = n_prefix_js
+ )
, fun attr -> attr##.value##(substring_toEnd v_len) )
let relink_attrib _root table (node : Dom_html.element Js.t) =
@@ -378,9 +409,11 @@ let relink_attrib _root table (node : Dom_html.element Js.t) =
let relink_attribs (root : Dom_html.element Js.t) attribs attrib_nodeList =
Logs.debug ~src:section (fun fmt ->
- fmt "Relink %i attributes" attrib_nodeList##.length);
+ fmt "Relink %i attributes" attrib_nodeList##.length
+ );
Eliommod_dom.iter_nodeList attrib_nodeList (fun node ->
- relink_attrib root attribs node)
+ relink_attrib root attribs node
+ )
(* == Extract the request data and the request tab-cookies from a page
@@ -400,7 +433,8 @@ let load_data_script page =
| t ->
raise_error ~section
"Unable to find Eliom application data (script element expected, found %s element)"
- t)
+ t
+ )
| _ -> raise_error ~section "Unable to find Eliom application data."
in
let script = data_script##.text in
@@ -426,19 +460,22 @@ let scroll_to_fragment ?offset fragment =
| Some fragment ->
let scroll_to_element e = e##(scrollIntoView Js._true) in
let elem = Dom_html.document##(getElementById (Js.string fragment)) in
- Js.Opt.iter elem scroll_to_element)
+ Js.Opt.iter elem scroll_to_element
+ )
let with_progress_cursor : 'a Lwt.t -> 'a Lwt.t =
fun t ->
- Lwt.catch
- (fun () ->
+ Lwt.catch
+ (fun () ->
Dom_html.document##.body##.style##.cursor := Js.string "progress";
let* res = t in
Dom_html.document##.body##.style##.cursor := Js.string "auto";
- Lwt.return res)
- (fun exn ->
+ Lwt.return res
+ )
+ (fun exn ->
Dom_html.document##.body##.style##.cursor := Js.string "auto";
- Lwt.fail exn)
+ Lwt.fail exn
+ )
(* Type for partially unwrapped elt. *)
type tmp_recontent =
@@ -450,7 +487,8 @@ type tmp_recontent =
type tmp_elt =
{ (* to be unwrapped *)
tmp_elt : tmp_recontent
- ; tmp_node_id : Xml.node_id }
+ ; tmp_node_id : Xml.node_id
+ }
(******************************************************************************)
(* Register unwrappers *)
@@ -478,44 +516,52 @@ let unwrap_tyxml tmp_elt =
let elt =
let context = "unwrapping (i.e. utilize it in whatsoever form)" in
Xml.make_lazy ~id:tmp_elt.tmp_node_id
- (lazy
- (match tmp_elt.tmp_node_id with
+ ( lazy
+ ( match tmp_elt.tmp_node_id with
| Xml.ProcessId process_id as id ->
Logs.debug ~src:section (fun fmt ->
- fmt "Unwrap tyxml from ProcessId %s" process_id);
+ fmt "Unwrap tyxml from ProcessId %s" process_id
+ );
Js.Optdef.case
(Eliom_client_core.find_process_node (Js.bytestring process_id))
(fun () ->
- Logs.debug ~src:section (fun fmt -> fmt "not found");
- let xml_elt : Xml.elt = Xml.make ~id elt in
- let xml_elt =
- Eliom_content_core.Xml.set_classes_of_elt xml_elt
- in
- Eliom_client_core.register_process_node
- (Js.bytestring process_id)
- (Eliom_client_core.rebuild_node_ns `HTML5 context xml_elt);
- xml_elt)
+ Logs.debug ~src:section (fun fmt -> fmt "not found");
+ let xml_elt : Xml.elt = Xml.make ~id elt in
+ let xml_elt =
+ Eliom_content_core.Xml.set_classes_of_elt xml_elt
+ in
+ Eliom_client_core.register_process_node
+ (Js.bytestring process_id)
+ (Eliom_client_core.rebuild_node_ns `HTML5 context xml_elt);
+ xml_elt
+ )
(fun elt ->
- Logs.debug ~src:section (fun fmt -> fmt "found");
- Xml.make_dom ~id elt)
+ Logs.debug ~src:section (fun fmt -> fmt "found");
+ Xml.make_dom ~id elt
+ )
| Xml.RequestId request_id as id ->
Logs.debug ~src:section (fun fmt ->
- fmt "Unwrap tyxml from RequestId %s" request_id);
+ fmt "Unwrap tyxml from RequestId %s" request_id
+ );
Js.Optdef.case
(Eliom_client_core.find_request_node (Js.bytestring request_id))
(fun () ->
- Logs.debug ~src:section (fun fmt -> fmt "not found");
- let xml_elt : Xml.elt = Xml.make ~id elt in
- Eliom_client_core.register_request_node
- (Js.bytestring request_id)
- (Eliom_client_core.rebuild_node_ns `HTML5 context xml_elt);
- xml_elt)
+ Logs.debug ~src:section (fun fmt -> fmt "not found");
+ let xml_elt : Xml.elt = Xml.make ~id elt in
+ Eliom_client_core.register_request_node
+ (Js.bytestring request_id)
+ (Eliom_client_core.rebuild_node_ns `HTML5 context xml_elt);
+ xml_elt
+ )
(fun elt ->
- Logs.debug ~src:section (fun fmt -> fmt "found");
- Xml.make_dom ~id elt)
+ Logs.debug ~src:section (fun fmt -> fmt "found");
+ Xml.make_dom ~id elt
+ )
| Xml.NoId as id ->
Logs.debug ~src:section (fun fmt -> fmt "Unwrap tyxml from NoId");
- Xml.make ~id elt))
+ Xml.make ~id elt
+ )
+ )
in
Eliom_client_core.register_unwrapped_elt elt;
elt
@@ -531,8 +577,10 @@ let unwrap_global_data (global_data', _) =
Eliom_client_core.global_data :=
String_map.map
(fun {Eliom_runtime.server_sections_data; client_sections_data} ->
- { Eliom_client_core.server_section = Array.to_list server_sections_data
- ; client_section = Array.to_list client_sections_data })
+ { Eliom_client_core.server_section = Array.to_list server_sections_data
+ ; client_section = Array.to_list client_sections_data
+ }
+ )
global_data'
let _ =
@@ -586,7 +634,8 @@ let add_string_event_listener o e f capt : unit =
type state =
{ (* TODO store cookies_info in state... *)
template : string option
- ; position : Eliommod_dom.position }
+ ; position : Eliommod_dom.position
+ }
[@@deriving json]
[@@@warning "+39"]
@@ -599,7 +648,8 @@ let random_int =
fun () ->
let a =
Js.Unsafe.global##.crypto##(getRandomValues
- (new%js Typed_array.int16Array 2))
+ (new%js Typed_array.int16Array 2)
+ )
in
(Typed_array.unsafe_get a 0 lsl 16) lor Typed_array.unsafe_get a 1
else fun () -> truncate (4294967296. *. Js.to_float Js.math##random)
@@ -635,7 +685,8 @@ type page =
; set_page_status : ?step:React.step -> Page_status_t.t -> unit
; mutable dom : Dom_html.bodyElement Js.t option
; mutable reload_function :
- (unit -> unit -> Eliom_service.result Lwt.t) option }
+ (unit -> unit -> Eliom_service.result Lwt.t) option
+ }
let string_of_page p =
Printf.sprintf "%d/%d %s %s %d %b" p.page_unique_id p.page_id.state_index
@@ -647,7 +698,8 @@ let string_of_page p =
let set_page_status p st =
Logs.debug ~src:section_page (fun fmt ->
fmt "Set page status %d/%d: %s" p.page_unique_id p.page_id.state_index
- (Page_status_t.to_string st));
+ (Page_status_t.to_string st)
+ );
p.set_page_status st
let retire_page p =
@@ -666,30 +718,33 @@ let last_page_id = ref (-1)
let mk_page ?(state_id = next_state_id ()) ?url ?previous_page ~status () =
incr last_page_id;
Logs.debug ~src:section_page (fun fmt ->
- fmt "Create page %d/%d" !last_page_id state_id.state_index);
+ fmt "Create page %d/%d" !last_page_id state_id.state_index
+ );
let page_status, set_page_status = React.S.create status in
(* protect page_status from React.S.stop ~strong:true *)
ignore @@ React.S.map (fun _ -> ()) page_status;
{ page_unique_id = !last_page_id
; page_id = state_id
; url =
- (match url with
+ ( match url with
| Some u -> u
| None ->
fst
- (Url.split_fragment
- (Js.to_string Dom_html.window##.location##.href)))
+ (Url.split_fragment (Js.to_string Dom_html.window##.location##.href))
+ )
; page_status
; previous_page
; set_page_status
; dom = None
- ; reload_function = None }
+ ; reload_function = None
+ }
let active_page = ref @@ mk_page ~status:Active ()
let set_active_page p =
Logs.debug ~src:section_page (fun fmt ->
- fmt "Set active page %d/%d" p.page_unique_id p.page_id.state_index);
+ fmt "Set active page %d/%d" p.page_unique_id p.page_id.state_index
+ );
retire_page !active_page;
active_page := p;
set_page_status !active_page Active
@@ -723,7 +778,8 @@ module History = struct
let set h =
Logs.debug ~src:section (fun fmt ->
fmt "setting history:\n%s"
- (String.concat "\n" @@ List.map string_of_page !history));
+ (String.concat "\n" @@ List.map string_of_page !history)
+ );
history := h
in
(fun () -> !history), set
@@ -799,7 +855,8 @@ module History = struct
if !num_doms > max_num_doms
then (
p.dom <- None;
- set_page_status p Dead)
+ set_page_status p Dead
+ )
in
List.iter maybe_delete_dom pages_ordered_by_distance_from_present
end
@@ -809,10 +866,12 @@ let advance_page () =
if new_page != !active_page
then (
new_page.previous_page <- Some !active_page.page_id.state_index;
- (match History.find_by_state_index new_page.page_id.state_index with
+ ( match History.find_by_state_index new_page.page_id.state_index with
| Some _ -> ()
- | None -> History.advance new_page);
- set_active_page new_page)
+ | None -> History.advance new_page
+ );
+ set_active_page new_page
+ )
let state_key {session_id; state_index} =
Js.string (Printf.sprintf "state_history_%x_%x" session_id state_index)
@@ -822,11 +881,13 @@ let get_state state_id : state =
(Js.Optdef.case
Dom_html.window##.sessionStorage
(fun () ->
- (* We use this only when the history API is
+ (* We use this only when the history API is
available. Sessionstorage seems to be available
everywhere the history API exists. *)
- raise_error ~section "sessionStorage not available")
- (fun s -> s##(getItem (state_key state_id))))
+ raise_error ~section "sessionStorage not available"
+ )
+ (fun s -> s##(getItem (state_key state_id)))
+ )
(fun () -> raise Not_found)
(fun s -> of_json ~typ:[%json: state] (Js.to_string s))
@@ -835,12 +896,14 @@ let set_state i (v : state) =
Dom_html.window##.sessionStorage
(fun () -> ())
(fun s ->
- s##(setItem (state_key i) (Js.string (to_json ~typ:[%json: state] v))))
+ s##(setItem (state_key i) (Js.string (to_json ~typ:[%json: state] v)))
+ )
let update_state () =
set_state !active_page.page_id
{ template = Eliom_request_info.get_request_template ()
- ; position = Eliommod_dom.getDocumentScroll () }
+ ; position = Eliommod_dom.getDocumentScroll ()
+ }
let lock_request_handling = Eliom_request.lock
let unlock_request_handling = Eliom_request.unlock
@@ -884,7 +947,7 @@ let normalize_app_path p =
match List.rev p with "" :: p -> List.rev p | _ -> p
let init_client_app ~app_name ?(ssl = false) ~hostname ?(port = 80) ~site_dir ()
- =
+ =
Logs.debug (fun fmt -> fmt "Eliom_client.init_client_app called.");
Eliom_process.appl_name_r := Some app_name;
Eliom_request_info.client_app_initialised := true;
@@ -901,13 +964,15 @@ let init_client_app ~app_name ?(ssl = false) ~hostname ?(port = 80) ~site_dir ()
{ Eliom_common.cpi_ssl = ssl
; cpi_hostname = hostname
; cpi_server_port = port
- ; cpi_original_full_path = site_dir @ [""] };
+ ; cpi_original_full_path = site_dir @ [""]
+ };
Eliom_process.set_request_template None;
(* We set the tab cookie table, with the app name inside: *)
Eliom_process.set_request_cookies
(Ocsigen_cookie_map.add ~path:[] Eliom_common.appl_name_cookie_name
(Ocsigen_cookie_map.OSet (None, app_name, false))
- Ocsigen_cookie_map.empty);
+ Ocsigen_cookie_map.empty
+ );
ignore (get_global_data ())
let is_client_app () = !Eliom_common.is_client_app
@@ -930,7 +995,9 @@ let set_base_url () =
[ Js.to_string Dom_html.window##.location##.protocol
; "//"
; Js.to_string Dom_html.window##.location##.host
- ; Js.to_string Dom_html.window##.location##.pathname ])
+ ; Js.to_string Dom_html.window##.location##.pathname
+ ]
+ )
let dom_history_ready = ref false
@@ -947,40 +1014,43 @@ let dom_history_ready = ref false
server functions (see Eliom_uri). *)
let init () =
(* Initialize client app if the __eliom_server variable is defined *)
- (if
- is_client_app ()
- && Js.Optdef.test Js.Unsafe.global##.___eliom_server_
- && Js.Optdef.test Js.Unsafe.global##.___eliom_app_name_
- then
- let app_name = Js.to_string Js.Unsafe.global##.___eliom_app_name_
- and site_dir =
- Js.Optdef.case
- Js.Unsafe.global##.___eliom_path_
- (fun () -> [])
- (fun p -> normalize_app_path (Js.to_string p))
- in
- match
- Url.url_of_string (Js.to_string Js.Unsafe.global##.___eliom_server_)
- with
- | Some (Http {hu_host; hu_port; _}) ->
- init_client_app ~app_name ~ssl:false ~hostname:hu_host ~port:hu_port
- ~site_dir ()
- | Some (Https {hu_host; hu_port; _}) ->
- init_client_app ~app_name ~ssl:true ~hostname:hu_host ~port:hu_port
- ~site_dir ()
- | _ -> ());
+ ( if
+ is_client_app ()
+ && Js.Optdef.test Js.Unsafe.global##.___eliom_server_
+ && Js.Optdef.test Js.Unsafe.global##.___eliom_app_name_
+ then
+ let app_name = Js.to_string Js.Unsafe.global##.___eliom_app_name_
+ and site_dir =
+ Js.Optdef.case
+ Js.Unsafe.global##.___eliom_path_
+ (fun () -> [])
+ (fun p -> normalize_app_path (Js.to_string p))
+ in
+ match
+ Url.url_of_string (Js.to_string Js.Unsafe.global##.___eliom_server_)
+ with
+ | Some (Http {hu_host; hu_port; _}) ->
+ init_client_app ~app_name ~ssl:false ~hostname:hu_host ~port:hu_port
+ ~site_dir ()
+ | Some (Https {hu_host; hu_port; _}) ->
+ init_client_app ~app_name ~ssl:true ~hostname:hu_host ~port:hu_port
+ ~site_dir ()
+ | _ -> ()
+ );
let js_data = lazy (Eliom_request_info.get_request_data ()) in
Js.Optdef.case
Js.Unsafe.global##.___eliom_global_data_
(fun () ->
- (* Global data are in [js_data], so we unmarshal it right away. *)
- ignore (Lazy.force js_data))
+ (* Global data are in [js_data], so we unmarshal it right away. *)
+ ignore (Lazy.force js_data)
+ )
(fun global_data ->
- (* Global data are in a separate file. We should not unmarshal
+ (* Global data are in a separate file. We should not unmarshal
[js_data] right away but only once the client program has
been initialized. *)
- ignore (Eliom_unwrap.unwrap_js global_data);
- Js.Unsafe.delete Js.Unsafe.global "__eliom_global_data");
+ ignore (Eliom_unwrap.unwrap_js global_data);
+ Js.Unsafe.delete Js.Unsafe.global "__eliom_global_data"
+ );
(* *)
(* The first time we load the page, we record the initial URL in a client
side ref, in order to set (on client-side) in header for each
@@ -1000,11 +1070,12 @@ let init () =
let onload _ev =
let js_data = Lazy.force js_data in
Logs.debug ~src:section (fun fmt -> fmt "onload (client main)");
- (match !onload_handler with
+ ( match !onload_handler with
| Some h ->
Dom.removeEventListener h;
onload_handler := None
- | None -> ());
+ | None -> ()
+ );
Eliom_client_core.set_initial_load ();
Lwt.async (fun () ->
if !Eliom_config.debug_timings
@@ -1013,7 +1084,8 @@ let init () =
Eliom_request_info.set_session_info
~uri:
(String.concat "/"
- (Eliom_request_info.get_csp_original_full_path ()))
+ (Eliom_request_info.get_csp_original_full_path ())
+ )
js_data.Eliom_common.ejs_sess_info
@@ fun () -> Lwt.return_unit
in
@@ -1048,7 +1120,8 @@ let init () =
run_callbacks load_callbacks;
if !Eliom_config.debug_timings
then Console.console##(timeEnd (Js.string "onload"));
- Lwt.return_unit);
+ Lwt.return_unit
+ );
Js._false
in
Logs.debug ~src:section (fun fmt -> fmt "Set load/onload events");
@@ -1062,31 +1135,22 @@ let init () =
onload_handler :=
Some
(Dom.addEventListener Dom_html.window (Dom.Event.make "load")
- (Dom.handler onload) Js._true);
+ (Dom.handler onload) Js._true
+ );
add_string_event_listener Dom_html.window "beforeunload" onbeforeunload_fun
false;
ignore
(Dom.addEventListener Dom_html.window (Dom.Event.make "unload")
(Dom_html.handler onunload_fun)
- Js._false)
+ Js._false
+ )
(* == Low-level: call service. *)
-let create_request__
- ?absolute
- ?absolute_path
- ?https
- (type m)
- ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t)
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- get_params
- post_params
- =
+let create_request__ ?absolute ?absolute_path ?https (type m)
+ ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t) ?hostname
+ ?port ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params get_params
+ post_params =
let path, get_params, fragment, post_params =
Eliom_uri.make_post_uri_components__ ?absolute ?absolute_path ?https
~service ?hostname ?port ?fragment ?keep_nl_params ?nl_params
@@ -1097,21 +1161,10 @@ let create_request__
in
uri, get_params, post_params
-let create_request_
- (type m)
- ?absolute
- ?absolute_path
- ?https
- ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t)
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- get_params
- post_params
- =
+let create_request_ (type m) ?absolute ?absolute_path ?https
+ ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t) ?hostname
+ ?port ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params get_params
+ post_params =
(* TODO: allow get_get_or_post service to return also the service
with the correct subtype. Then do use Eliom_uri.make_string_uri
and Eliom_uri.make_post_uri_components instead of
@@ -1129,35 +1182,24 @@ let create_request_
`Post
(create_request__ ?absolute ?absolute_path ?https ~service ?hostname
?port ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params
- get_params post_params)
+ get_params post_params
+ )
| Eliom_service.Put' ->
`Put
(create_request__ ?absolute ?absolute_path ?https ~service ?hostname
?port ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params
- get_params post_params)
+ get_params post_params
+ )
| Eliom_service.Delete' ->
`Delete
(create_request__ ?absolute ?absolute_path ?https ~service ?hostname
?port ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params
- get_params post_params)
-
-let raw_call_service
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- ?progress
- ?upload_progress
- ?override_mime_type
- get_params
- post_params
- =
+ get_params post_params
+ )
+
+let raw_call_service ?absolute ?absolute_path ?https ~service ?hostname ?port
+ ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params ?progress
+ ?upload_progress ?override_mime_type get_params post_params =
(* with_credentials = true is necessary for client side apps when
we want the Eliom server to be different from the server for
static files (if any). For example when testing a mobile app
@@ -1196,23 +1238,9 @@ let raw_call_service
| None -> Lwt.fail (Eliom_request.Failed_request 204)
| Some content -> Lwt.return (uri, content)
-let call_service
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- ?progress
- ?upload_progress
- ?override_mime_type
- get_params
- post_params
- =
+let call_service ?absolute ?absolute_path ?https ~service ?hostname ?port
+ ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params ?progress
+ ?upload_progress ?override_mime_type get_params post_params =
let* _, content =
raw_call_service ?absolute ?absolute_path ?https ~service ?hostname ?port
?fragment ?keep_nl_params ?nl_params ?keep_get_na_params ?progress
@@ -1222,22 +1250,9 @@ let call_service
(* == Leave an application. *)
-let exit_to
- ?window_name
- ?window_features
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- get_params
- post_params
- =
+let exit_to ?window_name ?window_features ?absolute ?absolute_path ?https
+ ~service ?hostname ?port ?fragment ?keep_nl_params ?nl_params
+ ?keep_get_na_params get_params post_params =
match
create_request_ ?absolute ?absolute_path ?https ~service ?hostname ?port
?fragment ?keep_nl_params ?nl_params ?keep_get_na_params get_params
@@ -1252,28 +1267,17 @@ let exit_to
| `Delete (uri, _, post_params) ->
Eliom_request.redirect_delete ?window_name uri post_params
-let window_open
- ~window_name
- ?window_features
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- get_params
- =
+let window_open ~window_name ?window_features ?absolute ?absolute_path ?https
+ ~service ?hostname ?port ?fragment ?keep_nl_params ?nl_params
+ ?keep_get_na_params get_params =
match
create_request_ ?absolute ?absolute_path ?https ~service ?hostname ?port
?fragment ?keep_nl_params ?nl_params ?keep_get_na_params get_params ()
with
| `Get (uri, _) ->
Dom_html.window##(open_ (Js.string uri) window_name
- (Js.Opt.option window_features))
+ (Js.Opt.option window_features)
+ )
| `Post (_, _, _) -> assert false
| `Put (_, _, _) -> assert false
| `Delete (_, _, _) -> assert false
@@ -1290,23 +1294,9 @@ let unwrap_caml_content content =
in
Lwt.return (r.Eliom_runtime.ecs_data, r.Eliom_runtime.ecs_request_data)
-let call_ocaml_service
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- ?keep_get_na_params
- ?progress
- ?upload_progress
- ?override_mime_type
- get_params
- post_params
- =
+let call_ocaml_service ?absolute ?absolute_path ?https ~service ?hostname ?port
+ ?fragment ?keep_nl_params ?nl_params ?keep_get_na_params ?progress
+ ?upload_progress ?override_mime_type get_params post_params =
Logs.debug ~src:section (fun fmt -> fmt "Call OCaml service");
let* _, content =
raw_call_service ?absolute ?absolute_path ?https ~service ?hostname ?port
@@ -1344,7 +1334,8 @@ let path_and_args_of_uri uri =
| Some n ->
( path_of_string String.(sub uri 0 n)
, Url.decode_arguments String.(sub uri (n + 1) (length uri - n - 1)) )
- | None -> path_of_string uri, [])
+ | None -> path_of_string uri, []
+ )
let set_current_uri, get_current_uri =
let set_current_uri uri =
@@ -1353,7 +1344,8 @@ let set_current_uri, get_current_uri =
let path, all_get_params = path_and_args_of_uri current_uri in
Lwt.async @@ fun () ->
Eliom_request_info.update_session_info ~path ~all_get_params
- ~all_post_params:None (fun () -> Lwt.return_unit)
+ ~all_post_params:None (fun () -> Lwt.return_unit
+ )
in
let get_current_uri () = (get_this_page ()).url in
set_current_uri, get_current_uri
@@ -1384,7 +1376,8 @@ let push_history_dom () =
else Dom_html.document##.documentElement
in
page.dom <- Some dom;
- History.garbage_collect_doms ())
+ History.garbage_collect_doms ()
+ )
module Page_status = struct
include Page_status_t
@@ -1423,7 +1416,8 @@ module Page_status = struct
if now && React.S.value (signal ()) = Active
then (
action ();
- if not once then on_event ())
+ if not once then on_event ()
+ )
else on_event ()
let oncached ?(once = false) ?stop action =
@@ -1455,7 +1449,8 @@ let stash_reload_function f =
let state_id = page.page_id in
let id = state_id.state_index in
Logs.debug ~src:section_page (fun fmt ->
- fmt "Update reload function for page %d" id);
+ fmt "Update reload function for page %d" id
+ );
page.reload_function <- Some f
let change_url_string ~replace uri =
@@ -1471,46 +1466,45 @@ let change_url_string ~replace uri =
Dom_html.window##.history##replaceState
(Js.Opt.return
(Js.string
- (to_json ~typ:[%json: saved_state] (this_page.page_id, full_uri))))
+ (to_json ~typ:[%json: saved_state] (this_page.page_id, full_uri))
+ )
+ )
(Js.string "")
- (if !Eliom_common.is_client_app
- then Js.null
- else Js.Opt.return (Js.string uri)))
+ ( if !Eliom_common.is_client_app
+ then Js.null
+ else Js.Opt.return (Js.string uri)
+ )
+ )
else (
update_state ();
Opt.iter stash_reload_function !reload_function;
Dom_html.window##.history##pushState
(Js.Opt.return
(Js.string
- (to_json ~typ:[%json: saved_state] (this_page.page_id, full_uri))))
+ (to_json ~typ:[%json: saved_state] (this_page.page_id, full_uri))
+ )
+ )
(Js.string "")
- (if !Eliom_common.is_client_app
- then Js.null
- else Js.Opt.return (Js.string uri)));
- Eliommod_dom.touch_base ())
+ ( if !Eliom_common.is_client_app
+ then Js.null
+ else Js.Opt.return (Js.string uri)
+ )
+ );
+ Eliommod_dom.touch_base ()
+ )
else (
current_pseudo_fragment := url_fragment_prefix_with_sharp ^ uri;
if uri <> fst (Url.split_fragment Url.Current.as_string)
then
- Dom_html.window##.location##.hash := Js.string (url_fragment_prefix ^ uri))
+ Dom_html.window##.location##.hash := Js.string (url_fragment_prefix ^ uri)
+ )
(* == Function [change_url] changes the URL, without doing a request.
It takes a GET (co-)service as parameter and its parameters.
*)
-let change_url
- ?(replace = false)
- ?absolute
- ?absolute_path
- ?https
- ~service
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?nl_params
- params
- =
+let change_url ?(replace = false) ?absolute ?absolute_path ?https ~service
+ ?hostname ?port ?fragment ?keep_nl_params ?nl_params params =
Logs.debug ~src:section_page (fun fmt -> fmt "Change url");
(reload_function :=
match Eliom_service.xhr_with_cookies service with
@@ -1523,17 +1517,21 @@ let change_url
| _ -> (
match Eliom_service.reload_fun service with
| Some rf -> Some (fun () () -> rf params ())
- | None -> None));
+ | None -> None
+ )
+ );
change_url_string ~replace
(Eliom_uri.make_string_uri ?absolute ?absolute_path ?https ~service
- ?hostname ?port ?fragment ?keep_nl_params ?nl_params params)
+ ?hostname ?port ?fragment ?keep_nl_params ?nl_params params
+ )
let set_template_content ~replace ~uri ?fragment =
let really_set content () =
reload_function := None;
- (match fragment with
+ ( match fragment with
| None -> change_url_string ~replace uri
- | Some fragment -> change_url_string ~replace (uri ^ "#" ^ fragment));
+ | Some fragment -> change_url_string ~replace (uri ^ "#" ^ fragment)
+ );
let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
let* (), request_data = unwrap_caml_content content in
do_request_data request_data;
@@ -1544,8 +1542,8 @@ let set_template_content ~replace ~uri ?fragment =
Lwt.return_unit
and cancel () = Lwt.return_unit in
function
- | None -> Lwt.return_unit
- | Some content -> run_onunload_wrapper (really_set content) cancel
+ | None -> Lwt.return_unit
+ | Some content -> run_onunload_wrapper (really_set content) cancel
let set_uri ~replace ?fragment uri =
(* Changing url: *)
@@ -1562,14 +1560,16 @@ let replace_page ~do_insert_base new_page =
Js.Opt.iter new_body (fun new_body ->
Dom.replaceChild
Dom_html.document##.documentElement
- new_body Dom_html.document##.body)
+ new_body Dom_html.document##.body
+ )
else (
(* We insert in the page.
The URLs of all other pages will be computed w.r.t.
the base URL. *)
if do_insert_base then insert_base new_page;
Dom.replaceChild Dom_html.document new_page
- Dom_html.document##.documentElement);
+ Dom_html.document##.documentElement
+ );
if !Eliom_config.debug_timings
then Console.console##(timeEnd (Js.string "replace_page"))
@@ -1602,7 +1602,8 @@ let set_content_local ?offset ?fragment new_page =
locked := false;
Lwt_mutex.unlock Eliom_client_core.load_mutex;
(* run callbacks upon page activation (or now), but just once *)
- Page_status.onactive ~once:true (fun () -> run_callbacks load_callbacks);
+ Page_status.onactive ~once:true (fun () -> run_callbacks load_callbacks
+ );
scroll_to_fragment ?offset fragment;
advance_page ();
if !Eliom_config.debug_timings
@@ -1612,16 +1613,19 @@ let set_content_local ?offset ?fragment new_page =
let cancel () = recover (); Lwt.return_unit in
Lwt.catch
(fun () ->
- let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
- Eliom_client_core.set_loading_phase ();
- if !Eliom_config.debug_timings
- then Console.console##(time (Js.string "set_content_local"));
- run_onunload_wrapper really_set cancel)
+ let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
+ Eliom_client_core.set_loading_phase ();
+ if !Eliom_config.debug_timings
+ then Console.console##(time (Js.string "set_content_local"));
+ run_onunload_wrapper really_set cancel
+ )
(fun exn ->
- recover ();
- Logs.debug ~src:section (fun fmt ->
- fmt ("set_content_local" ^^ "@\n%s") (Printexc.to_string exn));
- Lwt.fail exn)
+ recover ();
+ Logs.debug ~src:section (fun fmt ->
+ fmt ("set_content_local" ^^ "@\n%s") (Printexc.to_string exn)
+ );
+ Lwt.fail exn
+ )
(* Function to be called for server side services: *)
let set_content ~replace ~uri ?offset ?fragment content =
@@ -1634,7 +1638,8 @@ let set_content ~replace ~uri ?offset ?fragment content =
; origin_uri = get_current_uri ()
; target_uri
; origin_id = !active_page.page_id.state_index
- ; target_id = None }
+ ; target_id = None
+ }
(flush_onchangepage ())
in
match content with
@@ -1725,17 +1730,20 @@ let set_content ~replace ~uri ?offset ?fragment content =
in
Lwt.catch
(fun () ->
- let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
- Eliom_client_core.set_loading_phase ();
- if !Eliom_config.debug_timings
- then Console.console##(time (Js.string "set_content"));
- let g () = recover (); Lwt.return_unit in
- run_onunload_wrapper really_set g)
+ let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
+ Eliom_client_core.set_loading_phase ();
+ if !Eliom_config.debug_timings
+ then Console.console##(time (Js.string "set_content"));
+ let g () = recover (); Lwt.return_unit in
+ run_onunload_wrapper really_set g
+ )
(fun exn ->
- recover ();
- Logs.debug ~src:section (fun fmt ->
- fmt ("set_content" ^^ "@\n%s") (Printexc.to_string exn));
- Lwt.fail exn)
+ recover ();
+ Logs.debug ~src:section (fun fmt ->
+ fmt ("set_content" ^^ "@\n%s") (Printexc.to_string exn)
+ );
+ Lwt.fail exn
+ )
let ocamlify_params =
List.map (function v, `String s -> v, Js.to_string s | _, _ -> assert false)
@@ -1772,7 +1780,8 @@ let route ({Eliom_route.i_subpath; i_get_params; i_post_params; _} as info) =
Eliom_route.call_service
{ info with
Eliom_route.i_get_params =
- Eliom_common.(remove_prefixed_param nl_param_prefix) i_get_params }
+ Eliom_common.(remove_prefixed_param nl_param_prefix) i_get_params
+ }
in
Lwt.return (uri, result)
@@ -1798,7 +1807,8 @@ let string_of_result result =
let rec handle_result ~replace ~uri result =
let* result = result in
Logs.debug ~src:section_page (fun fmt ->
- fmt "%s" ("handle_result: result is " ^ string_of_result result));
+ fmt "%s" ("handle_result: result is " ^ string_of_result result)
+ );
match result with
| Eliom_service.No_contents -> Lwt.return_unit
| Dom d ->
@@ -1818,23 +1828,24 @@ let rec handle_result ~replace ~uri result =
reload ~replace ~uri ~fallback:Eliom_service.reload_action_hidden
| true, true ->
switch_to_https ();
- reload ~replace ~uri ~fallback:Eliom_service.reload_action_https_hidden)
+ reload ~replace ~uri ~fallback:Eliom_service.reload_action_https_hidden
+ )
(* == Main (exported) function: change the content of the page without
leaving the javascript application. See [change_page_uri] for the
function used to change page when clicking a link and
[change_page_{get,post}_form] when submiting a form. *)
and change_page :
- 'get 'post 'meth 'attached 'co 'ext 'reg 'tipo 'gn 'pn.
- ?ignore_client_fun:bool
- -> ?replace:bool
- -> ?window_name:string
- -> ?window_features:string
- -> ?absolute:bool
- -> ?absolute_path:bool
- -> ?https:bool
- -> service:
- ( 'get
+ 'get 'post 'meth 'attached 'co 'ext 'reg 'tipo 'gn 'pn.
+ ?ignore_client_fun:bool
+ -> ?replace:bool
+ -> ?window_name:string
+ -> ?window_features:string
+ -> ?absolute:bool
+ -> ?absolute_path:bool
+ -> ?https:bool
+ -> service:
+ ( 'get
, 'post
, 'meth
, 'attached
@@ -1844,161 +1855,151 @@ and change_page :
, 'tipo
, 'gn
, 'pn
- , Eliom_service.non_ocaml )
+ , Eliom_service.non_ocaml
+ )
Eliom_service.t
- -> ?hostname:string
- -> ?port:int
- -> ?fragment:string
- -> ?keep_nl_params:[`All | `None | `Persistent]
- -> ?nl_params:Eliom_parameter.nl_params_set
- -> ?keep_get_na_params:bool
- -> ?progress:(int -> int -> unit)
- -> ?upload_progress:(int -> int -> unit)
- -> ?override_mime_type:string
- -> 'get
- -> 'post
- -> unit Lwt.t
- =
- fun (type m)
- ?(ignore_client_fun = false)
- ?(replace = false)
- ?window_name
- ?window_features
- ?absolute
- ?absolute_path
- ?https
- ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t)
- ?hostname
- ?port
- ?fragment
- ?keep_nl_params
- ?(nl_params = Eliom_parameter.empty_nl_params_set)
- ?keep_get_na_params
- ?progress
- ?upload_progress
- ?override_mime_type
- get_params
- post_params ->
- Logs.debug ~src:section_page (fun fmt -> fmt "Change page");
- let xhr = Eliom_service.xhr_with_cookies service in
- if
- xhr = None
- || (https = Some true && not Eliom_request_info.ssl_)
- || (https = Some false && Eliom_request_info.ssl_)
- || (window_name <> None && window_name <> Some "_self")
- then
- let () =
- Logs.debug ~src:section_page (fun fmt -> fmt "change page: xhr is None")
- in
- Lwt.return
- (exit_to ?window_name ?window_features ?absolute ?absolute_path ?https
- ~service ?hostname ?port ?fragment ?keep_nl_params ~nl_params
- ?keep_get_na_params get_params post_params)
- else
- with_progress_cursor
- (match xhr with
- | Some (Some tmpl as t)
- when t = Eliom_request_info.get_request_template () ->
- Logs.debug ~src:section_page (fun fmt ->
- fmt "change page: xhr is Some of get request template");
- let nl_params =
- Eliom_parameter.add_nl_parameter nl_params Eliom_request.nl_template
- tmpl
- in
- let* uri, content =
- raw_call_service ?absolute ?absolute_path ?https ~service ?hostname
- ?port ?fragment ?keep_nl_params ~nl_params ?keep_get_na_params
- ?progress ?upload_progress ?override_mime_type get_params
- post_params
- in
- set_template_content ~replace ~uri ?fragment (Some content)
- | _ -> (
- match Eliom_service.client_fun service with
- | Some f when not ignore_client_fun ->
- Logs.debug ~src:section_page (fun fmt ->
- fmt
- "change page: client_fun service is Some and (not ignore_client_fun)");
- (* The service has a client side implementation.
+ -> ?hostname:string
+ -> ?port:int
+ -> ?fragment:string
+ -> ?keep_nl_params:[`All | `None | `Persistent]
+ -> ?nl_params:Eliom_parameter.nl_params_set
+ -> ?keep_get_na_params:bool
+ -> ?progress:(int -> int -> unit)
+ -> ?upload_progress:(int -> int -> unit)
+ -> ?override_mime_type:string
+ -> 'get
+ -> 'post
+ -> unit Lwt.t =
+ fun (type m) ?(ignore_client_fun = false) ?(replace = false) ?window_name
+ ?window_features ?absolute ?absolute_path ?https
+ ~(service : (_, _, m, _, _, _, _, _, _, _, _) Eliom_service.t) ?hostname
+ ?port ?fragment ?keep_nl_params
+ ?(nl_params = Eliom_parameter.empty_nl_params_set) ?keep_get_na_params
+ ?progress ?upload_progress ?override_mime_type get_params post_params ->
+ Logs.debug ~src:section_page (fun fmt -> fmt "Change page");
+ let xhr = Eliom_service.xhr_with_cookies service in
+ if
+ xhr = None
+ || (https = Some true && not Eliom_request_info.ssl_)
+ || (https = Some false && Eliom_request_info.ssl_)
+ || (window_name <> None && window_name <> Some "_self")
+ then
+ let () =
+ Logs.debug ~src:section_page (fun fmt -> fmt "change page: xhr is None")
+ in
+ Lwt.return
+ (exit_to ?window_name ?window_features ?absolute ?absolute_path ?https
+ ~service ?hostname ?port ?fragment ?keep_nl_params ~nl_params
+ ?keep_get_na_params get_params post_params
+ )
+ else
+ with_progress_cursor
+ ( match xhr with
+ | Some (Some tmpl as t)
+ when t = Eliom_request_info.get_request_template () ->
+ Logs.debug ~src:section_page (fun fmt ->
+ fmt "change page: xhr is Some of get request template"
+ );
+ let nl_params =
+ Eliom_parameter.add_nl_parameter nl_params
+ Eliom_request.nl_template tmpl
+ in
+ let* uri, content =
+ raw_call_service ?absolute ?absolute_path ?https ~service ?hostname
+ ?port ?fragment ?keep_nl_params ~nl_params ?keep_get_na_params
+ ?progress ?upload_progress ?override_mime_type get_params
+ post_params
+ in
+ set_template_content ~replace ~uri ?fragment (Some content)
+ | _ -> (
+ match Eliom_service.client_fun service with
+ | Some f when not ignore_client_fun ->
+ Logs.debug ~src:section_page (fun fmt ->
+ fmt
+ "change page: client_fun service is Some and (not ignore_client_fun)"
+ );
+ (* The service has a client side implementation.
We do not make the request *)
- (* I record the function to be used for void coservices: *)
- Eliom_lib.Option.iter
- (fun rf -> reload_function := Some (fun () -> rf get_params))
- (Eliom_service.reload_fun service);
- let uri, l, l' =
- match
- create_request_ ~absolute:true ?absolute_path ?https ~service
- ?hostname ?port ?fragment ?keep_nl_params ~nl_params
- ?keep_get_na_params get_params post_params
- with
- | `Get (uri, l) -> uri, l, None
- | `Post (uri, l, l') | `Put (uri, l, l') | `Delete (uri, l, l') ->
- uri, l, Some (ocamlify_params l')
- in
- let l = ocamlify_params l in
- Eliom_request_info.update_session_info
- ~path:(Url.path_of_url_string uri)
- ~all_get_params:l ~all_post_params:l'
- @@ fun () ->
- let* () =
- run_lwt_callbacks
- { in_cache = is_in_cache !active_page.page_id
- ; origin_uri = get_current_uri ()
- ; target_uri = uri
- ; origin_id = !active_page.page_id.state_index
- ; target_id = None }
- (flush_onchangepage ())
- in
- with_new_page ~replace () @@ fun () ->
- handle_result ~replace ~uri (f get_params post_params)
- | None when is_client_app () ->
- Logs.debug ~src:section_page (fun fmt ->
- fmt "change page: client_fun service is None and is_client_app");
- Lwt.return
- @@ exit_to ?absolute ?absolute_path ?https ~service ?hostname ?port
- ?fragment ?keep_nl_params ~nl_params ?keep_get_na_params
- get_params post_params
- | _ ->
- Logs.debug ~src:section_page (fun fmt ->
- fmt "change page: client_fun service is anything else");
- if is_client_app ()
- then
- failwith
- (Printf.sprintf "change page: no client-side service (%b)"
- ignore_client_fun);
- (* No client-side implementation *)
- with_new_page ~replace () @@ fun () ->
- reload_function := None;
- let cookies_info = Eliom_uri.make_cookies_info (https, service) in
- let* uri, content =
- match
- create_request_ ?absolute ?absolute_path ?https ~service
- ?hostname ?port ?fragment ?keep_nl_params ~nl_params
- ?keep_get_na_params get_params post_params
- with
- | `Get (uri, _) ->
- Eliom_request.http_get ~expecting_process_page:true
- ?cookies_info uri [] Eliom_request.xml_result
- | `Post (uri, _, p) ->
- Eliom_request.http_post ~expecting_process_page:true
- ?cookies_info uri p Eliom_request.xml_result
- | `Put (uri, _, p) ->
- Eliom_request.http_put ~expecting_process_page:true
- ?cookies_info uri p Eliom_request.xml_result
- | `Delete (uri, _, p) ->
- Eliom_request.http_delete ~expecting_process_page:true
- ?cookies_info uri p Eliom_request.xml_result
- in
- let uri, fragment = Url.split_fragment uri in
- set_content ~replace ~uri ?fragment content))
-
-and change_page_unknown
- ?meth
- ?hostname:_
- ?(replace = false)
- i_subpath
- i_get_params
- i_post_params
- =
+ (* I record the function to be used for void coservices: *)
+ Eliom_lib.Option.iter
+ (fun rf -> reload_function := Some (fun () -> rf get_params))
+ (Eliom_service.reload_fun service);
+ let uri, l, l' =
+ match
+ create_request_ ~absolute:true ?absolute_path ?https ~service
+ ?hostname ?port ?fragment ?keep_nl_params ~nl_params
+ ?keep_get_na_params get_params post_params
+ with
+ | `Get (uri, l) -> uri, l, None
+ | `Post (uri, l, l') | `Put (uri, l, l') | `Delete (uri, l, l')
+ ->
+ uri, l, Some (ocamlify_params l')
+ in
+ let l = ocamlify_params l in
+ Eliom_request_info.update_session_info
+ ~path:(Url.path_of_url_string uri)
+ ~all_get_params:l ~all_post_params:l'
+ @@ fun () ->
+ let* () =
+ run_lwt_callbacks
+ { in_cache = is_in_cache !active_page.page_id
+ ; origin_uri = get_current_uri ()
+ ; target_uri = uri
+ ; origin_id = !active_page.page_id.state_index
+ ; target_id = None
+ }
+ (flush_onchangepage ())
+ in
+ with_new_page ~replace () @@ fun () ->
+ handle_result ~replace ~uri (f get_params post_params)
+ | None when is_client_app () ->
+ Logs.debug ~src:section_page (fun fmt ->
+ fmt "change page: client_fun service is None and is_client_app"
+ );
+ Lwt.return
+ @@ exit_to ?absolute ?absolute_path ?https ~service ?hostname ?port
+ ?fragment ?keep_nl_params ~nl_params ?keep_get_na_params
+ get_params post_params
+ | _ ->
+ Logs.debug ~src:section_page (fun fmt ->
+ fmt "change page: client_fun service is anything else"
+ );
+ if is_client_app ()
+ then
+ failwith
+ (Printf.sprintf "change page: no client-side service (%b)"
+ ignore_client_fun
+ );
+ (* No client-side implementation *)
+ with_new_page ~replace () @@ fun () ->
+ reload_function := None;
+ let cookies_info = Eliom_uri.make_cookies_info (https, service) in
+ let* uri, content =
+ match
+ create_request_ ?absolute ?absolute_path ?https ~service
+ ?hostname ?port ?fragment ?keep_nl_params ~nl_params
+ ?keep_get_na_params get_params post_params
+ with
+ | `Get (uri, _) ->
+ Eliom_request.http_get ~expecting_process_page:true
+ ?cookies_info uri [] Eliom_request.xml_result
+ | `Post (uri, _, p) ->
+ Eliom_request.http_post ~expecting_process_page:true
+ ?cookies_info uri p Eliom_request.xml_result
+ | `Put (uri, _, p) ->
+ Eliom_request.http_put ~expecting_process_page:true
+ ?cookies_info uri p Eliom_request.xml_result
+ | `Delete (uri, _, p) ->
+ Eliom_request.http_delete ~expecting_process_page:true
+ ?cookies_info uri p Eliom_request.xml_result
+ in
+ let uri, fragment = Url.split_fragment uri in
+ set_content ~replace ~uri ?fragment content
+ )
+ )
+
+and change_page_unknown ?meth ?hostname:_ ?(replace = false) i_subpath
+ i_get_params i_post_params =
Logs.debug ~src:section_page (fun fmt -> fmt "Change page unknown");
let i_sess_info = Eliom_request_info.get_sess_info ()
and i_meth =
@@ -2021,7 +2022,8 @@ and reload ~replace ~uri ~fallback =
Lwt.catch
(fun () -> change_page_unknown ~replace path args [])
(fun _ ->
- change_page ~replace ~ignore_client_fun:true ~service:fallback () ())
+ change_page ~replace ~ignore_client_fun:true ~service:fallback () ()
+ )
and reload_without_na_params ~replace ~uri ~fallback =
let path, args = path_and_args_of_uri uri in
@@ -2030,7 +2032,8 @@ and reload_without_na_params ~replace ~uri ~fallback =
Lwt.catch
(fun () -> change_page_unknown ~replace path args [])
(fun _ ->
- change_page ~replace ~ignore_client_fun:true ~service:fallback () ())
+ change_page ~replace ~ignore_client_fun:true ~service:fallback () ()
+ )
(* Function used in "onclick" event handler of . *)
let change_page_uri_a ?cookies_info ?tmpl ?(get_params = []) full_uri =
@@ -2054,31 +2057,39 @@ let change_page_uri_a ?cookies_info ?tmpl ?(get_params = []) full_uri =
Eliom_request.http_get ~expecting_process_page:true ?cookies_info
uri get_params Eliom_request.xml_result
in
- set_content ~replace:false ~uri ?fragment content)
+ set_content ~replace:false ~uri ?fragment content
+ )
else (
change_url_string ~replace:true full_uri;
scroll_to_fragment fragment;
- Lwt.return_unit))
+ Lwt.return_unit
+ )
+ )
let change_page_uri ?replace full_uri =
Logs.debug ~src:section_page (fun fmt -> fmt "Change page uri");
Lwt.catch
(fun () ->
- match Url.url_of_string full_uri with
- | Some (Url.Http url | Url.Https url) ->
- Logs.debug ~src:section_page (fun fmt ->
- fmt "change page uri: url is http or https");
- change_page_unknown ?replace url.Url.hu_path url.Url.hu_arguments []
- | _ -> failwith "invalid url")
+ match Url.url_of_string full_uri with
+ | Some (Url.Http url | Url.Https url) ->
+ Logs.debug ~src:section_page (fun fmt ->
+ fmt "change page uri: url is http or https"
+ );
+ change_page_unknown ?replace url.Url.hu_path url.Url.hu_arguments []
+ | _ -> failwith "invalid url"
+ )
(fun _ ->
- if is_client_app ()
- then
- failwith
- (Printf.sprintf "Change page uri: can't find service for %s" full_uri)
- else (
- Logs.debug ~src:section (fun fmt ->
- fmt "Change page uri: resort to server");
- change_page_uri_a full_uri))
+ if is_client_app ()
+ then
+ failwith
+ (Printf.sprintf "Change page uri: can't find service for %s" full_uri)
+ else (
+ Logs.debug ~src:section (fun fmt ->
+ fmt "Change page uri: resort to server"
+ );
+ change_page_uri_a full_uri
+ )
+ )
(* Functions used in "onsubmit" event handler of