Geotessera library for OCaml
patrick.sirref.org
1module Int63 = Optint.Int63
2
3(* FIXME: the None type is probably not needed with switch cancellation *)
4type t = {
5 stream : (unit -> unit) option Eio.Stream.t;
6 display : ((unit -> unit) -> unit, unit) Progress.Display.t;
7}
8
9type line = Int63.t Progress.Line.t
10
11type reporter = {
12 stream : (unit -> unit) option Eio.Stream.t;
13 reporter : Int63.t Progress.Reporter.t option;
14}
15
16let report r i =
17 match r.reporter with
18 | None -> ()
19 | Some reporter ->
20 Eio.Stream.add r.stream
21 (Some (fun () -> Progress.Reporter.report reporter i))
22
23let report_int r i = report r (Int63.of_int i)
24
25let line ~color ~total message =
26 let message = String.sub message 0 (min 21 (String.length message)) in
27 let open Progress.Line.Using_int63 in
28 list
29 [
30 rpad 22 (const message);
31 bytes;
32 bytes_per_sec;
33 bar ~color ~style:`UTF8 total;
34 percentage_of total ++ const " ";
35 ]
36
37let colors =
38 let a =
39 [
40 "#1996f3";
41 "#06aeed";
42 "#10c6e6";
43 "#27dade";
44 "#3dead5";
45 "#52f5cb";
46 "#66fcc2";
47 "#7dffb6";
48 "#92fda9";
49 "#a8f79c";
50 "#bced8f";
51 "#d2de81";
52 "#e8cb72";
53 "#feb562";
54 "#ff9b52";
55 "#ff8143";
56 "#ff6232";
57 "#ff4121";
58 ]
59 in
60 Array.map Progress.Color.hex (Array.of_list (a @ List.rev a))
61
62let next_color i = colors.(i mod Array.length colors)
63
64let line ~total file =
65 let color = next_color (Random.int (Array.length colors)) in
66 line ~color ~total file
67
68let rec apply_stream ~sw stream =
69 Eio.Switch.check sw;
70 match Eio.Stream.take stream with
71 | Some f ->
72 f ();
73 apply_stream ~sw stream
74 | None -> ()
75
76let init ?platform ~sw image : t =
77 let image_name =
78 Progress.Line.(
79 spacer 4
80 ++ constf "🐫 Fetching %a" Fmt.(styled `Bold string) image
81 ++
82 match platform with
83 | None -> const ""
84 | Some p -> constf "%a" Fmt.(styled `Faint (brackets string)) p)
85 in
86 let stream = Eio.Stream.create max_int in
87 let display = Progress.Display.start Progress.Multi.(line image_name) in
88 Eio.Fiber.fork ~sw (fun () -> apply_stream ~sw stream);
89 { stream; display }
90
91let rec empty_stream stream =
92 match Eio.Stream.take_nonblocking stream with
93 | None | Some None -> ()
94 | Some (Some f) ->
95 f ();
96 empty_stream stream
97
98let finalise { stream; display } =
99 Eio.Stream.add stream None;
100 empty_stream stream;
101 Progress.Display.finalise display
102
103let lines = ref 0
104
105let with_line ~display ?(show = true) bar f =
106 let reporter =
107 if show then (
108 let r = Progress.Display.add_line display.display (bar !lines) in
109 incr lines;
110 Some r)
111 else None
112 in
113 let finally () =
114 match reporter with
115 | None -> ()
116 | Some r ->
117 Eio.Stream.add display.stream
118 (Some (fun () -> Progress.Reporter.finalise r))
119 in
120 Fun.protect ~finally (fun () -> f { reporter; stream = display.stream })