Seek returns unit, improve documentation

The position is not always possible to keep track of, and is not
very useful to begin with.

The documentation better explains the lightweight higher kinded types
trick.

Co-authored-by: Calascibetta Romain <[email protected]>
Co-authored-by: Reynir Björnsson <[email protected]>

lib/tar.ml

@@ -821,7 +821,7 @@ type ('a, 't) io
 type ('a, 'err, 't) t =
   | Really_read : int -> (string, 'err, 't) t
   | Read : int -> (string, 'err, 't) t
-  | Seek : int -> (int, 'err, 't) t
+  | Seek : int -> (unit, 'err, 't) t
   | Bind : ('a, 'err, 't) t * ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
   | Return : ('a, 'err) result -> ('a, 'err, 't) t
   | High : (('a, 'err) result, 't) io -> ('a, 'err, 't) t
@@ -843,11 +843,11 @@ let fold f init =
     | Ok (t, Some `Header hdr, g) ->
       let global = Option.fold ~none:global ~some:(fun g -> Some g) g in
       let* acc' = f ?global hdr acc in
-      let* _off = seek (Header.compute_zero_padding_length hdr) in
+      let* () = seek (Header.compute_zero_padding_length hdr) in
       go t ?global acc'
     | Ok (t, Some `Skip n, g) ->
       let global = Option.fold ~none:global ~some:(fun g -> Some g) g in
-      let* _off = seek n in
+      let* () = seek n in
       go t ?global acc
     | Ok (t, Some `Read n, g) ->
       let global = Option.fold ~none:global ~some:(fun g -> Some g) g in

lib/tar.mli

@@ -181,21 +181,25 @@ val encode_global_extended_header : ?level:Header.compatibility -> Header.Extend
     We can compose these actions with [Bind], [Return] and [High]. The latter
     allows you to use a value [('a, 't) io] that comes from the scheduler used -
     so you can use an Lwt value (['a Lwt.t]) without depending on Lwt
-    ([('a, lwt) t]) at this stage. *)
+    ([('a, lwt) t]) at this stage.
+
+    For further informations, you can look at the paper about Lightweight
+    Higher Kind Polymorphism available
+    {{:https://www.cl.cam.ac.uk/~jdy22/papers/lightweight-higher-kinded-polymorphism.pdf} here}. *)
 
 type ('a, 't) io
 
 type ('a, 'err, 't) t =
   | Really_read : int -> (string, 'err, 't) t
   | Read : int -> (string, 'err, 't) t
-  | Seek : int -> (int, 'err, 't) t
+  | Seek : int -> (unit, 'err, 't) t
   | Bind : ('a, 'err, 't) t * ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
   | Return : ('a, 'err) result -> ('a, 'err, 't) t
   | High : (('a, 'err) result, 't) io -> ('a, 'err, 't) t
 
 val really_read : int -> (string, _, _) t
 val read : int -> (string, _, _) t
-val seek : int -> (int, _, _) t
+val seek : int -> (unit, _, _) t
 val ( let* ) : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t
 val return : ('a, 'err) result -> ('a, 'err, _) t
 

lib/tar_gz.ml

@@ -121,10 +121,10 @@ let really_read_through_gz decoder len =
 
 type error = [ `Fatal of Tar.error | `Eof | `Gz of string ]
 
-let seek_through_gz : decoder -> int -> (int, [> error ], _) Tar.t = fun state len ->
+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 0 (* XXX(dinosaure): actually, [fold] ignores the result. *))
+  Tar.return (Ok ())
 
 let gzipped t =
   let rec go : type a. decoder -> (a, [> error ] as 'err, 't) Tar.t -> (a, 'err, 't) Tar.t = fun decoder -> function

unix/tar_lwt_unix.ml

@@ -56,6 +56,7 @@ let read_complete fd buf len =
 
 let seek fd n =
   safe (Lwt_unix.lseek fd n) Unix.SEEK_CUR
+  |> Lwt_result.map ignore
 
 let safe_close fd =
   Lwt.catch (fun () -> Lwt_unix.close fd) (fun _ -> Lwt.return_unit)
@@ -151,7 +152,7 @@ let extract ?(filter = fun _ -> true) ~src dst =
         Tar.return (Error (`Exn exn))
       end
     | _ ->
-      let* _off = 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 ())
   in
   fold f src ()

unix/tar_unix.ml

@@ -40,6 +40,7 @@ let read_complete fd buf len =
 
 let seek fd n =
   safe (Unix.lseek fd n) Unix.SEEK_CUR
+  |> Result.map ignore
 
 type decode_error = [
   | `Fatal of Tar.error
@@ -70,8 +71,8 @@ module High : sig
   type t
   type 'a s = 'a
 
-    external inj : 'a s -> ('a, t) Tar.io = "%identity"
-    external prj : ('a, t) Tar.io -> 'a s = "%identity"
+  external inj : 'a s -> ('a, t) Tar.io = "%identity"
+  external prj : ('a, t) Tar.io -> 'a s = "%identity"
 end = struct
   type t
   type 'a s = 'a
@@ -153,11 +154,11 @@ let extract ?(filter = fun _ -> true) ~src dst =
       | _ ->
         (* TODO handle directories, links, etc. *)
         let ( let* ) = Tar.( let* ) in
-        let* _off = 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 ())
     else
       let ( let* ) = Tar.( let* ) in
-      let* _off = 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 ())
   in
   fold f src ()