2022-07-19 20:17:02 +03:00
|
|
|
(* 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 <emile.rolley@tuta.io>.
|
|
|
|
|
|
|
|
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
|
2022-07-20 12:51:08 +03:00
|
|
|
module R_ocaml = Runtime_ocaml.Runtime
|
2022-07-19 20:17:02 +03:00
|
|
|
|
|
|
|
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
|
2023-09-01 17:24:27 +03:00
|
|
|
|
2022-07-19 20:17:02 +03:00
|
|
|
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
|
2023-05-26 17:54:52 +03:00
|
|
|
method loggedIOJson : Js.js_string Js.t Js.prop
|
2022-07-19 20:17:02 +03:00
|
|
|
method loggedValueJson : Js.js_string Js.t Js.prop
|
|
|
|
end
|
2023-09-01 17:24:27 +03:00
|
|
|
|
2022-07-19 20:17:02 +03:00
|
|
|
class type event = object
|
|
|
|
method data : Js.js_string Js.t Js.prop
|
|
|
|
end
|
2023-09-01 17:24:27 +03:00
|
|
|
|
2022-07-19 20:17:02 +03:00
|
|
|
class type duration = object
|
2022-07-20 12:51:08 +03:00
|
|
|
method years : int Js.readonly_prop
|
|
|
|
method months : int Js.readonly_prop
|
|
|
|
method days : int Js.readonly_prop
|
2022-07-19 20:17:02 +03:00
|
|
|
end
|
|
|
|
|
2024-03-05 19:54:53 +03:00
|
|
|
let duration_of_js d = R_ocaml.duration_of_numbers d##.years d##.months d##.days
|
2022-07-20 12:51:08 +03:00
|
|
|
|
2024-03-05 19:54:53 +03:00
|
|
|
let duration_to_js d =
|
2022-07-20 12:51:08 +03:00
|
|
|
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
|
2022-07-20 15:20:21 +03:00
|
|
|
|
2024-03-05 19:54:53 +03:00
|
|
|
let date_of_js d =
|
2022-07-26 18:02:00 +03:00
|
|
|
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
|
|
|
|
match String.split_on_char '-' d with
|
|
|
|
| [year; month; day] ->
|
|
|
|
R_ocaml.date_of_numbers (int_of_string year) (int_of_string month)
|
|
|
|
(int_of_string day)
|
2024-03-05 19:54:53 +03:00
|
|
|
| _ -> failwith "date_of_js: invalid date"
|
2022-07-21 13:25:21 +03:00
|
|
|
|
2024-03-05 19:54:53 +03:00
|
|
|
let date_to_js d = Js.string @@ R_ocaml.date_to_string d
|
2022-07-21 13:25:21 +03:00
|
|
|
|
2022-07-21 16:52:35 +03:00
|
|
|
class type event_manager = object
|
2024-03-12 18:05:38 +03:00
|
|
|
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
|
2022-07-20 15:20:21 +03:00
|
|
|
end
|
|
|
|
|
2022-07-21 16:52:35 +03:00
|
|
|
let event_manager : event_manager Js.t =
|
2024-03-12 18:05:38 +03:00
|
|
|
object%js (_self)
|
|
|
|
method resetLog = R_ocaml.reset_log ()
|
2022-07-20 15:20:21 +03:00
|
|
|
|
|
|
|
method retrieveEvents =
|
2024-02-15 18:19:25 +03:00
|
|
|
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
|
2022-07-20 15:20:21 +03:00
|
|
|
|
|
|
|
method retrieveRawEvents =
|
2024-02-15 18:19:25 +03:00
|
|
|
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
|
2022-07-20 15:20:21 +03:00
|
|
|
end
|
2022-07-28 15:47:42 +03:00
|
|
|
|
2022-07-29 18:04:34 +03:00
|
|
|
let execute_or_throw_error f =
|
|
|
|
let throw_error (descr : string) (pos : R_ocaml.source_position) =
|
2022-07-28 15:47:42 +03:00
|
|
|
let msg =
|
|
|
|
Js.string
|
2022-07-29 18:04:34 +03:00
|
|
|
(Format.asprintf "%s in file %s, position %d:%d--%d:%d." descr
|
2022-07-28 15:47:42 +03:00
|
|
|
pos.filename pos.start_line pos.start_column pos.end_line
|
|
|
|
pos.end_column)
|
|
|
|
in
|
|
|
|
Js.Js_error.raise_
|
|
|
|
(Js.Js_error.of_error
|
|
|
|
(object%js
|
2023-04-04 16:19:08 +03:00
|
|
|
val mutable name = Js.string "CatalaError"
|
2022-07-28 15:47:42 +03:00
|
|
|
val mutable message = msg
|
|
|
|
val mutable stack = Js.Optdef.empty
|
|
|
|
method toString = msg
|
|
|
|
end))
|
2022-07-29 18:04:34 +03:00
|
|
|
in
|
|
|
|
try f () with
|
|
|
|
| R_ocaml.NoValueProvided pos ->
|
|
|
|
throw_error
|
|
|
|
"No rule applies in the given context to give a value to the variable" pos
|
|
|
|
| R_ocaml.ConflictError pos ->
|
|
|
|
throw_error
|
2022-09-05 15:50:37 +03:00
|
|
|
"A conflict happened between two rules giving a value to the variable" pos
|
2022-07-29 18:04:34 +03:00
|
|
|
| R_ocaml.AssertionFailed pos ->
|
|
|
|
throw_error "A failure happened in the assertion" pos
|
2024-03-12 16:36:26 +03:00
|
|
|
|
|
|
|
let () =
|
|
|
|
Js.export_all
|
|
|
|
(object%js
|
|
|
|
val eventsManager = event_manager
|
|
|
|
end)
|