From cd26e3d3a347a1f6d31d1f61c39a8a2c2cd75bbd Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 28 Jan 2020 13:02:39 -0600
Subject: [PATCH] IO: add `copy_into` for transferring data between channels

---
 src/core/CCIO.ml  | 29 +++++++++++++++++++++++++++++
 src/core/CCIO.mli |  5 +++++
 2 files changed, 34 insertions(+)

diff --git a/src/core/CCIO.ml b/src/core/CCIO.ml
index e78e2d8a..b13f68b7 100644
--- a/src/core/CCIO.ml
+++ b/src/core/CCIO.ml
@@ -219,6 +219,35 @@ let with_in_out ?(mode=0o644) ?(flags=[Open_creat]) filename f =
     close_in_noerr ic;
     raise e
 
+let copy_into ?(bufsize=4_096) ic oc : unit =
+  let buf = Bytes.create bufsize in
+  let cont = ref true in
+  while !cont do
+    let n = input ic buf 0 bufsize in
+    if n > 0 then (
+      output oc buf 0 n;
+    ) else (
+      cont := false
+    )
+  done
+
+(*$QR
+   Q.(list_of_size Gen.(0 -- 40) printable_string) (fun l ->
+     let s = ref "" in
+     OUnit.bracket_tmpfile ~prefix:"test_containers1" ~mode:[Open_creat; Open_trunc]
+      (fun (name1, oc1) ->
+        write_gen ~sep:"" oc1 (Gen.of_list l);
+        flush oc1;
+        OUnit.bracket_tmpfile ~prefix:"test_containers2" ~mode:[Open_creat; Open_trunc]
+          (fun (name2, oc2) ->
+             CCIO.with_in name1 (fun ic1 -> copy_into ic1 oc2);
+             flush oc2;
+             s := with_in name2 read_all;) ();
+      ) ();
+     String.concat "" l = !s
+    )
+*)
+
 let tee funs g () = match g() with
   | None -> None
   | Some x as res ->
diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli
index 23348307..f7ec3a3b 100644
--- a/src/core/CCIO.mli
+++ b/src/core/CCIO.mli
@@ -139,6 +139,11 @@ val with_in_out : ?mode:int -> ?flags:open_flag list ->
     @raise Sys_error in case of error.
     @since 0.12 *)
 
+val copy_into : ?bufsize:int -> in_channel -> out_channel -> unit
+(** [copy_into ic oc] writes the content of [ic] into [oc].
+    It is a blocking call.
+    @since NEXT_RELEASE *)
+
 (** {2 Misc for Generators} *)
 
 val tee : ('a -> unit) list -> 'a gen -> 'a gen