From ec4c1a260efe58d38237cefe13dd98895cc51836 Mon Sep 17 00:00:00 2001
From: vbot <vincent.botbol@inria.fr>
Date: Tue, 15 Oct 2024 12:03:58 +0200
Subject: [PATCH] Globals: add an LSP message format kind

---
 compiler/catala_utils/global.ml  |  2 +-
 compiler/catala_utils/global.mli |  5 ++---
 compiler/catala_utils/message.ml | 13 +++++++++++++
 3 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/compiler/catala_utils/global.ml b/compiler/catala_utils/global.ml
index 5257d84f..2c693e24 100644
--- a/compiler/catala_utils/global.ml
+++ b/compiler/catala_utils/global.ml
@@ -18,7 +18,7 @@ type file = string
 type raw_file = file
 type backend_lang = En | Fr | Pl
 type when_enum = Auto | Always | Never
-type message_format_enum = Human | GNU
+type message_format_enum = Human | GNU | Lsp
 
 type 'file input_src =
   | FileName of 'file
diff --git a/compiler/catala_utils/global.mli b/compiler/catala_utils/global.mli
index c6fd7ad0..f996be15 100644
--- a/compiler/catala_utils/global.mli
+++ b/compiler/catala_utils/global.mli
@@ -29,9 +29,8 @@ type backend_lang = En | Fr | Pl
 (** The usual auto/always/never option argument *)
 type when_enum = Auto | Always | Never
 
-type message_format_enum =
-  | Human
-  | GNU  (** Format of error and warning messages output by the compiler. *)
+(** Format of error and warning messages output by the compiler. *)
+type message_format_enum = Human | GNU | Lsp
 
 (** Sources for program input *)
 type 'file input_src =
diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml
index 1b8ed23e..4c2ef3cc 100644
--- a/compiler/catala_utils/message.ml
+++ b/compiler/catala_utils/message.ml
@@ -317,6 +317,18 @@ module Content = struct
       ppf content;
     Format.pp_print_newline ppf ()
 
+  let lsp_msg ppf content =
+    (* Hypothesis: [MainMessage] is always part of a content list. *)
+    let rec retrieve_message acc = function
+      | [] -> acc
+      | MainMessage m :: _ -> Some m
+      | Outcome m :: t ->
+        retrieve_message (match acc with None -> Some m | _ -> acc) t
+      | (Position _ | Suggestion _) :: t -> retrieve_message acc t
+    in
+    let msg = retrieve_message None content in
+    Option.iter (fun msg -> Format.fprintf ppf "%s" (unformat msg)) msg
+
   let emit ?ppf ?(pp_marker = pp_marker) (content : t) (target : level) : unit =
     let ppf = Option.value ~default:(get_ppf target) ppf in
     match Global.options.message_format with
@@ -325,6 +337,7 @@ module Content = struct
       | Debug | Log -> basic_msg ~pp_marker ppf target content
       | Result | Warning | Error -> fancy_msg ~pp_marker ppf target content)
     | GNU -> gnu_msg ~pp_marker ppf target content
+    | Lsp -> lsp_msg ppf content
 
   let emit_n ?ppf (target : level) = function
     | [content] -> emit content target