Translate 'Lwt_io.with_connection'

Author: Julow

bin/lwt_to_direct_style/ast_rewrite.ml

@@ -399,6 +399,11 @@ let rewrite_apply ~backend ~state full_ident args =
   | "Lwt_io", "length" -> take @@ fun fd -> return (Some (backend#io_length fd))
   | "Lwt_io", "close" -> take @@ fun fd -> return (Some (backend#io_close fd))
   | "Lwt_io", "flush" -> take @@ fun fd -> return (Some (backend#io_flush fd))
+  | "Lwt_io", "with_connection" ->
+      ignore_lblarg "fd" @@ ignore_lblarg "in_buffer"
+      @@ ignore_lblarg "out_buffer" @@ take
+      @@ fun sockaddr ->
+      take @@ fun f -> return (Some (backend#net_with_connection sockaddr f))
   | "Lwt_main", "run" ->
       take @@ fun promise -> return (Some (backend#main_run promise))
   | "Lwt_preemptive", "detach" ->

bin/lwt_to_direct_style/concurrency_backend.ml

@@ -338,4 +338,25 @@ let eio ~eio_sw_as_fiber_var ~eio_env_as_fiber_var add_comment =
                  [ "Eio"; "Domain_manager"; "run" ]
                  [ env "domain_mgr"; thunk ]) );
         ]
+
+    method net_with_connection sockaddr f =
+      add_comment
+        "[%s] is of type [Unix.sockaddr] but it should be a \
+         [Eio.Net.Sockaddr.stream]."
+        (Ocamlformat_utils.format_expression sockaddr);
+      mk_apply_simple (switch_ident "run")
+        [
+          mk_fun ~arg_name:"sw" (fun sw ->
+              Exp.apply f
+                [
+                  ( Nolabel,
+                    mk_apply_ident
+                      [ "Eio"; "Net"; "connect" ]
+                      [
+                        (Labelled (mk_loc "sw"), sw);
+                        (Nolabel, env "net");
+                        (Nolabel, sockaddr);
+                      ] );
+                ]);
+        ]
   end

test/lwt_to_direct_style/to_direct_style.t/run.t

@@ -230,10 +230,11 @@ Make a writable directory tree:
     Lwt_mutex.lock (line 136 column 9)
     Lwt_mutex.unlock (line 137 column 9)
     Lwt_mutex.with_lock (line 138 column 9)
-  lib/test_lwt_unix.ml: (55 occurrences)
+  lib/test_lwt_unix.ml: (57 occurrences)
     Lwt_io (line 7 column 8)
     Lwt.return (line 12 column 3)
     Lwt.return (line 46 column 11)
+    Lwt.return (line 61 column 65)
     Lwt.return_unit (line 44 column 43)
     Lwt.let* (line 10 column 3)
     Lwt.let* (line 11 column 3)
@@ -268,6 +269,7 @@ Make a writable directory tree:
     Lwt_io.stdout (line 26 column 33)
     Lwt_io.open_file (line 30 column 13)
     Lwt_io.open_file (line 34 column 13)
+    Lwt_io.with_connection (line 61 column 3)
     Lwt_preemptive.detach (line 44 column 10)
     Lwt_preemptive.detach (line 47 column 3)
     Lwt_unix.Timeout (line 14 column 9)
@@ -865,3 +867,11 @@ Make a writable directory tree:
   let _f a b = Unix.listen a b
   let _f a = Marshal.from_channel a
   let _f a b = Marshal.to_channel a b
+  
+  let _f sockaddr =
+    Switch.run (fun sw ->
+        (fun (_in_chan, _out_chan) -> ())
+          (Eio.Net.connect ~sw env#net
+             (* TODO: lwt-to-direct-style: [sockaddr] is of type [Unix.sockaddr] but it should be a [Eio.Net.Sockaddr.stream]. *)
+             (* TODO: lwt-to-direct-style: [env] must be propagated from the main loop *)
+             sockaddr))

test/lwt_to_direct_style/to_direct_style.t/src/lib/test_lwt_unix.ml

@@ -56,3 +56,7 @@ let _f a b = Lwt_unix.listen a b
 
 let _f a = Lwt_io.read_value a
 let _f a b = Lwt_io.write_value a b
+
+let _f sockaddr =
+  Lwt_io.with_connection sockaddr (fun (_in_chan, _out_chan) -> Lwt.return ())
+