Merge pull request #820 from Julow/eliom-lib-lwt-log

Eliom_lib: Remove Lwt_log redefinition

Author: smorimoto

eliom.opam

@@ -17,7 +17,7 @@ license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://ocsigen.org/eliom/"
 bug-reports: "https://github.com/ocsigen/eliom/issues"
 depends: [
-  "dune" {>= "3.6"}
+  "dune" {>= "3.18"}
   "ocaml" {>= "4.12" & < "5.3"}
   "ocamlfind"
   "ppx_deriving"
@@ -56,3 +56,4 @@ build: [
   ]
 ]
 dev-repo: "git+https://github.com/ocsigen/eliom.git"
+x-maintenance-intent: ["(latest)"]

src/lib/client/eliommod_dom.ml

@@ -248,7 +248,7 @@ let slow_select_nodes (root : Dom_html.element Js.t) =
            | Dom_html.A e -> ignore a_array ## (push e)
            | Dom_html.Form e -> ignore form_array ## (push e)
            | _ ->
-               Lwt_log.raise_error_f ~section "%s element tagged as eliom link"
+               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);
@@ -302,12 +302,12 @@ end
 let get_head (page : 'element #get_tag Js.t) : 'element Js.t =
   Js.Opt.get
     page ## (getElementsByTagName (Js.string "head")) ## (item 0)
-    (fun () -> Lwt_log.raise_error ~section "get_head")
+    (fun () -> raise_error ~section "get_head")
 
 let get_body (page : 'element #get_tag Js.t) : 'element Js.t =
   Js.Opt.get
     page ## (getElementsByTagName (Js.string "body")) ## (item 0)
-    (fun () -> Lwt_log.raise_error ~section "get_body")
+    (fun () -> raise_error ~section "get_body")
 
 let iter_dom_array (f : 'a -> unit)
     (a :
@@ -349,8 +349,7 @@ let add_childrens (elt : Dom_html.element Js.t) (sons : Dom.node Js.t list) =
               match Dom.nodeType t with
               | Dom.Text t -> t
               | _ ->
-                  Lwt_log.raise_error_f ~section
-                    "add_childrens: not text node in tag %s"
+                  raise_error ~section "add_childrens: not text node in tag %s"
                     (Js.to_string elt##.tagName)
             in
             concat acc ## (concat txt##.data) q
@@ -368,7 +367,7 @@ 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
-    | _ -> Lwt_log.raise_error ~section ~exn "add_childrens: can't appendChild")
+    | _ -> raise_error ~section ~exn "add_childrens: can't appendChild")
 
 (* END IE HACK *)
 
@@ -413,9 +412,7 @@ let copy_element (e : Dom.element Js.t)
         add_childrens copy child_copies;
         Some copy
   in
-  match aux e with
-  | None -> Lwt_log.raise_error ~section "copy_element"
-  | Some e -> e
+  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

src/lib/eliom_bus.client.ml

@@ -137,7 +137,7 @@ let original_stream t =
   if Eliom_client_core.in_onload () && t.original_stream_available
   then stream t
   else
-    Lwt_log.raise_error ~section
+    raise_error ~section
       "original_stream: the original stream is not available anymore"
 
 let flush t =

src/lib/eliom_client.client.ml

@@ -179,7 +179,7 @@ let a_handler =
   Dom_html.full_handler (fun node ev ->
     let node =
       Js.Opt.get (Dom_html.CoerceTo.a node) (fun () ->
-        Lwt_log.raise_error_f ~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 *)
@@ -196,7 +196,7 @@ let form_handler :
   Dom_html.full_handler (fun node ev ->
     let form =
       Js.Opt.get (Dom_html.CoerceTo.form node) (fun () ->
-        Lwt_log.raise_error_f ~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"
@@ -213,8 +213,7 @@ let relink_process_node (node : Dom_html.element Js.t) =
   let id =
     Js.Opt.get
       node ## (getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))
-      (fun () ->
-         Lwt_log.raise_error_f ~section "unique node without id attribute")
+      (fun () -> raise_error ~section "unique node without id attribute")
   in
   Js.Optdef.case
     (Eliom_client_core.find_process_node id)
@@ -241,8 +240,7 @@ let relink_request_node (node : Dom_html.element Js.t) =
   let id =
     Js.Opt.get
       node ## (getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))
-      (fun () ->
-         Lwt_log.raise_error_f ~section "unique node without id attribute")
+      (fun () -> raise_error ~section "unique node without id attribute")
   in
   Js.Optdef.case
     (Eliom_client_core.find_request_node id)
@@ -375,8 +373,7 @@ let relink_attrib _root table (node : Dom_html.element Js.t) =
         in
         Eliom_client_core.rebuild_rattrib node rattrib
       with Not_found ->
-        Lwt_log.raise_error_f ~section
-          "relink_attrib: client value %s not found" cid
+        raise_error ~section "relink_attrib: client value %s not found" cid
   in
   Eliommod_dom.iter_attrList node##.attributes aux
 
@@ -401,11 +398,10 @@ let load_data_script page =
         match Js.to_bytestring data_script##.tagName##toLowerCase with
         | "script" -> Js.Unsafe.coerce data_script
         | t ->
-            Lwt_log.raise_error_f ~section
+            raise_error ~section
               "Unable to find Eliom application data (script element expected, found %s element)"
               t)
-    | _ ->
-        Lwt_log.raise_error_f ~section "Unable to find Eliom application data."
+    | _ -> raise_error ~section "Unable to find Eliom application data."
   in
   let script = data_script##.text in
   if !Eliom_config.debug_timings
@@ -826,7 +822,7 @@ let get_state state_id : state =
           (* We use this only when the history API is
              available. Sessionstorage seems to be available
              everywhere the history API exists. *)
-          Lwt_log.raise_error_f ~section "sessionStorage not available")
+          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))

src/lib/eliom_client_core.client.ml

@@ -87,7 +87,7 @@ end = struct
           | None -> ""
           | Some p -> Printf.sprintf "(%s)" (Eliom_lib.pos_to_string p)
         in
-        Lwt_log.raise_error_f ~section
+        raise_error ~section
           "Client closure %s not found %s (is the module linked on the client?)"
           closure_id pos
     in
@@ -136,7 +136,7 @@ end = struct
                   Printf.sprintf "%s (%s at %s)" name i
                     (Eliom_lib.pos_to_string pos)
             in
-            Lwt_log.raise_error_f "Did not find injection %s" name))
+            raise_error "Did not find injection %s" name))
 
   let initialize ~compilation_unit_id
       {Eliom_runtime.injection_id; injection_value; _}
@@ -168,7 +168,7 @@ let do_next_server_section_data ~compilation_unit_id =
         data.server_section <- r;
         Array.iter Client_value.initialize l
     | [] ->
-        Lwt_log.raise_error_f ~section
+        raise_error ~section
           "Queue of client value data for compilation unit %s is empty (is it linked on the server?)"
           compilation_unit_id
   with Not_found -> ()
@@ -184,7 +184,7 @@ let do_next_client_section_data ~compilation_unit_id =
         data.client_section <- r;
         Array.iter (fun i -> Injection.initialize ~compilation_unit_id i) l
     | [] ->
-        Lwt_log.raise_error_f ~section
+        raise_error ~section
           "Queue of injection data for compilation unit %s is empty (is it linked on the server?)"
           compilation_unit_id
   with Not_found -> ()
@@ -361,7 +361,7 @@ let reify_caml_event name node ce =
           (fun ev ->
             let node =
               Js.Opt.get (Dom_html.CoerceTo.a node) (fun () ->
-                Lwt_log.raise_error ~section "not an anchor element")
+                raise_error ~section "not an anchor element")
             in
             raw_a_handler node cookies_info tmpl ev) )
   | Xml.CE_call_service
@@ -373,7 +373,7 @@ let reify_caml_event name node ce =
           (fun ev ->
             let form =
               Js.Opt.get (Dom_html.CoerceTo.form node) (fun () ->
-                Lwt_log.raise_error ~section "not a form element")
+                raise_error ~section "not a form element")
             in
             raw_form_handler form kind cookies_info tmpl ev
               (Eliom_lib.from_poly client_hdlr : client_form_handler)) )
@@ -732,7 +732,7 @@ let rebuild_node_ns ns context elt' =
     elt' context;
   if is_before_initial_load ()
   then
-    Lwt_log.raise_error_f ~section ~inspect:(rebuild_node' ns elt')
+    raise_error ~section ~inspect:(rebuild_node' ns elt')
       "Cannot apply %s%s before the document is initially loaded" context
       Xml.(
         match get_node_id elt' with

src/lib/eliom_comet.client.ml

@@ -24,9 +24,10 @@ open Lwt.Syntax
 (* This file is for client-side comet-programming. *)
 
 open Js_of_ocaml
+open Eliom_lib
 module Ecb = Eliom_comet_base
 
-let section = Eliom_lib.Lwt_log.Section.make "eliom:comet"
+let section = Lwt_log.Section.make "eliom:comet"
 
 module Configuration = struct
   type configuration_data =
@@ -184,8 +185,8 @@ let handle_exn, set_handle_exn_function =
         "Unknown exception during comet. Customize this with Eliom_comet.set_handle_exn_function. "
       in
       match exn with
-      | Some exn -> Eliom_lib.Lwt_log.raise_error ~section ~exn s
-      | None -> Eliom_lib.Lwt_log.debug ~section s)
+      | Some exn -> raise_error ~section ~exn "%s" s
+      | None -> Lwt_log.debug ~section s)
   in
   ( (fun ?exn () ->
       if not !closed
@@ -408,7 +409,7 @@ end = struct
           (function
              | _chan_id, Ecb.Data _ -> ()
              | _chan_id, Ecb.Closed ->
-                 Eliom_lib.Lwt_log.ign_warning ~section
+                 Lwt_log.ign_warning ~section
                    "update_stateful_state: received Closed: should not happen, this is an eliom bug, please report it"
              | chan_id, Ecb.Full -> stop_waiting hd chan_id)
           message
@@ -524,17 +525,17 @@ end = struct
              | Eliom_request.Failed_request (0 | 502 | 504) ->
                  if retries > max_retries
                  then (
-                   Eliom_lib.Lwt_log.ign_notice ~section "connection failure";
+                   Lwt_log.ign_notice ~section "connection failure";
                    set_activity hd `Inactive;
                    aux 0)
                  else
                    let* () = Js_of_ocaml_lwt.Lwt_js.sleep (delay retries) in
                    aux (retries + 1)
              | Restart ->
-                 Eliom_lib.Lwt_log.ign_info ~section "restart";
+                 Lwt_log.ign_info ~section "restart";
                  aux 0
              | exn ->
-                 Eliom_lib.Lwt_log.ign_notice ~exn ~section "connection failure";
+                 Lwt_log.ign_notice ~exn ~section "connection failure";
                  let* () = handle_exn ~exn () in
                  Lwt.fail exn)
     in
@@ -547,7 +548,7 @@ end = struct
             call_service_after_load_end srv queue
               (false, Ecb.Stateful (Ecb.Commands command)))
          (fun exn ->
-            Eliom_lib.Lwt_log.ign_notice_f ~section ~exn "request failed";
+            Lwt_log.ign_notice_f ~section ~exn "request failed";
             Lwt.return ""))
 
   let close hd chan_id =
@@ -566,8 +567,8 @@ end = struct
               {state with count = state.count - 1}
               !map
       with Not_found ->
-        Eliom_lib.Lwt_log.ign_info_f ~section
-          "trying to close a non existent channel: %s" chan_id)
+        Lwt_log.ign_info_f ~section "trying to close a non existent channel: %s"
+          chan_id)
 
   let add_channel_stateful hd chan_id =
     hd.hd_activity.active_channels <-
@@ -580,7 +581,7 @@ end = struct
     | Ecb.Last i, Ecb.Last j -> Ecb.Last (max i j)
     | p, Ecb.Last _ -> p
     | Ecb.Last _, p -> p
-    | _ -> Eliom_lib.Lwt_log.raise_error ~section "not corresponding position"
+    | _ -> raise_error ~section "not corresponding position"
 
   let add_channel_stateless hd chan_id kind =
     let pos =
@@ -714,7 +715,7 @@ let check_and_update_position position msg_pos data =
   match position, msg_pos, data with
   | No_position, None, _ -> true
   | No_position, Some _, _ | Position _, None, Ecb.Data _ ->
-      Eliom_lib.Lwt_log.raise_error ~section
+      raise_error ~section
         "check_position: channel kind and message do not match"
   | Position _, None, (Ecb.Full | Ecb.Closed) -> true
   | Position (relation, r), Some j, _ -> (

src/lib/eliom_common.server.ml

@@ -48,7 +48,7 @@ let tenable_value ~name v =
         value <- v;
         tenable <- override_tenable)
       else
-        Lwt_log.ign_warning_f ~section:Lwt_log.eliom
+        Lwt_log.ign_warning_f ~section:eliom_logs_src
           "Ignored setting tenable value %S." name
   end
 

src/lib/eliom_content_.client.ml

@@ -54,7 +54,7 @@ struct
         let elt' = Kind.toelt elt in
         match Xml.get_node_id elt' with
         | Xml.NoId ->
-            Lwt_log.raise_error_f ~section:Lwt_log.eliom
+            raise_error ~section:eliom_logs_src
               ~inspect:
                 (Eliom_client_core.rebuild_node' Ns.content_ns (Kind.toelt elt))
               "Cannot call %s on an element with functional semantics" context
@@ -64,7 +64,7 @@ struct
     Js.Opt.case
       (Dom_html.CoerceTo.element (get_unique_node name elt))
       (fun () ->
-         Lwt_log.raise_error_f ~section:Lwt_log.eliom
+         raise_error ~section:eliom_logs_src
            ~inspect:
              (Eliom_client_core.rebuild_node' Ns.content_ns (Kind.toelt elt))
            "Cannot call %s on a node which is not an element" name)

src/lib/eliom_lib.client.ml

@@ -79,19 +79,17 @@ module Url = struct
         split_path (try String.(sub s 0 (index s '?')) with Not_found -> s)
 end
 
-module Lwt_log = struct
-  include Lwt_log_js
+module Lwt_log = Lwt_log_js
 
-  let raise_error ?inspect ?exn ?section ?location ?logger msg =
+let raise_error ?inspect ?exn ?section ?location ?logger fmt =
+  let k msg =
     Lwt.ignore_result
-      (log ?inspect ?exn ?section ?location ?logger ~level:Error msg);
+      (Lwt_log.log ?inspect ?exn ?section ?location ?logger ~level:Error msg);
     match exn with Some exn -> raise exn | None -> failwith msg
+  in
+  Printf.ksprintf k fmt
 
-  let raise_error_f ?inspect ?exn ?section ?location ?logger fmt =
-    Printf.ksprintf (raise_error ?inspect ?exn ?section ?location ?logger) fmt
-
-  let eliom = Section.make "eliom"
-end
+let eliom_logs_src = Lwt_log.Section.make "eliom"
 
 let _ =
   Lwt_log.default := Lwt_log.console;