Source file Trace.ml

open MlFront_Core

type t =
  | NewUnits of ModuleUnit.t Unit.t list
  | OptimisticUnits of ModuleUnit.t Unit.t list

let of_new_units (units : ModuleUnit.t Unit.t list) = NewUnits units

let of_optimistic_units (units : ModuleUnit.t Unit.t list) =
  OptimisticUnits units

let unit_id_as_json : UnitId.t -> Ezjsonm.value = function
  | `PackageId package_id ->
      `O [ ("type", `String "package"); ("package", PackageId.json package_id) ]
  | `SpecialModuleId special_module_id ->
      `O
        [
          ("type", `String "special_module");
          ("special_module", SpecialModuleId.json special_module_id);
        ]

let unit_as_json : ModuleUnit.t Unit.t -> Ezjsonm.value =
 fun { code; more = { unit_id; party; _ }; _ } ->
  let pp_schema_ext = Schematic.Ext.simple_json in
  let json_code = Fmt.str "%a" (pp_schema_ext Schema.m2l) code in
  let code = Ezjsonm.value_from_string json_code in
  `O
    [
      ("unit_id", unit_id_as_json unit_id);
      ("party", `String (Fmt.to_to_string Party.pp party));
      ("code", code);
    ]

let as_json : t -> Ezjsonm.value = function
  | NewUnits units ->
      `O
        [
          ("type", `String "new_units");
          ("new_units", `A (List.map unit_as_json units));
        ]
  | OptimisticUnits units ->
      `O
        [
          ("type", `String "optimistic_units");
          ("optimistic_units", `A (List.map unit_as_json units));
        ]

let pp_traces ppf traces =
  let first = ref true in
  Format.fprintf ppf "@[<v>";
  List.iter
    (fun trace ->
      if !first then first := false else Format.pp_print_cut ppf ();
      let trace_str = Ezjsonm.value_to_string ~minify:true (as_json trace) in
      Format.pp_print_string ppf trace_str)
    traces;
  Format.fprintf ppf "@]"