From 419ec01fc4791e7cb8523b08c61d5ae4b3a9b8c1 Mon Sep 17 00:00:00 2001
From: metanivek <metanivek@gmail.com>
Date: Thu, 15 Sep 2022 14:23:00 -0400
Subject: [PATCH] irmin-pack: modify auto flush callback behavior

Instead of expecting the caller to flush, it now sends the results of a
flush to the callback.
---
 src/irmin-pack/unix/append_only_file.ml      | 6 ++++--
 src/irmin-pack/unix/append_only_file_intf.ml | 9 +++++----
 src/irmin-pack/unix/gc.ml                    | 6 +++---
 src/irmin-pack/unix/mapping_file.ml          | 4 ++--
 4 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/irmin-pack/unix/append_only_file.ml b/src/irmin-pack/unix/append_only_file.ml
index f8fb2ef5f75..656d2ec057d 100644
--- a/src/irmin-pack/unix/append_only_file.ml
+++ b/src/irmin-pack/unix/append_only_file.ml
@@ -20,6 +20,8 @@ include Append_only_file_intf
 module Make (Io : Io.S) = struct
   module Io = Io
 
+  type auto_flush_callback = (unit, Io.write_error) result -> unit
+
   type t = {
     io : Io.t;
     mutable persisted_end_offset : int63;
@@ -30,7 +32,7 @@ module Make (Io : Io.S) = struct
   and rw_perm = {
     buf : Buffer.t;
     auto_flush_threshold : int;
-    auto_flush_callback : t -> unit;
+    auto_flush_callback : auto_flush_callback;
   }
   (** [rw_perm] contains the data necessary to operate in readwrite mode. *)
 
@@ -164,6 +166,6 @@ module Make (Io : Io.S) = struct
         assert (Buffer.length rw_perm.buf < rw_perm.auto_flush_threshold);
         Buffer.add_string rw_perm.buf s;
         if Buffer.length rw_perm.buf >= rw_perm.auto_flush_threshold then (
-          rw_perm.auto_flush_callback t;
+          flush t |> rw_perm.auto_flush_callback;
           assert (empty_buffer t))
 end
diff --git a/src/irmin-pack/unix/append_only_file_intf.ml b/src/irmin-pack/unix/append_only_file_intf.ml
index fb05e2ab587..43ca1159cf7 100644
--- a/src/irmin-pack/unix/append_only_file_intf.ml
+++ b/src/irmin-pack/unix/append_only_file_intf.ml
@@ -28,12 +28,13 @@ module type S = sig
   module Io : Io.S
 
   type t
+  type auto_flush_callback = (unit, Io.write_error) result -> unit
 
   val create_rw :
     path:string ->
     overwrite:bool ->
     auto_flush_threshold:int ->
-    auto_flush_callback:(t -> unit) ->
+    auto_flush_callback:auto_flush_callback ->
     (t, [> Io.create_error ]) result
   (** Create a rw instance of [t] by creating the file at [path]. *)
 
@@ -42,7 +43,7 @@ module type S = sig
     end_offset:int63 ->
     dead_header_size:int ->
     auto_flush_threshold:int ->
-    auto_flush_callback:(t -> unit) ->
+    auto_flush_callback:auto_flush_callback ->
     ( t,
       [> Io.open_error
       | `Closed
@@ -76,8 +77,8 @@ module type S = sig
       One of the goals of the [Append_only_file] abstraction is to provide
       buffered appends. [auto_flush_threshold] is the soft cap after which the
       buffer should be flushed. If a call to [append_exn] fills the buffer,
-      [auto_flush_callback] will be called so that the parent abstraction takes
-      care of the flush procedure, which is expected to call [flush]. *)
+      [auto_flush_callback] will be called with the result of the buffer being
+      flushed. *)
 
   val open_ro :
     path:string ->
diff --git a/src/irmin-pack/unix/gc.ml b/src/irmin-pack/unix/gc.ml
index d314804bacb..46b330b7fe6 100644
--- a/src/irmin-pack/unix/gc.ml
+++ b/src/irmin-pack/unix/gc.ml
@@ -148,7 +148,7 @@ module Worker = struct
 
     let create_new_suffix ~root ~generation =
       let path = Irmin_pack.Layout.V3.suffix ~root ~generation in
-      let auto_flush_callback x = Ao.flush x |> Errs.raise_if_error in
+      let auto_flush_callback = Errs.raise_if_error in
       Ao.create_rw_exn ~path ~auto_flush_callback
 
     let run ~generation root commit_key =
@@ -233,7 +233,7 @@ module Worker = struct
         (* Step 4. Create the new prefix. *)
         let prefix =
           let path = Irmin_pack.Layout.V3.prefix ~root ~generation in
-          let auto_flush_callback x = Ao.flush x |> Errs.raise_if_error in
+          let auto_flush_callback = Errs.raise_if_error in
           Ao.create_rw_exn ~path ~auto_flush_callback
         in
         let () =
@@ -418,7 +418,7 @@ module Make (Args : Args) = struct
        0. *)
     let dead_header_size = 0 in
     let auto_flush_threshold = 1_000_000 in
-    let auto_flush_callback x = Ao.flush x |> Errs.raise_if_error in
+    let auto_flush_callback = Errs.raise_if_error in
     let* suffix =
       Ao.open_rw ~path ~end_offset ~dead_header_size ~auto_flush_callback
         ~auto_flush_threshold
diff --git a/src/irmin-pack/unix/mapping_file.ml b/src/irmin-pack/unix/mapping_file.ml
index 0585334332f..a92b71e559c 100644
--- a/src/irmin-pack/unix/mapping_file.ml
+++ b/src/irmin-pack/unix/mapping_file.ml
@@ -371,7 +371,7 @@ module Make (Io : Io.S) = struct
     Io.unlink path2 |> ignore;
 
     (* Create [file0] *)
-    let auto_flush_callback x = Ao.flush x |> Errs.raise_if_error in
+    let auto_flush_callback = Errs.raise_if_error in
     let* file0 =
       Ao.create_rw ~path:path0 ~overwrite:true ~auto_flush_threshold:1_000_000
         ~auto_flush_callback
@@ -404,7 +404,7 @@ module Make (Io : Io.S) = struct
     Io.unlink path0 |> ignore;
 
     (* Create [file2] *)
-    let auto_flush_callback x = Ao.flush x |> Errs.raise_if_error in
+    let auto_flush_callback = Errs.raise_if_error in
     let* file2 =
       Ao.create_rw ~path:path2 ~overwrite:true ~auto_flush_threshold:1_000_000
         ~auto_flush_callback