(* This file is part of the Catala compiler, a specification language for tax and social benefits computation rules. Copyright (C) 2020 Inria, contributor: Emile Rolley . Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. *) open Js_of_ocaml module R_ocaml = Runtime_ocaml.Runtime class type source_position = object method fileName : Js.js_string Js.t Js.prop method startLine : int Js.prop method endLine : int Js.prop method startColumn : int Js.prop method endColumn : int Js.prop method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop end class type raw_event = object method eventType : Js.js_string Js.t Js.prop method information : Js.js_string Js.t Js.js_array Js.t Js.prop method sourcePosition : source_position Js.t Js.optdef Js.prop method loggedIOJson : Js.js_string Js.t Js.prop method loggedValueJson : Js.js_string Js.t Js.prop end class type event = object method data : Js.js_string Js.t Js.prop end class type duration = object method years : int Js.readonly_prop method months : int Js.readonly_prop method days : int Js.readonly_prop end let duration_of_js d = R_ocaml.duration_of_numbers d##.years d##.months d##.days let duration_to_js d = let years, months, days = R_ocaml.duration_to_years_months_days d in object%js val years = years val months = months val days = days end let date_of_js d = let d = Js.to_string d in let d = if String.contains d 'T' then d |> String.split_on_char 'T' |> List.hd else d in let fail () = failwith "date_of_js: invalid date" in match String.split_on_char '-' d with | [year; month; day] -> ( try R_ocaml.date_of_numbers (int_of_string year) (int_of_string month) (int_of_string day) with Failure _ -> fail ()) | _ -> fail () let date_to_js d = Js.string @@ R_ocaml.date_to_string d class type event_manager = object method resetLog : unit Js.meth method retrieveEvents : event Js.t Js.js_array Js.t Js.meth method retrieveRawEvents : raw_event Js.t Js.js_array Js.t Js.meth end let event_manager : event_manager Js.t = object%js (_self) method resetLog = R_ocaml.reset_log () method retrieveEvents = R_ocaml.retrieve_log () |> R_ocaml.EventParser.parse_raw_events |> List.map (fun event -> object%js val mutable data = event |> R_ocaml.Json.event |> Js.string end) |> Array.of_list |> Js.array method retrieveRawEvents = let evt_to_js evt = (* FIXME: ideally this could be just a Json.parse (R_ocaml.Json.event foo) ? *) object%js val mutable eventType = (match evt with | R_ocaml.BeginCall _ -> "Begin call" | EndCall _ -> "End call" | VariableDefinition _ -> "Variable definition" | DecisionTaken _ -> "Decision taken") |> Js.string val mutable information = (match evt with | BeginCall info | EndCall info | VariableDefinition (info, _, _) -> List.map Js.string info | DecisionTaken _ -> []) |> Array.of_list |> Js.array val mutable loggedIOJson = match evt with | VariableDefinition (_, io, _) -> io |> R_ocaml.Json.io_log |> Js.string | EndCall _ | BeginCall _ | DecisionTaken _ -> "unavailable" |> Js.string val mutable loggedValueJson = (match evt with | VariableDefinition (_, _, v) -> v | EndCall _ | BeginCall _ | DecisionTaken _ -> R_ocaml.unembeddable ()) |> R_ocaml.Json.runtime_value |> Js.string val mutable sourcePosition = match evt with | DecisionTaken pos -> Js.def (object%js val mutable fileName = Js.string pos.filename val mutable startLine = pos.start_line val mutable endLine = pos.end_line val mutable startColumn = pos.start_column val mutable endColumn = pos.end_column val mutable lawHeadings = List.map Js.string pos.law_headings |> Array.of_list |> Js.array end) | _ -> Js.undefined end in R_ocaml.retrieve_log () |> List.map evt_to_js |> Array.of_list |> Js.array end let execute_or_throw_error f = try f () with R_ocaml.Error _ as exc -> let msg = Js.string (Printexc.to_string exc) in Js.Js_error.raise_ (Js.Js_error.of_error (object%js val mutable name = Js.string "CatalaError" val mutable message = msg val mutable stack = Js.Optdef.empty method toString = msg end)) let () = Js.export_all (object%js val eventsManager = event_manager end)