Merge pull request #813 from kit-ty-kate/ocaml-5.3

Add support for OCaml 5.3

Author: smorimoto

.github/workflows/workflow.yml

@@ -18,8 +18,8 @@ jobs:
           - macos-latest
           - ubuntu-latest
         ocaml-compiler:
-          - "4.14"
-          - "5.2"
+          - 5
+          - 4
 
     runs-on: ${{ matrix.os }}
 
@@ -46,7 +46,7 @@ jobs:
       - name: Set-up OCaml
         uses: ocaml/setup-ocaml@v3
         with:
-          ocaml-compiler: "4.14"
+          ocaml-compiler: 4
           dune-cache: true
 
       - uses: ocaml/setup-ocaml/lint-fmt@v3

dune-project

@@ -22,17 +22,17 @@ The client-side code is compiled to JS using Ocsigen Js_of_ocaml or to Wasm usin
  (homepage https://ocsigen.org/eliom/)
  (source (github ocsigen/eliom))
  (depends
-  (ocaml (and (>= 4.12) (< 5.3)))
+  (ocaml (>= 4.12))
   ocamlfind
   ppx_deriving
   (ppxlib (>= 0.15))
-  (js_of_ocaml-compiler (and (>= 5.5) (< 6.0)))
-  (js_of_ocaml (>= 5.5))
-  (js_of_ocaml-lwt (>= 5.5))
+  (js_of_ocaml-compiler (>= 6.0))
+  (js_of_ocaml (>= 6.0))
+  (js_of_ocaml-lwt (>= 6.0))
   (js_of_ocaml-ocamlbuild :build)
-  (js_of_ocaml-ppx (>= 5.5))
-  (js_of_ocaml-ppx_deriving_json (>= 5.5))
-  (js_of_ocaml-tyxml (>= 5.5))
+  (js_of_ocaml-ppx (>= 6.0))
+  (js_of_ocaml-ppx_deriving_json (>= 6.0))
+  (js_of_ocaml-tyxml (>= 6.0))
   lwt_log
   (tyxml (and (>= 4.6) (< 4.7)))
   (ocsigenserver (and (>= 6.0) (< 7.0)))

eliom.opam

@@ -18,17 +18,17 @@ homepage: "https://ocsigen.org/eliom/"
 bug-reports: "https://github.com/ocsigen/eliom/issues"
 depends: [
   "dune" {>= "3.18"}
-  "ocaml" {>= "4.12" & < "5.3"}
+  "ocaml" {>= "4.12"}
   "ocamlfind"
   "ppx_deriving"
   "ppxlib" {>= "0.15"}
-  "js_of_ocaml-compiler" {>= "5.5" & < "6.0"}
-  "js_of_ocaml" {>= "5.5"}
-  "js_of_ocaml-lwt" {>= "5.5"}
+  "js_of_ocaml-compiler" {>= "6.0"}
+  "js_of_ocaml" {>= "6.0"}
+  "js_of_ocaml-lwt" {>= "6.0"}
   "js_of_ocaml-ocamlbuild" {build}
-  "js_of_ocaml-ppx" {>= "5.5"}
-  "js_of_ocaml-ppx_deriving_json" {>= "5.5"}
-  "js_of_ocaml-tyxml" {>= "5.5"}
+  "js_of_ocaml-ppx" {>= "6.0"}
+  "js_of_ocaml-ppx_deriving_json" {>= "6.0"}
+  "js_of_ocaml-tyxml" {>= "6.0"}
   "lwt_log"
   "tyxml" {>= "4.6" & < "4.7"}
   "ocsigenserver" {>= "6.0" & < "7.0"}

src/lib/client/eliommod_dom.ml

@@ -104,7 +104,7 @@ let fast_select_request_nodes root =
 
 let fast_select_nodes root =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "fast_select_nodes"));
+  then Console.console ## (time (Js.string "fast_select_nodes"));
   let a_nodeList : Dom_html.element Dom.nodeList Js.t =
     root
     ## (querySelectorAll
@@ -137,7 +137,7 @@ let fast_select_nodes root =
           (Js.string ("." ^ Eliom_runtime.RawXML.ce_registered_attr_class)))
   in
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "fast_select_nodes"));
+  then Console.console ## (timeEnd (Js.string "fast_select_nodes"));
   ( a_nodeList
   , form_nodeList
   , process_node_nodeList
@@ -581,13 +581,13 @@ let rec rewrite_css ~max (media, href, css) =
        | None -> Lwt.return_nil
        | Some css ->
            if !Eliom_config.debug_timings
-           then Firebug.console ## (time (Js.string ("rewrite_CSS: " ^ href)));
+           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
-             Firebug.console ## (timeEnd (Js.string ("rewrite_CSS: " ^ href)));
+             Console.console ## (timeEnd (Js.string ("rewrite_CSS: " ^ href)));
            Lwt.return (imports @ [media, css]))
     (fun _ -> Lwt.return [media, Printf.sprintf "@import url(%s);" href])
 
@@ -663,7 +663,7 @@ let build_style (e, css) =
 
 let preload_css (doc : Dom_html.element Js.t) =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "preload_css (fetch+rewrite)"));
+  then Console.console ## (time (Js.string "preload_css (fetch+rewrite)"));
   let* css = Lwt_list.map_p build_style (fetch_linked_css (get_head doc)) in
   let css = List.concat css in
   List.iter
@@ -675,7 +675,7 @@ let preload_css (doc : Dom_html.element Js.t) =
          Lwt_log.ign_info ~section "Unique CSS skipped...")
     css;
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "preload_css (fetch+rewrite)"));
+  then Console.console ## (timeEnd (Js.string "preload_css (fetch+rewrite)"));
   Lwt.return_unit
 
 (** Window scrolling *)
@@ -687,18 +687,18 @@ let preload_css (doc : Dom_html.element Js.t) =
 [@@@warning "-39"]
 
 type position =
-  {html_top : int; html_left : int; body_top : int; body_left : int}
+  {html_top : float; html_left : float; body_top : float; body_left : float}
 [@@deriving json]
 
 [@@@warning "+39"]
 
-let top_position = {html_top = 0; html_left = 0; body_top = 0; body_left = 0}
+let top_position = {html_top = 0.; html_left = 0.; body_top = 0.; body_left = 0.}
 
 let createDocumentScroll () =
-  { html_top = Dom_html.document##.documentElement##.scrollTop
-  ; html_left = Dom_html.document##.documentElement##.scrollLeft
-  ; body_top = Dom_html.document##.body##.scrollTop
-  ; body_left = Dom_html.document##.body##.scrollLeft }
+  { 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 }
 
 (* With firefox, the scroll position is restored before to fire the
    popstate event. We maintain our own position. *)
@@ -719,10 +719,10 @@ let _ =
 let getDocumentScroll () = !current_position
 
 let setDocumentScroll pos =
-  Dom_html.document##.documentElement##.scrollTop := pos.html_top;
-  Dom_html.document##.documentElement##.scrollLeft := pos.html_left;
-  Dom_html.document##.body##.scrollTop := pos.body_top;
-  Dom_html.document##.body##.scrollLeft := pos.body_left;
+  Dom_html.document##.documentElement##.scrollTop := Js.float pos.html_top;
+  Dom_html.document##.documentElement##.scrollLeft := Js.float pos.html_left;
+  Dom_html.document##.body##.scrollTop := Js.float pos.body_top;
+  Dom_html.document##.body##.scrollLeft := Js.float pos.body_left;
   current_position := pos
 
 (* UGLY HACK for Opera bug: Opera seem does not always take into

src/lib/client/eliommod_dom.mli

@@ -86,7 +86,7 @@ val iter_attrList :
 (** Window scrolling. *)
 
 type position =
-  {html_top : int; html_left : int; body_top : int; body_left : int}
+  {html_top : float; html_left : float; body_top : float; body_left : float}
 [@@deriving json]
 
 val top_position : position

src/lib/eliom_client.client.ml

@@ -107,7 +107,7 @@ let check_global_data global_data =
   | [] -> ()
   | l ->
       Printf.ksprintf
-        (fun s -> Firebug.console ## (error (Js.string s)))
+        (fun s -> Console.console ## (error (Js.string s)))
         "Code generating the following client values is not linked on the client:\n%s"
         (String.concat "\n"
            (List.rev_map
@@ -128,7 +128,7 @@ let check_global_data global_data =
   | [] -> ()
   | l ->
       Printf.ksprintf
-        (fun s -> Firebug.console ## (error (Js.string s)))
+        (fun s -> Console.console ## (error (Js.string s)))
         "Code containing the following injections is not linked on the client:\n%s"
         (String.concat "\n"
            (List.rev_map
@@ -260,12 +260,12 @@ let relink_request_node (node : Dom_html.element Js.t) =
 let relink_request_nodes root =
   Lwt_log.ign_debug ~section "Relink request nodes";
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "relink_request_nodes"));
+  then Console.console ## (time (Js.string "relink_request_nodes"));
   Eliommod_dom.iter_nodeList
     (Eliommod_dom.select_request_nodes root)
     relink_request_node;
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "relink_request_nodes"))
+  then Console.console ## (timeEnd (Js.string "relink_request_nodes"))
 
 (* Relinks a-elements, form-elements, and process nodes. The list of
    closure nodes is returned for application on [relink_closure_node]
@@ -405,12 +405,12 @@ let load_data_script page =
   in
   let script = data_script##.text in
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "load_data_script"));
+  then Console.console ## (time (Js.string "load_data_script"));
   ignore (Js.Unsafe.eval_string (Js.to_string script));
   Eliom_process.reset_request_template ();
   Eliom_process.reset_request_cookies ();
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "load_data_script"))
+  then Console.console ## (timeEnd (Js.string "load_data_script"))
 
 (* == Scroll the current page such that the top of element with the id
    [fragment] is aligned with the window's top. If the optional
@@ -1004,7 +1004,7 @@ let init () =
     Eliom_client_core.set_initial_load ();
     Lwt.async (fun () ->
       if !Eliom_config.debug_timings
-      then Firebug.console ## (time (Js.string "onload"));
+      then Console.console ## (time (Js.string "onload"));
       let* () =
         Eliom_request_info.set_session_info
           ~uri:
@@ -1043,7 +1043,7 @@ let init () =
       Lwt_mutex.unlock Eliom_client_core.load_mutex;
       run_callbacks load_callbacks;
       if !Eliom_config.debug_timings
-      then Firebug.console ## (timeEnd (Js.string "onload"));
+      then Console.console ## (timeEnd (Js.string "onload"));
       Lwt.return_unit);
     Js._false
   in
@@ -1459,7 +1459,7 @@ let set_uri ~replace ?fragment uri =
 
 let replace_page ~do_insert_base new_page =
   if !Eliom_config.debug_timings
-  then Firebug.console ## (time (Js.string "replace_page"));
+  then Console.console ## (time (Js.string "replace_page"));
   if !only_replace_body
   then
     let new_body = new_page ##. childNodes ## (item 1) in
@@ -1475,7 +1475,7 @@ let replace_page ~do_insert_base new_page =
     Dom.replaceChild Dom_html.document new_page
       Dom_html.document##.documentElement);
   if !Eliom_config.debug_timings
-  then Firebug.console ## (timeEnd (Js.string "replace_page"))
+  then Console.console ## (timeEnd (Js.string "replace_page"))
 
 (* Function to be called for client side services: *)
 let set_content_local ?offset ?fragment new_page =
@@ -1484,7 +1484,7 @@ let set_content_local ?offset ?fragment new_page =
   let recover () =
     if !locked then Lwt_mutex.unlock Eliom_client_core.load_mutex;
     if !Eliom_config.debug_timings
-    then Firebug.console ## (timeEnd (Js.string "set_content_local"))
+    then Console.console ## (timeEnd (Js.string "set_content_local"))
   and really_set () =
     (* Inline CSS in the header to avoid the "flashing effect".
        Otherwise, the browser start to display the page before
@@ -1510,7 +1510,7 @@ let set_content_local ?offset ?fragment new_page =
     scroll_to_fragment ?offset fragment;
     advance_page ();
     if !Eliom_config.debug_timings
-    then Firebug.console ## (timeEnd (Js.string "set_content_local"));
+    then Console.console ## (timeEnd (Js.string "set_content_local"));
     Lwt.return_unit
   in
   let cancel () = recover (); Lwt.return_unit in
@@ -1519,7 +1519,7 @@ let set_content_local ?offset ?fragment new_page =
        let* () = Lwt_mutex.lock Eliom_client_core.load_mutex in
        Eliom_client_core.set_loading_phase ();
        if !Eliom_config.debug_timings
-       then Firebug.console ## (time (Js.string "set_content_local"));
+       then Console.console ## (time (Js.string "set_content_local"));
        run_onunload_wrapper really_set cancel)
     (fun exn ->
        recover ();
@@ -1619,19 +1619,19 @@ let set_content ~replace ~uri ?offset ?fragment content =
         scroll_to_fragment ?offset fragment;
         advance_page ();
         if !Eliom_config.debug_timings
-        then Firebug.console ## (timeEnd (Js.string "set_content"));
+        then Console.console ## (timeEnd (Js.string "set_content"));
         Lwt.return_unit
       and recover () =
         if !locked then Lwt_mutex.unlock Eliom_client_core.load_mutex;
         if !Eliom_config.debug_timings
-        then Firebug.console ## (timeEnd (Js.string "set_content"))
+        then Console.console ## (timeEnd (Js.string "set_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 Firebug.console ## (time (Js.string "set_content"));
+           then Console.console ## (time (Js.string "set_content"));
            let g () = recover (); Lwt.return_unit in
            run_onunload_wrapper really_set g)
         (fun exn ->

src/lib/eliom_content.client.mli

@@ -758,7 +758,7 @@ module Html : sig
       val minHeightPx : 'a elt -> int
       val minWidth : 'a elt -> string
       val minWidthPx : 'a elt -> int
-      val opacity : 'a elt -> string option
+      val opacity : 'a elt -> string
       val outline : 'a elt -> string
       val outlineColor : 'a elt -> string
       val outlineOffset : 'a elt -> string

src/lib/eliom_content_.client.ml

@@ -963,7 +963,7 @@ module Html = struct
 
       let opacity elt =
         let elt = get_unique_elt "Css.opacity" elt in
-        Option.map Js.to_bytestring (Js.Optdef.to_option elt##.style##.opacity)
+        Js.to_bytestring elt##.style##.opacity
 
       let outline elt =
         let elt = get_unique_elt "Css.outline" elt in
@@ -1406,7 +1406,7 @@ module Html = struct
 
       let opacity elt v =
         let elt = get_unique_elt "SetCss.opacity" elt in
-        elt##.style##.opacity := Js.def (Js.bytestring v)
+        elt##.style##.opacity := Js.bytestring v
 
       let outline elt v =
         let elt = get_unique_elt "SetCss.outline" elt in

src/lib/eliom_lib.client.ml

@@ -95,7 +95,7 @@ let _ =
   Lwt_log.default := Lwt_log.console;
   Lwt.async_exception_hook :=
     fun exn ->
-      Firebug.console##error_3 (Js.string "Lwt.async:")
+      Console.console##error_3 (Js.string "Lwt.async:")
         (Js.string (Printexc.to_string exn))
         exn
 

src/lib/eliom_request.client.ml

@@ -222,18 +222,7 @@ let send ?with_credentials ?(expecting_process_page = false) ?cookies_info
     let headers =
       if expecting_process_page
       then
-        let content_type =
-          if Dom_html.onIE
-             && not
-                  (Js.Optdef.test
-                     (Js.Unsafe.coerce Dom_html.document)##.adoptNode)
-          then
-            (* ie < 9 does not know xhtml+xml content type, but ie 9
-               can use it and need it to use adoptNode *)
-            "application/xml"
-          else "application/xhtml+xml"
-        in
-        ("Accept", content_type)
+        ("Accept", "application/xhtml+xml")
         :: ( Eliom_common.expecting_process_page_name
            , encode_header_value ~typ:[%json: bool] true )
         :: headers