From 421d281fc17fefb0040e22d201c658a38ff26083 Mon Sep 17 00:00:00 2001
From: vbot <vincent.botbol@inria.fr>
Date: Mon, 17 Jun 2024 15:36:38 +0200
Subject: [PATCH] Add delayed errors in Message

---
 compiler/catala_utils/message.ml  | 29 +++++++++++++++++++++++++++++
 compiler/catala_utils/message.mli | 15 +++++++++++++--
 2 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml
index 1b977d3f..4275aee9 100644
--- a/compiler/catala_utils/message.ml
+++ b/compiler/catala_utils/message.ml
@@ -327,6 +327,7 @@ open Content
 (** {1 Error exception} *)
 
 exception CompilerError of Content.t
+exception CompilerErrors of Content.t list
 
 (** {1 Error printing} *)
 
@@ -404,3 +405,31 @@ let result = make ~level:Result ~cont:emit
 let results r = emit (List.flatten (List.map of_result r)) Result
 let warning = make ~level:Warning ~cont:emit
 let error = make ~level:Error ~cont:(fun m _ -> raise (CompilerError m))
+
+(* Multiple errors handling *)
+let global_errors = ref None
+
+let delayed_error x =
+  make ~level:Error ~cont:(fun m _ ->
+      match !global_errors with
+      | None ->
+        failwith
+          "delayed error called outside scope: encapsulate using \
+           'with_delayed_errors' first"
+      | Some l ->
+        global_errors := Some (m :: l);
+        x)
+
+let with_delayed_errors (f : unit -> 'a) : 'a =
+  (match !global_errors with
+  | None -> global_errors := Some []
+  | Some _ -> failwith "delayed error scope already initialized");
+  let r = f () in
+  match !global_errors with
+  | None -> assert false
+  | Some [] ->
+    global_errors := None;
+    r
+  | Some errs ->
+    global_errors := None;
+    raise (CompilerErrors (List.rev errs))
diff --git a/compiler/catala_utils/message.mli b/compiler/catala_utils/message.mli
index 26bb8676..d1204ec9 100644
--- a/compiler/catala_utils/message.mli
+++ b/compiler/catala_utils/message.mli
@@ -60,9 +60,10 @@ end
 (** This functions emits the message according to the emission type defined by
     [Cli.message_format_flag]. *)
 
-(** {1 Error exception} *)
+(** {1 Error exceptions} *)
 
 exception CompilerError of Content.t
+exception CompilerErrors of Content.t list
 
 (** {1 Some formatting helpers}*)
 
@@ -98,5 +99,15 @@ val log : ('a, unit) emitter
 val debug : ('a, unit) emitter
 val result : ('a, unit) emitter
 val warning : ('a, unit) emitter
-val error : ('a, 'b) emitter
+val error : ('a, 'exn) emitter
 val results : Content.message list -> unit
+
+(** Multiple errors *)
+
+val with_delayed_errors : (unit -> 'a) -> 'a
+(** [with_delayed_errors f] calls [f] and registers each error triggered using
+    [delayed_error].
+
+    @raise CompilerErrors when delayed errors were registered. *)
+
+val delayed_error : 'b -> ('a, 'b) emitter