Move Tar.( let* ) to a new Tar.Syntax submodule and add Tar.bind

bin/otar.ml

@@ -14,6 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Tar.Syntax
+
 let () = Printexc.record_backtrace true
 
 let ( / ) = Filename.concat
@@ -99,9 +101,8 @@ let list filename =
       hdr.Tar.Header.file_name
       (Tar.Header.Link.to_string hdr.link_indicator)
       (bytes_to_size ~decimals:2) hdr.Tar.Header.file_size ;
-    let open Tar in
-    let* _ = seek (Int64.to_int hdr.Tar.Header.file_size) in
-    return (Ok ())
+    let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
+    Tar.return (Ok ())
   in
   let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0 in
   match Tar_unix.run (Tar_gz.in_gzipped (Tar.fold go ())) fd with

eio/tar_eio.ml

@@ -122,7 +122,7 @@ let copy dst len =
   let rec read_write dst len =
     if len = 0 then value (Ok ())
     else
-      let ( let* ) = Tar.( let* ) in
+      let open Tar.Syntax in
       let slen = min blen len in
       let* str = Tar.really_read slen in
       let* _written = Result.ok (Eio.Flow.copy_string str dst) |> value in
@@ -132,7 +132,7 @@ let copy dst len =
 
 let extract ?(filter = fun _ -> true) src dst =
   let f ?global:_ hdr () =
-    let ( let* ) = Tar.( let* ) in
+    let open Tar.Syntax in
     let path = dst / hdr.Tar.Header.file_name in
     match (filter hdr, hdr.Tar.Header.link_indicator) with
     | true, Tar.Header.Link.Normal ->

lib/tar.ml

@@ -832,13 +832,19 @@ type ('a, 'err, 't) t =
   | High : (('a, 'err) result, 't) io -> ('a, 'err, 't) t
   | Write : string -> (unit, 'err, 't) t
 
-let ( let* ) x f = Bind (x, f)
+let bind x f = Bind (x, f)
 let return x = Return x
 let really_read n = Really_read n
 let read n = Read n
 let seek n = Seek n
 let write str = Write str
 
+module Syntax = struct
+  let ( let* ) = bind
+end
+
+open Syntax
+
 type ('a, 'err, 't) fold = (?global:Header.Extended.t -> Header.t -> 'a -> ('a, 'err, 't) t) -> 'a -> ('a, 'err, 't) t
 
 let fold f init =

lib/tar.mli

@@ -201,10 +201,14 @@ type ('a, 'err, 't) t =
 val really_read : int -> (string, _, _) t
 val read : int -> (string, _, _) t
 val seek : int -> (unit, _, _) t
-val ( let* ) : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
+val bind : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
 val return : ('a, 'err) result -> ('a, 'err, _) t
 val write : string -> (unit, _, _) t
 
+module Syntax : sig
+  val ( let* ) : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
+end
+
 type ('a, 'err, 't) fold = (?global:Header.Extended.t -> Header.t -> 'a -> ('a, 'err, 't) t) -> 'a -> ('a, 'err, 't) t
 
 val fold : ('a, [> `Fatal of error ], 't) fold

lib/tar_gz.ml

@@ -14,6 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Tar.Syntax
+
 external ba_get_int32_ne : De.bigstring -> int -> int32 = "%caml_bigstring_get32"
 external ba_set_int32_ne : De.bigstring -> int -> int32 -> unit = "%caml_bigstring_set32"
 
@@ -56,7 +58,6 @@ type decoder =
 let read_through_gz
   : decoder -> bytes -> (int, 'err, _) Tar.t
   = fun ({ ic_buffer; oc_buffer; tp_length; _ } as state) res ->
-    let open Tar in
     let rec until_full_or_end gz (res, res_off, res_len) =
       match Gz.Inf.decode gz with
       | `Flush gz ->
@@ -66,40 +67,38 @@ let read_through_gz
         if len < max
         then ( state.pos <- len
              ; state.gz <- gz
-             ; return (Ok (res_off + len)) )
+             ; Tar.return (Ok (res_off + len)) )
         else until_full_or_end (Gz.Inf.flush gz) (res, res_off + len, res_len - len)
       | `End gz ->
         let max = De.bigstring_length oc_buffer - Gz.Inf.dst_rem gz in
         let len = min res_len max in
         bigstring_blit_bytes oc_buffer ~src_off:0 res ~dst_off:res_off ~len;
         state.pos <- len;
         state.gz <- gz;
-        return (Ok (res_off + len))
+        Tar.return (Ok (res_off + len))
       | `Await gz ->
         let* tp_buffer = Tar.read tp_length in
         let len = String.length tp_buffer in
         bigstring_blit_string tp_buffer ~src_off:0 ic_buffer ~dst_off:0 ~len;
         let gz = Gz.Inf.src gz ic_buffer 0 len in
         until_full_or_end gz (res, res_off, res_len)
-      | `Malformed err -> return (Error (`Gz err)) in
+      | `Malformed err -> Tar.return (Error (`Gz err)) in
     let max = (De.bigstring_length oc_buffer - Gz.Inf.dst_rem state.gz) - state.pos in
     let len = min (Bytes.length res) max in
     bigstring_blit_bytes oc_buffer ~src_off:state.pos res ~dst_off:0 ~len;
     if len < max
     then ( state.pos <- state.pos + len
-         ; return (Ok len) )
+         ; Tar.return (Ok len) )
     else until_full_or_end (Gz.Inf.flush state.gz) (res, len, Bytes.length res - len)
 
 let really_read_through_gz decoder len =
-  let open Tar in
   let res = Bytes.create len in
   let* len = read_through_gz decoder res in
   if Bytes.length res = len
   then Tar.return (Ok (Bytes.unsafe_to_string res))
   else Tar.return (Error `Eof)
 
 let read_through_gz decoder len =
-  let open Tar in
   let res = Bytes.create len in
   let* len = read_through_gz decoder res in
   let str = Bytes.sub_string res 0 len in
@@ -110,7 +109,6 @@ type error = [ `Fatal of Tar.error | `Eof | `Gz of string ]
 let seek_through_gz
   : decoder -> int -> (unit, [> error ], _) Tar.t
   = fun state len ->
-  let open Tar in
   let* _buf = really_read_through_gz state len in
   Tar.return (Ok ())
 
@@ -211,13 +209,13 @@ let out_gzipped ~level ~mtime os t =
   let gz = Gz.Def.dst gz oc_buffer 0 (De.bigstring_length oc_buffer) in
   let* state = until_await 0 oc_buffer (Gz.Def.encode gz) in
   let encoder =
-    { state 
+    { state
     ; ic_buffer
     ; oc_buffer } in
   let* result = go encoder t in
   let `Await gz = encoder.state in
   let* () =
     Gz.Def.src gz ic_buffer 0 0
-    |> Gz.Def.encode 
+    |> Gz.Def.encode
     |> until_end 0 oc_buffer  in
   Tar.return (Ok result)

lib_test/global_extended_headers_test.ml

@@ -47,7 +47,7 @@ let use_global_extended_headers _test_ctxt =
       Alcotest.testable (fun ppf hdr -> Fmt.pf ppf "%a" Fmt.(option pp) hdr) ( = )
     in
     let f ?global hdr idx =
-      let ( let* ) = Tar.( let* ) in
+      let open Tar.Syntax in
       let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
       match idx with
       | 0 ->

lib_test/parse_test.ml

@@ -13,6 +13,7 @@
  *)
 
 open Lwt.Infix
+open Tar.Syntax
 
 let convert_path os path =
   let ch = Unix.open_process_in (Printf.sprintf "cygpath -%c -- %s" (match os with `Mixed -> 'm' | `Unix -> 'u' | `Windows -> 'w') path) in
@@ -34,8 +35,7 @@ end
 let list filename =
   let f ?global:_ hdr acc =
     print_endline hdr.Tar.Header.file_name;
-    let ( let* ) = Tar.( let* ) in
-    let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
+    let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
     Tar.return (Ok (hdr :: acc))
   in
   match Tar_unix.fold f filename [] with
@@ -169,8 +169,7 @@ let can_list_pax_implicit_dir () =
   let f ?global:_ hdr () =
     Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator;
     Alcotest.(check string) "filename is patched" "clearly/a/directory/" hdr.file_name;
-    let ( let* ) = Tar.( let* ) in
-    let* _pos = Tar.seek (Int64.to_int hdr.file_size) in
+    let* () = Tar.seek (Int64.to_int hdr.file_size) in
     Tar.return (Ok ())
   in
   match Tar_unix.fold f "lib_test/pax-shenanigans.tar" () with
@@ -192,8 +191,7 @@ let can_list_longlink_implicit_dir () =
   let f ?global:_ hdr () =
     Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator;
     Alcotest.(check string) "filename is patched" "some/long/name/for/a/directory/" hdr.file_name;
-    let ( let* ) = Tar.( let* ) in
-    let* _pos = Tar.seek (Int64.to_int hdr.file_size) in
+    let* () = Tar.seek (Int64.to_int hdr.file_size) in
     Tar.return (Ok ())
   in
   match Tar_unix.fold f "lib_test/long-implicit-dir.tar" () with
@@ -216,8 +214,7 @@ let can_transform_tar () =
   let fd_out = Unix.openfile tar_out [ O_WRONLY; O_CREAT; O_CLOEXEC ] 0o644 in
   with_tmpdir @@ fun temp_dir ->
   let f ?global:_ hdr _ =
-    let ( let* ) = Tar.( let* ) in
-    let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
+    let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
     let hdr =
       { hdr with
         Tar.Header.file_name = Filename.concat temp_dir hdr.file_name;
@@ -236,8 +233,7 @@ let can_transform_tar () =
     | Ok () ->
       Unix.close fd_out;
       let f ?global:_ hdr _ =
-        let ( let* ) = Tar.( let* ) in
-        let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
+        let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
         Alcotest.(check string) "Filename was transformed" temp_dir
           (String.sub hdr.file_name 0 (min (String.length hdr.file_name) (String.length temp_dir)));
         Tar.return (Ok ())

unix/tar_lwt_unix.ml

@@ -15,6 +15,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Tar.Syntax
+
 type decode_error = [
   | `Fatal of Tar.error
   | `Unix of Unix.error * string * string
@@ -122,7 +124,6 @@ let copy ~dst_fd len =
   let rec read_write ~dst_fd len =
     if len = 0 then value (Lwt.return (Ok ()))
     else
-      let ( let* ) = Tar.( let* ) in
       let slen = min blen len in
       let* str = Tar.really_read slen in
       let* _written = Lwt_result.map_error unix_err_to_msg
@@ -139,7 +140,6 @@ let extract ?(filter = fun _ -> true) ~src dst =
       (fun _ -> Lwt.return_unit)
     >|= Result.ok in
   let f ?global:_ hdr () =
-    let ( let* ) = Tar.( let* ) in
     match filter hdr, hdr.Tar.Header.link_indicator with
     | true, Tar.Header.Link.Normal ->
       let* dst = Lwt_result.map_error

unix/tar_unix.ml

@@ -127,7 +127,7 @@ let unix_err_to_msg = function
 let copy ~dst_fd len =
   let blen = 65536 in
   let rec read_write ~dst_fd len =
-    let ( let* ) = Tar.( let* ) in
+    let open Tar.Syntax in
     if len = 0 then Tar.return (Ok ())
     else
       let slen = min blen len in
@@ -156,11 +156,11 @@ let extract ?(filter = fun _ -> true) ~src dst =
         (* TODO set owner / mode / mtime etc. *)
       | _ ->
         (* TODO handle directories, links, etc. *)
-        let ( let* ) = Tar.( let* ) in
+        let open Tar.Syntax in
         let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
         Tar.return (Ok ())
     else
-      let ( let* ) = Tar.( let* ) in
+      let open Tar.Syntax in
       let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
       Tar.return (Ok ())
   in