1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
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 =
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)