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
open Util
type 'a t =
| E of
{ msg : string
; context : 'a option
}
| Tag of string * 'a t
| Group of 'a t list
let make ?context msg = E { msg; context }
let tag msg e = Tag (msg, e)
let group es = Group es
let tag_group msg es = tag msg (group es)
let rec pp pp_context fmt =
let open Format in
function
| E { msg; context = None } ->
fprintf fmt "@[%s@]" msg
| E { msg; context = Some context } ->
fprintf fmt "@[%s, but got@ @[%a@]@]" msg pp_context context
| Tag (msg, e) ->
fprintf fmt "@[<2>%s:@ %a@]" msg (pp pp_context) e
| Group es ->
let max_errors = 5 in
let es_trunc = My_list.take max_errors es in
let not_shown = List.length es - max_errors in
fprintf
fmt
"@[%a %s@]"
(Format.pp_print_list ~pp_sep:Format.pp_print_space (pp pp_context))
es_trunc
( if not_shown > 0
then Printf.sprintf "(...%d errors not shown...)" not_shown
else "" )
let to_string pp_context t = Format.asprintf "@[<2>%a@?@]" (pp pp_context) t
let map_tag f = function Tag (s, e) -> Tag (f s, e) | e -> e
let rec map_context f = function
| E { msg; context } ->
E { msg; context = My_opt.map f context }
| Tag (s, e) ->
Tag (s, map_context f e)
| Group es ->
Group (My_list.map (map_context f) es)