Remove deprecated Lwt_logs

cohttp-lwt-unix/bin/cohttp_server_lwt.ml

@@ -21,6 +21,8 @@ open Cohttp_lwt_unix
 
 open Cohttp_server
 
+let log_src = Logs.Src.create "cohttp-lwt-unix.bin.server"
+
 let method_filter meth (res,body) = match meth with
   | `HEAD -> Lwt.return (res,`Empty)
   | _ -> Lwt.return (res,body)
@@ -81,10 +83,11 @@ let handler ~info ~docroot ~index (ch,_conn) req _body =
   let uri = Cohttp.Request.uri req in
   let path = Uri.path uri in
   (* Log the request to the console *)
-  Lwt_log.debug_f "%s %s %s"
+  Logs_lwt.debug ~src:log_src (fun m -> m
+    "%s %s %s"
     (Cohttp.(Code.string_of_method (Request.meth req)))
     path
-    (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch)) >>= fun () ->
+    (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch))) >>= fun () ->
   (* Get a canonical filename from the URL and docroot *)
   match Request.meth req with
   | (`GET | `HEAD) as meth ->
@@ -98,11 +101,11 @@ let handler ~info ~docroot ~index (ch,_conn) req _body =
       ~body:(html_of_method_not_allowed meth (String.concat "," allowed) path info) ()
 
 let start_server docroot port host index tls () =
-  Lwt_log.info_f "Listening for HTTP request on: %s %d" host port >>= fun () ->
+  Logs_lwt.info (fun m -> m "Listening for HTTP request on: %s %d" host port) >>= fun () ->
   let info = Printf.sprintf "Served by Cohttp/Lwt listening on %s:%d" host port in
   let conn_closed (ch,_conn) =
-    Lwt_log.ign_debug_f "connection %s closed"
-      (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch)) in
+    Logs.debug ~src:log_src (fun m -> m "connection %s closed"
+      (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch))) in
   let callback = handler ~info ~docroot ~index in
   let config = Server.make ~callback ~conn_closed () in
   let mode = match tls with
@@ -114,13 +117,36 @@ let start_server docroot port host index tls () =
   let ctx = Cohttp_lwt_unix.Net.init ~ctx () in
   Server.create ~ctx ~mode config
 
+(* The example of Lwt-aware reporter in Logs' documentation *)
+let lwt_reporter () =
+  let buf_fmt ~like =
+    let b = Buffer.create 512 in
+    Fmt.with_buffer ~like b,
+    fun () -> let m = Buffer.contents b in Buffer.reset b; m
+  in
+  let app, app_flush = buf_fmt ~like:Fmt.stdout in
+  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
+  let reporter = Logs_fmt.reporter ~app ~dst () in
+  let report src level ~over k msgf =
+    let k () =
+      let write () = match level with
+      | Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
+      | _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
+      in
+      let unblock () = over (); Lwt.return_unit in
+      Lwt.finalize write unblock |> Lwt.ignore_result;
+      k ()
+    in
+    reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
+  in
+  { Logs.report = report }
+
 let lwt_start_server docroot port host index verbose tls =
-  (match List.length verbose with
-  | 0 -> ()
-  | 1 -> Lwt_log_core.(add_rule "*" Info)
-  | _ -> Lwt_log_core.(add_rule "*" Debug));
+  Logs.set_level verbose;
+  Logs.set_reporter (lwt_reporter ());
   Lwt_main.run (start_server docroot port host index tls ())
 
+
 open Cmdliner
 
 let host =
@@ -135,9 +161,7 @@ let index =
   let doc = "Name of index file in directory." in
   Arg.(value & opt string "index.html" & info ["i"] ~docv:"INDEX" ~doc)
 
-let verb =
-  let doc = "Logging output to console." in
-  Arg.(value & flag_all & info ["v"; "verbose"] ~doc)
+let verb = Logs_cli.level ()
 
 let tls =
   let doc = "TLS certificate files." in

cohttp-lwt-unix/bin/jbuild

@@ -2,6 +2,13 @@
 
 (executables
  ((names (cohttp_curl_lwt cohttp_proxy_lwt cohttp_server_lwt))
-  (libraries (cohttp-lwt-unix cohttp_server cmdliner))
+  (libraries
+   (cohttp-lwt-unix
+    cohttp_server
+    logs
+    logs.lwt
+    logs.fmt
+    logs.cli
+    cmdliner))
   (package cohttp-lwt-unix)
   (public_names (cohttp-curl-lwt cohttp-proxy-lwt cohttp-server-lwt))))

cohttp-lwt-unix/src/jbuild

@@ -7,6 +7,7 @@
   (preprocess (pps (ppx_sexp_conv)))
   (libraries
    (fmt
+    logs
     logs.lwt
     conduit-lwt-unix
     magic-mime

cohttp-lwt-unix/src/server.ml

@@ -4,6 +4,8 @@ module Server_core = Cohttp_lwt.Make_server (Io)
 include Server_core
 open Lwt
 
+let log_src = Logs.Src.create "cohttp-lwt-unix.server"
+
 let blank_uri = Uri.of_string ""
 
 let resolve_file ~docroot ~uri =
@@ -31,7 +33,10 @@ let respond_file ?headers ~fname () =
               | "" -> None
               | buf -> Some buf)
             (fun exn ->
-               Lwt_log.ign_debug ~exn ("Error resolving file " ^ fname);
+               Logs.debug ~src:log_src
+                 (fun m -> m "Error resolving file %s (%s)"
+                   fname
+                   (Printexc.to_string exn));
                return_none)
         ) in
       Lwt.on_success (Lwt_stream.closed stream) (fun () ->