1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
open! Import
type 'a reporter = 'a -> unit
module type S = sig
type 'a reporter
type 'a line
type ('a, 'b) multi
type config
val with_reporter : ?config:config -> 'a line -> ('a reporter -> 'b) -> 'b
(** [with_reporters line f] begins rendering [line] and calls [f] with the
reporting function. Once [f] returns, the display is finalised. {b Note:}
attempting to use the reporting function after [f] has returned will raise
a [Finalised] exception. *)
val with_reporters : ?config:config -> ('a, 'b) multi -> 'a -> 'b
(** [with_reporters bars f] begins rendering [bars] and passes the
corresponding reporting functions to [f]. Once [f] returns, the display is
finalised. *)
(** {2 Examples}
- Reading a file into memory and displaying a single progress bar:
{[
let read_file path buffer =
let total = file_size path and in_channel = open_in path in
try
with_reporter (counter ~total ()) @@ fun report ->
let rec aux offset =
let bytes_read = really_read buffer offset in
report bytes_read;
aux (offset + bytes_read)
in
aux 0
with End_of_file -> close_in in_channel
]}
- Sending data to multiple clients, with one progress bar each:
{[
let multi_bar_rendering () =
with_reporters
Multi.(line bar_a ++ line bar_b ++ line bar_c)
(fun report_a report_b report_c ->
for i = 1 to 1000 do
report_a (transfer_bytes client_a);
report_b (transfer_bytes client_b);
report_c (transfer_bytes client_c)
done)
]} *)
(** {2 Logging during rendering} *)
val interject_with : (unit -> 'a) -> 'a
(** [interject_with f] executes the function [f] while temporarily suspending
the rendering of any active progress bar display. This can be useful when
printing to [stdout] / [stderr], to avoid any interference from the
rendering of progress bars. If using the [Logs] library, consider using
{!reporter} and {!instrument_reporter} instead.
{b Note}:
{i the caller must ensure that the terminal cursor is left in an
appropriate position to resume rendering. In practice, this means that
any printing to the terminal should be terminated with a newline
character and flushed.} *)
(** Extensions to the {{:https://erratique.ch/software/logs} [Logs]} library
designed to cooperate with progress bar rendering: *)
val logs_reporter :
?pp_header:(Logs.level * string option) Fmt.t
-> ?app:Format.formatter
-> ?dst:Format.formatter
-> unit
-> Logs.reporter
(** [reporter] is like [Logs_fmt.reporter] but produces a reporter that
{{!Progress.interject_with} suspends} any ongoing progress bar rendering
while displaying log entries, ensuring that log entries in the terminal
are never overwritten by the renderer. *)
val instrument_logs_reporter : Logs.reporter -> Logs.reporter
(** [instrument_reporter r] wraps the synchronous reporter [r] to ensure that
any progress bar rendering is suspended while messages are being
constructed for [r].
{b Note}:
{i to ensure that log entries are not overwritten by the [Progress]
renderer, [r] must flush any log entries to the terminal synchronously:
as soon as they are reported. This is true of the [Logs] reporters
built by {!Logs.format_reporter} and {!Logs_fmt.reporter}. An
asynchronous reporter should use {!interject_with} to delimit its
flushing action instead.} *)
(** {2 Manual lifecycle management}
Functions for explicitly starting and stopping the process of rendering a
bar; useful when the code doing the progress reporting cannot be
conveniently delimited inside {!with_reporter}. All {!Display}s must be
properly {{!Display.finalise} finalised}, and it is not possible to
interleave rendering of displays. *)
module Reporter : sig
type -'a t
(** The (abstract) type of reporter functions used by the manual lifecycle
management functions in {!Display}. An ['a t] is conceptually an
['a -> unit] function, but can be explicitly {!finalise}d. *)
val report : 'a t -> 'a -> unit
val finalise : _ t -> unit
(** [finalise t] terminates rendering of the line associated with reporter
[t]. Attempting to {!report} to a finalised reporter will raise an
exception. *)
(** A heterogeneous list type, used by {!Display} for returning a list of
reporters corresponding to multi-line progress displays. *)
type (_, _) list =
| [] : ('a, 'a) list
| ( :: ) : 'a * ('b, 'c) list -> ('a -> 'b, 'c) list
end
module Display : sig
type ('a, 'b) t
(** The type of active progress bar displays. The type parameters ['a] and
['b] track the types of the reporting functions supplied by {!reporters}
(see {!Multi.t} for details).*)
val start : ?config:config -> ('a, 'b) multi -> ('a, 'b) t
(** Initiate rendering of a progress bar display. Raises [Failure] if there
is already an active progress bar display. *)
val reporters : ('a, unit) t -> ('a, unit) Reporter.list
(** [reporters d] is the list of initial reporting functions belonging to
display [d].
{b Note}
{i this list does not include any reporters added {i during} progress
bar rendering via {!add_line}.} *)
val tick : _ t -> unit
(** [tick d] re-renders the contents of display [d] without reporting any
specific values. This function can be used to update spinners,
durations, etc. when there is no actual progress to report. *)
val add_line : ?above:int -> (_, _) t -> 'a line -> 'a Reporter.t
(** Add a line to an ongoing display, and get its reporting function. By
default, the line is added to the {i bottom} of the display
([above = 0]); the [~above] argument can be passed to add the line above
some number of existing lines. *)
val remove_line : (_, _) t -> _ Reporter.t -> unit
(** Remove a line from an ongoing display, identified by the reporting
function that was returned by [add_line]. Lines may be removed either
before they are finalised (for example if some task has been cancelled)
or after being finalised. In both cases, the line will be removed from
the display, thus retrieving some space in the terminal. Attempting to
remove a line that has already been removed from the display will raise
[Failure]. Also raises [Failure] if the display has already been
finalised. *)
val pause : (_, _) t -> unit
(** Suspends the rendering of any active progress bar display. It can be
useful to compose with the [Logs] library and avoid interference when
printing to [stdout] / [stderr] from the rendering of progress bars. *)
val resume : (_, _) t -> unit
(** Resume the rendering of progress bar display. *)
val finalise : (_, _) t -> unit
(** Terminate the given progress bar display. Raises [Failure] if the
display has already been finalised. *)
end
end
module type Renderer = sig
module type S = S
module Make (_ : Platform.S) :
S
with type 'a reporter := 'a reporter
and type 'a line := 'a Line.t
and type ('a, 'b) multi := ('a, 'b) Multi.t
and type config := Config.user_supplied
end