Coded message format adapted to editors

compiler/catala_utils/cli.ml

@@ -98,6 +98,10 @@ let disable_counterexamples = ref false
 let avoid_exceptions_flag = ref false
 let check_invariants_flag = ref false
 
+type message_format_enum = Human | EditorParsable
+
+let message_format_flag = ref Human
+
 open Cmdliner
 
 let file =
@@ -122,6 +126,20 @@ let color =
           "Allow output of colored and styled text. If set to $(i,auto), \
            enabled when the standard output is to a terminal.")
 
+let message_format_opt = Arg.enum ["human", Human; "editor", EditorParsable]
+
+let message_format =
+  Arg.(
+    value
+    & opt ~vopt:Human message_format_opt Human
+    & info ["message_format"]
+        ~doc:
+          "Selects the format of error and warning messages emitted by the \
+           compiler. If set to $(i,human), the messages will be nicely \
+           displayed and meant to be read by a human. If set to $(i, editor), \
+           the messages will be rendered in a way that is easily parsable by \
+           IDEs.")
+
 let unstyled =
   Arg.(
     value
@@ -263,6 +281,7 @@ let output =
 type options = {
   debug : bool;
   color : when_enum;
+  message_format : message_format_enum;
   wrap_weaved_output : bool;
   avoid_exceptions : bool;
   backend : string;
@@ -285,6 +304,7 @@ let options =
   let make
       debug
       color
+      message_format
       unstyled
       wrap_weaved_output
       avoid_exceptions
@@ -305,6 +325,7 @@ let options =
     {
       debug;
       color = (if unstyled then Never else color);
+      message_format;
       wrap_weaved_output;
       avoid_exceptions;
       backend;
@@ -327,6 +348,7 @@ let options =
     const make
     $ debug
     $ color
+    $ message_format
     $ unstyled
     $ wrap_weaved_output
     $ avoid_exceptions
@@ -362,7 +384,8 @@ let set_option_globals options : unit =
   optimize_flag := options.optimize;
   check_invariants_flag := options.check_invariants;
   disable_counterexamples := options.disable_counterexamples;
-  avoid_exceptions_flag := options.avoid_exceptions
+  avoid_exceptions_flag := options.avoid_exceptions;
+  message_format_flag := options.message_format
 
 let version = "0.8.0"
 

compiler/catala_utils/cli.mli

@@ -77,6 +77,13 @@ val disable_counterexamples : bool ref
 val avoid_exceptions_flag : bool ref
 (** Avoids using [try ... with] exceptions when compiling the default calculus. *)
 
+type message_format_enum =
+  | Human
+  | EditorParsable
+      (** Format of error and warning messages output by the compiler. *)
+
+val message_format_flag : message_format_enum ref
+
 (** {2 CLI terms} *)
 
 val file : string Cmdliner.Term.t
@@ -99,6 +106,7 @@ type when_enum = Auto | Always | Never
 type options = {
   debug : bool;
   color : when_enum;
+  message_format : message_format_enum;
   wrap_weaved_output : bool;
   avoid_exceptions : bool;
   backend : string;

compiler/catala_utils/errors.ml

@@ -25,15 +25,31 @@ exception StructuredError of (string * (string option * Pos.t) list)
 
 let print_structured_error (msg : string) (pos : (string option * Pos.t) list) :
     string =
-  Printf.sprintf "%s%s%s" msg
-    (if pos = [] then "" else "\n\n")
-    (String.concat "\n\n"
-       (List.map
-          (fun (msg, pos) ->
-            Printf.sprintf "%s%s"
-              (match msg with None -> "" | Some msg -> msg ^ "\n")
-              (Pos.retrieve_loc_text pos))
-          pos))
+  match !Cli.message_format_flag with
+  | Cli.Human ->
+    Printf.sprintf "%s%s%s" msg
+      (if pos = [] then "" else "\n\n")
+      (String.concat "\n\n"
+         (List.map
+            (fun (msg, pos) ->
+              Printf.sprintf "%s%s"
+                (match msg with None -> "" | Some msg -> msg ^ "\n")
+                (Pos.retrieve_loc_text pos))
+            pos))
+  | Cli.EditorParsable ->
+    let remove_new_lines s =
+      Re.replace ~all:true (Re.compile (Re.char '\n')) ~f:(fun _ -> " | ") s
+    in
+    "\n"
+    ^ String.concat "\n"
+        (List.map
+           (fun (msg', pos) ->
+             Printf.sprintf "%s%s" (Pos.to_string_short pos)
+               (match msg' with
+               | None -> remove_new_lines msg
+               | Some msg' ->
+                 remove_new_lines msg ^ " | " ^ remove_new_lines msg'))
+           pos)
 
 (** {1 Error exception and printing} *)
 

compiler/catala_utils/pos.ml

@@ -96,15 +96,10 @@ let to_string (pos : t) : string =
 
 let to_string_short (pos : t) : string =
   let s, e = pos.code_pos in
-  if e.Lexing.pos_lnum = s.Lexing.pos_lnum then
-    Printf.sprintf "%s:%d.%d-%d:" s.Lexing.pos_fname s.Lexing.pos_lnum
-      (s.Lexing.pos_cnum - s.Lexing.pos_bol)
-      (e.Lexing.pos_cnum - e.Lexing.pos_bol)
-  else
-    Printf.sprintf "%s:%d.%d-%d.%d:" s.Lexing.pos_fname s.Lexing.pos_lnum
-      (s.Lexing.pos_cnum - s.Lexing.pos_bol)
-      e.Lexing.pos_lnum
-      (e.Lexing.pos_cnum - e.Lexing.pos_bol)
+  Printf.sprintf "%s:%d.%d-%d.%d:" s.Lexing.pos_fname s.Lexing.pos_lnum
+    (s.Lexing.pos_cnum - s.Lexing.pos_bol + 1)
+    e.Lexing.pos_lnum
+    (e.Lexing.pos_cnum - e.Lexing.pos_bol + 1)
 
 let indent_number (s : string) : int =
   try

compiler/driver.ml

@@ -567,11 +567,13 @@ let driver source_file (options : Cli.options) : int =
                     prgm type_ordering)))))));
     0
   with
-  | Errors.StructuredError (msg, pos) ->
+  | Errors.StructuredError (msg, pos) -> (
     let bt = Printexc.get_raw_backtrace () in
     Cli.error_print "%s" (Errors.print_structured_error msg pos);
     if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
-    -1
+    match options.message_format with
+    | Human -> -1
+    | EditorParsable -> 0 (* editors don't suffer a non-zero return code *))
   | Sys_error msg ->
     let bt = Printexc.get_raw_backtrace () in
     Cli.error_print "System error: %s" msg;