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
open! Import
type 'a reporter = 'a -> unit
module type S = sig
type 'a line
type 'a reporter
type ('a, 'b) t
(** The type of vertical {i sequences} of progress bars. The parameter ['a]
stores a list of the reporting functions associated with each bar,
terminating with ['b]. For example:
{[
(* Single progress bar, taking a [float] value. *)
(float reporter -> 'b, 'b) t
(* A two-bar layout, where the top bar takes [int64]s and the bottom one
takes [string * float] pairs. *)
(int64 reporter -> (string * float) reporter -> 'b, 'b) t
]}
These reporting functions are supplied when beginning the
{{!rendering} rendering} process. *)
val line : 'a line -> ('a reporter -> 'b, 'b) t
(** Construct a multiple-line layout from a single progress bar line. *)
val lines : 'a line list -> ('a reporter list -> 'b, 'b) t
(** Construct a multiple-line layout from a sequence of lines that all have
the same type of reported values. *)
val ( ++ ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
(** Stack progress bars vertically. [a ++ b] is a set with [a] stacked on top
of [b]. The two sections have separate reporting functions, passed
consecutively to the {!with_reporters} continuation when rendering. *)
val blank : ('a, 'a) t
(** A blank line, for adding spacing between progress lines. *)
end
module Hlist (Elt : sig
type 'a t
end) =
struct
type (_, _) t =
| Zero : ('a, 'a) t
| One : 'a Elt.t -> ('a reporter -> 'b, 'b) t
| Many : 'a Elt.t list -> ('a reporter list -> 'b, 'b) t
| Plus : (('a, 'b) t * ('b, 'c) t) -> ('a, 'c) t
type 'b mapper = { f : 'a. int -> 'a Elt.t option -> 'b }
let mapi =
let rec aux : type a b c. (a, b) t -> int -> f:c mapper -> int * c list =
fun t i ~f ->
match t with
| Zero -> (succ i, [ f.f i None ])
| One b -> (succ i, [ f.f i (Some b) ])
| Many bs ->
( i + List.length bs
, List.mapi bs ~f:(fun i' x -> f.f (i + i') (Some x)) )
| Plus (xs, ys) ->
let i, xs = aux xs ~f i in
let i, ys = aux ys ~f i in
(i, xs @ ys)
in
fun t ~f -> snd (aux t 0 ~f)
let rec length : type a b. (a, b) t -> int = function
| Zero -> 1
| One _ -> 1
| Many xs -> List.length xs
| Plus (a, b) -> length a + length b
let ( ++ ) xs ys = Plus (xs, ys)
end
module type Multi = sig
module type S = S
module Hlist = Hlist
include
S
with type 'a line := 'a Line.t
and type 'a reporter := 'a -> unit
and type ('a, 'b) t = ('a, 'b) Hlist(Line).t
end