forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Use v instead of create in Progress module type S
Update module type S and its implementations (Active, Disabled)
to use 'v' constructor consistently.
+128
+57
lib/progress.ml
+57
lib/progress.ml
···
1
+
(** Progress reporting for sync operations.
2
+
3
+
Provides terminal progress indicators for long-running sync phases.
4
+
5
+
Note: For thread-safety during parallel operations, uses an atomic counter
6
+
that's rendered on each tick. *)
7
+
8
+
type t = {
9
+
progress : Tty.Progress.t;
10
+
completed : int Atomic.t;
11
+
total : int;
12
+
phase_name : string;
13
+
}
14
+
15
+
let v ~total phase_name =
16
+
let msg = Fmt.str "%s (0/%d)" phase_name total in
17
+
let progress = Tty.Progress.create ~total msg in
18
+
{ progress; completed = Atomic.make 0; total; phase_name }
19
+
20
+
let tick t name =
21
+
let n = Atomic.fetch_and_add t.completed 1 + 1 in
22
+
let msg = Fmt.str "%s: %s (%d/%d)" t.phase_name name n t.total in
23
+
Tty.Progress.message t.progress msg;
24
+
Tty.Progress.set t.progress n
25
+
26
+
let clear t = Tty.Progress.clear t.progress
27
+
let finish t = Tty.Progress.finish t.progress
28
+
29
+
(** Module signature for progress implementations *)
30
+
module type S = sig
31
+
type t
32
+
33
+
val v : total:int -> string -> t
34
+
val tick : t -> string -> unit
35
+
val clear : t -> unit
36
+
val finish : t -> unit
37
+
end
38
+
39
+
(** Active progress with terminal output *)
40
+
module Active : S with type t = t = struct
41
+
type nonrec t = t
42
+
43
+
let v = v
44
+
let tick = tick
45
+
let clear = clear
46
+
let finish = finish
47
+
end
48
+
49
+
(** Disabled progress (no terminal output) *)
50
+
module Disabled : S with type t = unit = struct
51
+
type t = unit
52
+
53
+
let v ~total:_ _ = ()
54
+
let tick () _ = ()
55
+
let clear () = ()
56
+
let finish () = ()
57
+
end
+71
lib/progress.mli
+71
lib/progress.mli
···
1
+
(** Progress reporting for sync operations.
2
+
3
+
Provides terminal progress indicators for long-running sync phases. Uses
4
+
{!Tty.Progress} for display when enabled, or no-op when disabled (quiet
5
+
mode, non-TTY output).
6
+
7
+
{2 Usage}
8
+
9
+
{[
10
+
let progress = Progress.v ~total:10 "Fetching" in
11
+
List.iter
12
+
(fun name ->
13
+
do_work name;
14
+
Progress.tick progress name)
15
+
items;
16
+
Progress.finish progress
17
+
]}
18
+
19
+
Or with the functor interface for conditional progress:
20
+
21
+
{[
22
+
let module P =
23
+
(val if show_progress then (module Progress.Active)
24
+
else (module Progress.Disabled) : Progress.S)
25
+
in
26
+
let p = P.v ~total "Fetching" in
27
+
...;
28
+
P.finish p
29
+
]} *)
30
+
31
+
type t
32
+
(** Progress state for a sync phase. *)
33
+
34
+
val v : total:int -> string -> t
35
+
(** [v ~total phase_name] creates progress for a phase with [total] items. Shows
36
+
as "[phase_name] (0/[total])" initially. *)
37
+
38
+
val tick : t -> string -> unit
39
+
(** [tick t name] increments progress and updates message to show [name]. *)
40
+
41
+
val clear : t -> unit
42
+
(** [clear t] clears the progress line without printing newline. *)
43
+
44
+
val finish : t -> unit
45
+
(** [finish t] completes the progress bar and prints newline. *)
46
+
47
+
(** {1 Abstract Interface}
48
+
49
+
For code that needs to conditionally enable progress. *)
50
+
51
+
module type S = sig
52
+
type t
53
+
54
+
val v : total:int -> string -> t
55
+
(** Create progress for a phase with the given total item count. *)
56
+
57
+
val tick : t -> string -> unit
58
+
(** Increment progress and update the displayed message. *)
59
+
60
+
val clear : t -> unit
61
+
(** Clear the progress line without printing a newline. *)
62
+
63
+
val finish : t -> unit
64
+
(** Complete the progress bar and print a newline. *)
65
+
end
66
+
67
+
module Active : S with type t = t
68
+
(** Active progress with terminal output. *)
69
+
70
+
module Disabled : S with type t = unit
71
+
(** Disabled progress (no terminal output). *)