From 5e54b9db3c9a354c62509a0c661cd5b13fcf539b Mon Sep 17 00:00:00 2001 From: ArthurW Date: Mon, 11 Sep 2023 15:40:45 +0200 Subject: [PATCH 1/2] Update to ocamlformat.0.26.1 --- .ocamlformat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.ocamlformat b/.ocamlformat index f5c5d853..1749d9a7 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.25.1 +version = 0.26.1 profile = conventional ocaml-version = 4.08 From 4daf3f43a99dca7615d2b56c24820843b688e245 Mon Sep 17 00:00:00 2001 From: ArthurW Date: Fri, 8 Sep 2023 18:41:01 +0200 Subject: [PATCH 2/2] Mirage support: unix dependency is optional --- CHANGES.md | 1 + bench/bench.ml | 2 +- bench/dune | 4 ++-- bench/replay.ml | 2 +- src/checks.ml | 8 ++++++-- src/checks_intf.ml | 2 ++ src/dune | 2 +- src/index_intf.ml | 2 ++ src/log.ml | 7 ++++--- src/log.mli | 6 +++++- src/platform.ml | 7 +++++++ src/unix/buffer.ml | 2 +- src/unix/dune | 5 +++-- src/unix/index_unix.ml | 3 +++ src/unix/index_unix.mli | 1 + src/unix/raw.ml | 2 +- test/cli/dune | 4 ++-- test/unix/common.ml | 4 +++- test/unix/dune | 2 +- 19 files changed, 47 insertions(+), 19 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e5d81020..8dd8636a 100644 --- a/CHANGES.md +++ b/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) diff --git a/bench/bench.ml b/bench/bench.ml index 6ceb197e..4c8e31ab 100644 --- a/bench/bench.ml +++ b/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 diff --git a/bench/dune b/bench/dune index e284a36a..33a8236a 100644 --- a/bench/dune +++ b/bench/dune @@ -1,7 +1,7 @@ (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) @@ -9,7 +9,7 @@ (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) diff --git a/bench/replay.ml b/bench/replay.ml index 9d41c981..86feb426 100644 --- a/bench/replay.ml +++ b/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) diff --git a/src/checks.ml b/src/checks.ml index 1dfd17ae..3d447025 100644 --- a/src/checks.ml +++ b/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" ); diff --git a/src/checks_intf.ml b/src/checks_intf.ml index 76b0b66d..f90d836a 100644 --- a/src/checks_intf.ml +++ b/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 diff --git a/src/dune b/src/dune index 3b080efb..454f0026 100644 --- a/src/dune +++ b/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))) diff --git a/src/index_intf.ml b/src/index_intf.ml index bbbb882d..0ed8d11e 100644 --- a/src/index_intf.ml +++ b/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 diff --git a/src/log.ml b/src/log.ml index b643e5db..876ec49f 100644 --- a/src/log.ml +++ b/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 diff --git a/src/log.mli b/src/log.mli index 5cafe790..5b1dfa74 100644 --- a/src/log.mli +++ b/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 diff --git a/src/platform.ml b/src/platform.ml index e592045e..99a49395 100644 --- a/src/platform.ml +++ b/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 diff --git a/src/unix/buffer.ml b/src/unix/buffer.ml index 2dce21ee..f6e45df0 100644 --- a/src/unix/buffer.ml +++ b/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 } diff --git a/src/unix/dune b/src/unix/dune index 11dc1a42..b77c4f38 100644 --- a/src/unix/dune +++ b/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)) diff --git a/src/unix/index_unix.ml b/src/unix/index_unix.ml index 76b874a0..37953031 100644 --- a/src/unix/index_unix.ml +++ b/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 diff --git a/src/unix/index_unix.mli b/src/unix/index_unix.mli index 0e549273..a6d8ffec 100644 --- a/src/unix/index_unix.mli +++ b/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 diff --git a/src/unix/raw.ml b/src/unix/raw.ml index 39245e57..f3f52643 100644 --- a/src/unix/raw.ml +++ b/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 diff --git a/test/cli/dune b/test/cli/dune index 900a911e..b3982c5e 100644 --- a/test/cli/dune +++ b/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) diff --git a/test/unix/common.ml b/test/unix/common.ml index 21514379..f4fc3f7a 100644 --- a/test/unix/common.ml +++ b/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 diff --git a/test/unix/dune b/test/unix/dune index 65de8482..8fca5ae2 100644 --- a/test/unix/dune +++ b/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))