Format trace to JSON format

compiler/catala_utils/cli.ml

@@ -26,7 +26,8 @@ let language_code =
   let rl = List.map (fun (a, b) -> b, a) languages in
   fun l -> List.assoc l rl
 
-let message_format_opt = ["human", Human; "gnu", GNU]
+let message_format_opt = ["human", (Human : message_format_enum); "gnu", GNU]
+let trace_format_opt = ["human", (Human : trace_format_enum); "json", JSON]
 
 open Cmdliner
 
@@ -154,6 +155,16 @@ module Flags = struct
             "Displays a trace of the interpreter's computation or generates \
              logging instructions in translate programs."
 
+    let trace_format =
+      value
+      & opt (enum trace_format_opt) Human
+      & info ["trace-format"]
+          ~doc:
+            "Selects the format of trace logs emitted by the interpreter. If \
+             set to $(i,human), the messages will be nicely displayed and \
+             meant to be read by a human. If set to $(i, json), the messages \
+             will be emitted as a JSON structured object."
+
     let plugins_dirs =
       let doc = "Set the given directory to be searched for backend plugins." in
       let env = Cmd.Env.info "CATALA_PLUGINS" in
@@ -223,6 +234,7 @@ module Flags = struct
           color
           message_format
           trace
+          trace_format
           plugins_dirs
           disable_warnings
           max_prec_digits
@@ -242,8 +254,8 @@ module Flags = struct
         (* This sets some global refs for convenience, but most importantly
            returns the options record. *)
         Global.enforce_options ~language ~debug ~color ~message_format ~trace
-          ~plugins_dirs ~disable_warnings ~max_prec_digits ~path_rewrite
-          ~stop_on_error ~no_fail_on_assert ()
+          ~trace_format ~plugins_dirs ~disable_warnings ~max_prec_digits
+          ~path_rewrite ~stop_on_error ~no_fail_on_assert ()
       in
       Term.(
         const make
@@ -252,6 +264,7 @@ module Flags = struct
         $ color
         $ message_format
         $ trace
+        $ trace_format
         $ plugins_dirs
         $ disable_warnings
         $ max_prec_digits

compiler/catala_utils/global.ml

@@ -19,6 +19,7 @@ type raw_file = file
 type backend_lang = En | Fr | Pl
 type when_enum = Auto | Always | Never
 type message_format_enum = Human | GNU | Lsp
+type trace_format_enum = Human | JSON
 
 type 'file input_src =
   | FileName of 'file
@@ -33,6 +34,7 @@ type options = {
   mutable color : when_enum;
   mutable message_format : message_format_enum;
   mutable trace : bool;
+  mutable trace_format : trace_format_enum;
   mutable plugins_dirs : file list;
   mutable disable_warnings : bool;
   mutable max_prec_digits : int;
@@ -54,6 +56,7 @@ let options =
     color = Auto;
     message_format = Human;
     trace = false;
+    trace_format = Human;
     plugins_dirs = [];
     disable_warnings = false;
     max_prec_digits = 20;
@@ -69,6 +72,7 @@ let enforce_options
     ?color
     ?message_format
     ?trace
+    ?trace_format
     ?plugins_dirs
     ?disable_warnings
     ?max_prec_digits
@@ -82,6 +86,7 @@ let enforce_options
   Option.iter (fun x -> options.color <- x) color;
   Option.iter (fun x -> options.message_format <- x) message_format;
   Option.iter (fun x -> options.trace <- x) trace;
+  Option.iter (fun x -> options.trace_format <- x) trace_format;
   Option.iter (fun x -> options.plugins_dirs <- x) plugins_dirs;
   Option.iter (fun x -> options.disable_warnings <- x) disable_warnings;
   Option.iter (fun x -> options.max_prec_digits <- x) max_prec_digits;

compiler/catala_utils/global.mli

@@ -32,6 +32,9 @@ type when_enum = Auto | Always | Never
 (** Format of error and warning messages output by the compiler. *)
 type message_format_enum = Human | GNU | Lsp
 
+(** Format of trace logs *)
+type trace_format_enum = Human | JSON
+
 (** Sources for program input *)
 type 'file input_src =
   | FileName of 'file  (** A file path to read from disk *)
@@ -51,6 +54,7 @@ type options = private {
   mutable color : when_enum;
   mutable message_format : message_format_enum;
   mutable trace : bool;
+  mutable trace_format : trace_format_enum;
   mutable plugins_dirs : file list;
   mutable disable_warnings : bool;
   mutable max_prec_digits : int;
@@ -73,6 +77,7 @@ val enforce_options :
   ?color:when_enum ->
   ?message_format:message_format_enum ->
   ?trace:bool ->
+  ?trace_format:trace_format_enum ->
   ?plugins_dirs:file list ->
   ?disable_warnings:bool ->
   ?max_prec_digits:int ->

compiler/shared_ast/interpreter.ml

@@ -917,9 +917,20 @@ let evaluate_expr_trace :
     ~finally:(fun () ->
       if Global.options.trace then
         let trace = Runtime.retrieve_log () in
-        List.iter (print_log lang) trace
-        (* TODO: [Runtime.pp_events ~is_first_call:true Format.err_formatter
-           (Runtime.EventParser.parse_raw_events trace)] fais here, check why *))
+        match Global.options.trace_format with
+        | Human ->
+          List.iter (print_log lang) trace
+          (* TODO: [Runtime.pp_events ~is_first_call:true Format.err_formatter
+             (Runtime.EventParser.parse_raw_events trace)] fais here, check
+             why *)
+        | JSON ->
+          Format.printf "[";
+          Format.pp_print_list
+            ~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
+            (fun fmt -> Format.fprintf fmt "%s")
+            Format.std_formatter
+            (List.map Runtime.Json.raw_event trace);
+          Format.printf "]\n")
 
 let evaluate_expr_safe :
     type d.

runtimes/ocaml/runtime.ml

@@ -320,7 +320,7 @@ module BufferedJson = struct
   (* Note: the output format is made for transition with what Yojson gave us,
      but we could change it to something nicer (e.g. objects for structures) *)
   let rec runtime_value buf = function
-    | Unit -> Buffer.add_string buf {|"Unit"|}
+    | Unit -> Buffer.add_string buf {|{}|}
     | Bool b -> Buffer.add_string buf (string_of_bool b)
     | Money m -> Buffer.add_string buf (money_to_string m)
     | Integer i -> Buffer.add_string buf (integer_to_string i)
@@ -329,14 +329,22 @@ module BufferedJson = struct
     | Date d -> quote buf (date_to_string d)
     | Duration d -> quote buf (duration_to_string d)
     | Enum (name, (constr, v)) ->
-      Printf.bprintf buf {|[["%s"],["%s",%a]]|} name constr runtime_value v
+      Printf.bprintf buf
+        {|{"kind": "enum", "name": "%s", "constructor": "%s", "value": %a}|}
+        name constr runtime_value v
     | Struct (name, elts) ->
-      Printf.bprintf buf {|["%s",[%a]]|} name
+      Printf.bprintf buf {|{"kind": "struct", "name": "%s", "fields": {%a}}|}
+        name
         (list (fun buf (cstr, v) ->
-             Printf.bprintf buf {|"%s":%a|} cstr runtime_value v))
+             Printf.bprintf buf {|"%s": %a|} cstr runtime_value v))
         elts
-    | Array elts | Tuple elts ->
-      Printf.bprintf buf "[%a]" (list runtime_value) (Array.to_list elts)
+    | (Array elts | Tuple elts) as v ->
+      Printf.bprintf buf {|{"kind": %s, "value":[%a]}|}
+        (match v with
+        | Array _ -> "\"array\""
+        | Tuple _ -> "\"tuple\""
+        | _ -> assert false)
+        (list runtime_value) (Array.to_list elts)
     | Unembeddable -> Buffer.add_string buf {|"unembeddable"|}
 
   let information buf info = Printf.bprintf buf "[%a]" (list quote) info
@@ -380,6 +388,26 @@ module BufferedJson = struct
     Printf.bprintf buf {|,"fun_inputs":[%a]|} (list var_def) fc.fun_inputs;
     Printf.bprintf buf {|,"body":[%a]|} (list event) fc.body;
     Printf.bprintf buf {|,"output":%a}|} var_def fc.output
+
+  and raw_event buf = function
+    | BeginCall name ->
+      Printf.bprintf buf {|{"event": "BeginCall", "name": "%s"}|}
+        (String.concat "." name)
+    | EndCall name ->
+      Printf.bprintf buf {|{"event": "EndCall", "name": "%s"}|}
+        (String.concat "." name)
+    | VariableDefinition (name, io, value) ->
+      Printf.bprintf buf
+        {|{
+         "event": "VariableDefinition",
+         "name": "%s",
+         "io": %a,
+         "value": %a
+         }|}
+        (String.concat "." name) io_log io runtime_value value
+    | DecisionTaken source_pos ->
+      Printf.bprintf buf {|{"event": "DecisionTaken", "pos": %a}|}
+        source_position source_pos
 end
 
 module Json = struct
@@ -393,6 +421,7 @@ module Json = struct
   let runtime_value = str runtime_value
   let io_log = str io_log
   let event = str event
+  let raw_event = str raw_event
 end
 
 let log_ref : raw_event list ref = ref []

runtimes/ocaml/runtime.mli

@@ -252,6 +252,7 @@ module Json : sig
 
   (* val information: information -> string *)
   val event : event -> string
+  val raw_event : raw_event -> string
 end
 
 val pp_events : ?is_first_call:bool -> Format.formatter -> event list -> unit