Translate 'Lwt_io.read_into_exactly'

Author: Julow

bin/lwt_to_direct_style/ast_rewrite.ml

@@ -356,12 +356,13 @@ let rewrite_apply ~backend ~state full_ident args =
   | "Lwt_mutex", "with_lock" ->
       take @@ fun t ->
       take @@ fun f -> return (Some (backend#mutex_with_lock t f))
-  | "Lwt_io", "read_into" ->
+  | "Lwt_io", (("read_into" | "read_into_exactly") as ident) ->
+      let exactly = ident = "read_into_exactly" in
       take @@ fun input ->
       take @@ fun buffer ->
       take @@ fun buf_off ->
       take @@ fun buf_len ->
-      return (Some (backend#io_read input buffer buf_off buf_len))
+      return (Some (backend#io_read ~exactly input buffer buf_off buf_len))
   | "Lwt_io", "of_fd" ->
       ignore_lblarg "buffer"
       @@ ignore_lblarg ~cmt:"Will behave as if it was [true]." "close"

bin/lwt_to_direct_style/concurrency_backend.ml

@@ -18,9 +18,10 @@ let eio ~eio_sw_as_fiber_var ~eio_env_as_fiber_var add_comment =
     [ i ]
   in
   let add_comment fmt = Format.kasprintf add_comment fmt in
-  let add_comment_dropped_exp ~label exp =
-    add_comment "Dropped expression (%s): [%s]." label
+  let add_comment_dropped_exp ~label ?(cmt = "") exp =
+    add_comment "Dropped expression (%s): [%s].%s" label
       (Ocamlformat_utils.format_expression exp)
+      cmt
   in
   (* If [--eio-sw-as-fiber-var] is passed on the command line, this will query
      the current switch. Otherwise, this will generate a comment.
@@ -206,7 +207,7 @@ let eio ~eio_sw_as_fiber_var ~eio_env_as_fiber_var add_comment =
       (*     ]) *)
       fd
 
-    method io_read input buffer buf_offset buf_len =
+    method io_read ~exactly input buffer buf_offset buf_len =
       add_comment "[%s] should be a [Cstruct.t]."
         (Ocamlformat_utils.format_expression buffer);
       add_comment
@@ -215,9 +216,12 @@ let eio ~eio_sw_as_fiber_var ~eio_env_as_fiber_var add_comment =
          contains an internal buffer) or change the call to \
          [Eio.Buf_read.of_flow] used to create the buffer."
         (Ocamlformat_utils.format_expression input);
-      add_comment_dropped_exp ~label:"buffer offset" buf_offset;
-      add_comment_dropped_exp ~label:"buffer length" buf_len;
-      mk_apply_simple [ "Eio"; "Flow"; "single_read" ] [ input; buffer ]
+      add_comment_dropped_exp ~label:"buffer offset"
+        ~cmt:" This will behave as if it was [0]." buf_offset;
+      add_comment_dropped_exp ~label:"buffer length"
+        ~cmt:" This will behave as if it was [Cstruct.length buffer]." buf_len;
+      let fun_ = if exactly then "read_exact" else "single_read" in
+      mk_apply_simple [ "Eio"; "Flow"; fun_ ] [ input; buffer ]
 
     method io_read_all input =
       mk_apply_simple [ "Eio"; "Buf_read"; "take_all" ] [ input ]

test/lwt_to_direct_style/to_direct_style.t/run.t

@@ -228,45 +228,47 @@ 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: (38 occurrences)
+  lib/test_lwt_unix.ml: (40 occurrences)
     Lwt_io (line 7 column 8)
-    Lwt.return (line 11 column 3)
+    Lwt.return (line 12 column 3)
     Lwt.let* (line 10 column 3)
-    Lwt.let* (line 31 column 3)
-    Lwt.let* (line 35 column 3)
+    Lwt.let* (line 11 column 3)
+    Lwt.let* (line 32 column 3)
+    Lwt.let* (line 36 column 3)
     Lwt.Syntax (line 1 column 6)
-    Lwt_io.Input (line 22 column 32)
-    Lwt_io.Output (line 23 column 32)
+    Lwt_io.Input (line 23 column 32)
+    Lwt_io.Output (line 24 column 32)
     Lwt_io.input (line 7 column 28)
-    Lwt_io.input (line 31 column 36)
-    Lwt_io.output (line 21 column 32)
-    Lwt_io.output (line 35 column 36)
-    Lwt_io.output_channel (line 26 column 9)
-    Lwt_io.close (line 32 column 3)
+    Lwt_io.input (line 32 column 36)
+    Lwt_io.output (line 22 column 32)
+    Lwt_io.output (line 36 column 36)
+    Lwt_io.output_channel (line 27 column 9)
+    Lwt_io.close (line 33 column 3)
     Lwt_io.of_fd (line 7 column 16)
-    Lwt_io.of_fd (line 21 column 13)
     Lwt_io.of_fd (line 22 column 13)
     Lwt_io.of_fd (line 23 column 13)
-    Lwt_io.read_line (line 28 column 15)
-    Lwt_io.read (line 41 column 15)
+    Lwt_io.of_fd (line 24 column 13)
+    Lwt_io.read_line (line 29 column 15)
     Lwt_io.read (line 42 column 15)
     Lwt_io.read (line 43 column 15)
+    Lwt_io.read (line 44 column 15)
     Lwt_io.read_into (line 10 column 19)
-    Lwt_io.write (line 24 column 19)
-    Lwt_io.length (line 36 column 3)
-    Lwt_io.stdout (line 26 column 33)
-    Lwt_io.open_file (line 31 column 13)
-    Lwt_io.open_file (line 35 column 13)
-    Lwt_unix.Timeout (line 13 column 9)
+    Lwt_io.read_into_exactly (line 11 column 13)
+    Lwt_io.write (line 25 column 19)
+    Lwt_io.length (line 37 column 3)
+    Lwt_io.stdout (line 27 column 33)
+    Lwt_io.open_file (line 32 column 13)
+    Lwt_io.open_file (line 36 column 13)
+    Lwt_unix.Timeout (line 14 column 9)
     Lwt_unix.of_unix_file_descr (line 6 column 8)
-    Lwt_unix.stat (line 38 column 16)
-    Lwt_unix.lstat (line 39 column 16)
-    Lwt_unix.sockaddr (line 14 column 9)
-    Lwt_unix.ADDR_UNIX (line 14 column 29)
-    Lwt_unix.ADDR_UNIX (line 16 column 6)
-    Lwt_unix.ADDR_INET (line 16 column 29)
-    Lwt_unix.ADDR_INET (line 17 column 3)
-    Lwt_unix.getaddrinfo (line 19 column 9)
+    Lwt_unix.stat (line 39 column 16)
+    Lwt_unix.lstat (line 40 column 16)
+    Lwt_unix.sockaddr (line 15 column 9)
+    Lwt_unix.ADDR_UNIX (line 15 column 29)
+    Lwt_unix.ADDR_UNIX (line 17 column 6)
+    Lwt_unix.ADDR_INET (line 17 column 29)
+    Lwt_unix.ADDR_INET (line 18 column 3)
+    Lwt_unix.getaddrinfo (line 20 column 9)
   lib/test.mli: (17 occurrences)
     Lwt (line 12 column 26)
     Lwt.t (line 1 column 35)
@@ -298,9 +300,9 @@ Make a writable directory tree:
     Lwt.let* (line 163 column 21)
     Lwt.Fail (line 179 column 9)
   Warning: lib/test_lwt_unix.ml: 3 occurrences have not been rewritten.
-    Lwt_io.stdout (line 26 column 33)
-    Lwt_io.read (line 42 column 15)
+    Lwt_io.stdout (line 27 column 33)
     Lwt_io.read (line 43 column 15)
+    Lwt_io.read (line 44 column 15)
   Warning: lib/test.mli: 2 occurrences have not been rewritten.
     Lwt_mutex.t (line 2 column 10)
     Lwt_mutex.t (line 3 column 10)
@@ -695,8 +697,16 @@ Make a writable directory tree:
       Eio.Flow.single_read
         (* TODO: lwt-to-direct-style: [buf] should be a [Cstruct.t]. *)
         (* TODO: lwt-to-direct-style: [Eio.Flow.single_read] operates on a [Flow.source] but [inp] is likely of type [Eio.Buf_read.t]. Rewrite this code to use [Buf_read] (which contains an internal buffer) or change the call to [Eio.Buf_read.of_flow] used to create the buffer. *)
-        (* TODO: lwt-to-direct-style: Dropped expression (buffer offset): [0]. *)
-        (* TODO: lwt-to-direct-style: Dropped expression (buffer length): [1024]. *)
+        (* TODO: lwt-to-direct-style: Dropped expression (buffer offset): [0]. This will behave as if it was [0]. *)
+        (* TODO: lwt-to-direct-style: Dropped expression (buffer length): [1024]. This will behave as if it was [Cstruct.length buffer]. *)
+        inp buf
+    in
+    let () =
+      Eio.Flow.read_exact
+        (* TODO: lwt-to-direct-style: [buf] should be a [Cstruct.t]. *)
+        (* TODO: lwt-to-direct-style: [Eio.Flow.single_read] operates on a [Flow.source] but [inp] is likely of type [Eio.Buf_read.t]. Rewrite this code to use [Buf_read] (which contains an internal buffer) or change the call to [Eio.Buf_read.of_flow] used to create the buffer. *)
+        (* TODO: lwt-to-direct-style: Dropped expression (buffer offset): [0]. This will behave as if it was [0]. *)
+        (* TODO: lwt-to-direct-style: Dropped expression (buffer length): [1024]. This will behave as if it was [Cstruct.length buffer]. *)
         inp buf
     in
     ()

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

@@ -8,6 +8,7 @@ let _f fname =
   in
   let buf = Bytes.create 1024 in
   let* _n : int = Lwt_io.read_into inp buf 0 1024 in
+  let* () = Lwt_io.read_into_exactly inp buf 0 1024 in
   Lwt.return ()
 
 let _ = Lwt_unix.Timeout