Merge pull request #396 from art-w/mirage-io

Mirage support: make unix dependency optional

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.25.1
+version = 0.26.1
 profile = conventional
 
 ocaml-version = 4.08

CHANGES.md

@@ -4,6 +4,7 @@
 
 - Lock files are now opened with O_CLOEXEC flag (#394, @vect0r-vicall)
 - Update to cmdliner.1.1.0 (#382, @MisterDA)
+- Mirage support: optional dependency to unix (#396, @art-w)
 
 # 1.6.2 (2023-06-06)
 

bench/bench.ml

@@ -642,7 +642,7 @@ let cmd =
   let doc = "Run all the benchmarks." in
   ( Term.(
       const (fun () -> run)
-      $ Index_lib.Private.Logs.setup_term (module Mtime_clock)
+      $ Index_lib.Private.Logs.setup_term (module Mtime_clock) (module Fmt_tty)
       $ name_filter
       $ data_dir
       $ output

bench/dune

@@ -1,15 +1,15 @@
 (library
  (name common)
  (modules common)
- (libraries progress logs fmt mtime mtime.clock.os))
+ (libraries progress logs fmt mtime mtime.clock.os unix))
 
 (executable
  (name bench)
  (modules bench)
  (preprocess
   (pps ppx_repr ppx_deriving_yojson))
  (libraries index index.unix cmdliner metrics metrics-unix yojson fmt re
-   stdlib-shims common mtime mtime.clock.os))
+   stdlib-shims common mtime mtime.clock.os unix))
 
 (alias
  (name bench)

bench/replay.ml

@@ -262,7 +262,7 @@ let trace_data_file =
 let main_term =
   Term.(
     const (fun () -> main)
-    $ Index_lib.Private.Logs.setup_term (module Mtime_clock)
+    $ Index_lib.Private.Logs.setup_term (module Mtime_clock) (module Fmt_tty)
     $ nb_ops
     $ trace_data_file)
 

src/checks.ml

@@ -174,10 +174,14 @@ module Make (K : Data.Key) (V : Data.Value) (Platform : Platform_args) = struct
       in
       let commands =
         [
-          ( Term.(Stat.term $ Log.setup_term ~reporter (module Clock)),
+          ( Term.(
+              Stat.term
+              $ Log.setup_term ~reporter (module Clock) (module Fmt_tty)),
             Cmd.info ~doc:"Print high-level statistics about the store." "stat"
           );
-          ( Term.(Integrity_check.term $ Log.setup_term ~reporter (module Clock)),
+          ( Term.(
+              Integrity_check.term
+              $ Log.setup_term ~reporter (module Clock) (module Fmt_tty)),
             Cmd.info
               ~doc:"Search the store for integrity faults and corruption."
               "integrity-check" );

src/checks_intf.ml

@@ -28,6 +28,8 @@ end
 module type Platform_args = sig
   module IO : Io.S
   module Clock : Platform.CLOCK
+  module Progress : Progress_engine.S
+  module Fmt_tty : Platform.FMT_TTY
 end
 
 module type Checks = sig

src/dune

@@ -2,6 +2,6 @@
  (public_name index)
  (name index)
  (libraries logs fmt stdlib-shims mtime cmdliner logs.fmt logs.cli fmt.cli
-   fmt.tty jsonm progress repr ppx_repr optint lru)
+   jsonm progress.engine repr ppx_repr optint lru)
  (preprocess
   (pps ppx_repr)))

src/index_intf.ml

@@ -323,11 +323,13 @@ module type Index = sig
         ?style_renderer:Fmt.style_renderer ->
         ?level:Logs.level ->
         (module Platform.CLOCK) ->
+        (module Platform.FMT_TTY) ->
         unit
 
       val setup_term :
         ?reporter:Logs.reporter ->
         (module Platform.CLOCK) ->
+        (module Platform.FMT_TTY) ->
         unit Cmdliner.Term.t
     end
 

src/log.ml

@@ -42,7 +42,8 @@ let default_reporter (type c) ?(prefix = "")
   in
   { Logs.report }
 
-let setup ?reporter ?style_renderer ?level (module Clock : Platform.CLOCK) =
+let setup ?reporter ?style_renderer ?level (module Clock : Platform.CLOCK)
+    (module Fmt_tty : Platform.FMT_TTY) =
   let start_time = Clock.counter () in
   let reporter =
     match reporter with
@@ -59,7 +60,7 @@ open Cmdliner
 let ( let+ ) t f = Term.(const f $ t)
 let ( and+ ) a b = Term.(const (fun x y -> (x, y)) $ a $ b)
 
-let setup_term ?reporter (module Clock : Platform.CLOCK) =
+let setup_term ?reporter clock fmt_tty =
   let+ style_renderer = Fmt_cli.style_renderer ()
   and+ level = Logs_cli.level () in
-  setup ?reporter ?style_renderer ?level (module Clock : Platform.CLOCK)
+  setup ?reporter ?style_renderer ?level clock fmt_tty

src/log.mli

@@ -22,7 +22,11 @@ val setup :
   ?style_renderer:Fmt.style_renderer ->
   ?level:Logs.level ->
   (module Platform.CLOCK) ->
+  (module Platform.FMT_TTY) ->
   unit
 
 val setup_term :
-  ?reporter:Logs.reporter -> (module Platform.CLOCK) -> unit Cmdliner.Term.t
+  ?reporter:Logs.reporter ->
+  (module Platform.CLOCK) ->
+  (module Platform.FMT_TTY) ->
+  unit Cmdliner.Term.t

src/platform.ml

@@ -58,9 +58,16 @@ module type THREAD = sig
   (** Re-schedule the calling thread without suspending it. *)
 end
 
+module type FMT_TTY = sig
+  val setup_std_outputs :
+    ?style_renderer:Fmt.style_renderer -> ?utf_8:bool -> unit -> unit
+end
+
 module type S = sig
   module IO : IO
   module Semaphore : SEMAPHORE
   module Thread : THREAD
   module Clock : CLOCK
+  module Progress : Progress_engine.S
+  module Fmt_tty : FMT_TTY
 end

src/unix/buffer.ml

@@ -18,7 +18,7 @@ type t = { mutable buffer : bytes; mutable position : int }
 
 external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
   = "caml_blit_string"
-  [@@noalloc]
+[@@noalloc]
 (** Bytes.unsafe_blit_string not available in OCaml 4.08. *)
 
 let create n = { buffer = Bytes.create n; position = 0 }

src/unix/dune

@@ -4,5 +4,6 @@
   (names pread pwrite))
  (public_name index.unix)
  (name index_unix)
- (libraries fmt index logs logs.threaded threads.posix unix semaphore-compat
-   mtime mtime.clock.os optint))
+ (optional)
+ (libraries fmt fmt.tty index logs logs.threaded threads.posix unix
+   semaphore-compat mtime mtime.clock.os optint progress))

src/unix/index_unix.ml

@@ -417,6 +417,8 @@ module Platform = struct
   module Semaphore = Semaphore
   module Thread = Thread
   module Clock = Mtime_clock
+  module Progress = Progress
+  module Fmt_tty = Fmt_tty
 end
 
 module Make (K : Index.Key.S) (V : Index.Value.S) =
@@ -425,6 +427,7 @@ module Make (K : Index.Key.S) (V : Index.Value.S) =
 module Syscalls = Syscalls
 
 module Private = struct
+  module Platform = Platform
   module IO = IO
   module Raw = Raw
 

src/unix/index_unix.mli

@@ -26,6 +26,7 @@ module Syscalls = Syscalls
 (** These modules should not be used. They are exposed purely for testing
     purposes. *)
 module Private : sig
+  module Platform : Index.Platform.S
   module IO : Index.Platform.IO
   module Raw = Raw
 

src/unix/raw.ml

@@ -61,7 +61,7 @@ let assert_read ~len n =
       Printf.eprintf "Attempted to read %d bytes, but got %d bytes instead!\n%!"
         len n;
       false))
-  [@@inline always]
+[@@inline always]
 
 module Offset = struct
   let off = Int63.zero

test/cli/dune

@@ -1,12 +1,12 @@
 (executable
  (name index_fsck)
  (modules index_fsck)
- (libraries index index.unix))
+ (libraries index index.unix unix))
 
 (executable
  (name generate)
  (modules generate)
- (libraries index index.unix))
+ (libraries index index.unix unix))
 
 (rule
  (alias generate-cli-test-data)

test/unix/common.ml

@@ -5,7 +5,9 @@ module Log = (val Logs.src_log src : Logs.LOG)
 
 let report () =
   Logs_threaded.enable ();
-  Index.Private.Logs.setup ~level:Logs.Debug (module Mtime_clock)
+  Index.Private.Logs.setup ~level:Logs.Debug
+    (module Mtime_clock)
+    (module Fmt_tty)
 
 module String_size = struct
   let length = 20

test/unix/dune

@@ -1,5 +1,5 @@
 (tests
  (names main force_merge io_array)
  (package index)
- (libraries index index.unix alcotest fmt logs logs.fmt re stdlib-shims
+ (libraries index index.unix unix alcotest fmt logs logs.fmt re stdlib-shims
    threads.posix repr semaphore-compat optint mtime.clock.os))