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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
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 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_jsoo d =
R_ocaml.duration_of_numbers d##.years d##.months d##.days
let duration_to_jsoo 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_jsoo 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
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)
| _ -> failwith "date_of_jsoo: invalid date"
let date_to_jsoo d = Js.string @@ R_ocaml.date_to_string d
class type event_manager =
object
method resetLog : (unit, unit) Js.meth_callback Js.meth
method retrieveEvents :
(unit, event Js.t Js.js_array Js.t) Js.meth_callback Js.meth
method retrieveRawEvents :
(unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth
end
let event_manager : event_manager Js.t =
object%js
method resetLog = Js.wrap_meth_callback R_ocaml.reset_log
method retrieveEvents =
Js.wrap_meth_callback (fun () ->
Js.array
(Array.of_list
(R_ocaml.retrieve_log ()
|> R_ocaml.EventParser.parse_raw_events
|> List.map (fun event ->
object%js
val mutable data =
event
|> R_ocaml.yojson_of_event
|> Yojson.Safe.to_string
|> Js.string
end))))
method retrieveRawEvents =
Js.wrap_meth_callback (fun () ->
Js.array
(Array.of_list
(List.map
(fun evt ->
object%js
val mutable eventType =
Js.string
(match evt with
| R_ocaml.BeginCall _ -> "Begin call"
| EndCall _ -> "End call"
| VariableDefinition _ -> "Variable definition"
| DecisionTaken _ -> "Decision taken")
val mutable information =
Js.array
(Array.of_list
(match evt with
| BeginCall info
| EndCall info
| VariableDefinition (info, _) ->
List.map Js.string info
| DecisionTaken _ -> []))
val mutable loggedValueJson =
(match evt with
| VariableDefinition (_, v) -> v
| EndCall _ | BeginCall _ | DecisionTaken _ ->
R_ocaml.unembeddable ())
|> R_ocaml.yojson_of_runtime_value
|> Yojson.Safe.to_string
|> 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 =
Js.array
(Array.of_list
(List.map Js.string pos.law_headings))
end)
| _ -> Js.undefined
end)
(R_ocaml.retrieve_log ()))))
end
let execute_or_throw_error f =
let throw_error (descr : string) (pos : R_ocaml.source_position) =
let msg =
Js.string
(Format.asprintf "%s in file %s, position %d:%d--%d:%d." descr
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
val mutable name = Js.string "NoValueProvided"
val mutable message = msg
val mutable stack = Js.Optdef.empty
method toString = msg
end))
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
"A conflict happend between two rules giving a value to the variable" pos
| R_ocaml.AssertionFailed pos ->
throw_error "A failure happened in the assertion" pos