mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-20 00:41:05 +03:00
Merge pull request #267 from CatalaLang/refactor-web-api
Refactor the web API by serializing runtime values
This commit is contained in:
commit
5b4ab6d2b8
@ -34,6 +34,7 @@ depends: [
|
||||
"visitors" {>= "20200210"}
|
||||
"benchmark" {>= "1.6"}
|
||||
"js_of_ocaml-ppx" {>= "3.8.0"}
|
||||
"ppx_yojson_conv" {>= "0.14.0"}
|
||||
"camomile" {>= "1.0.2"}
|
||||
"cppo" {>= "1"}
|
||||
"alcotest" {with-test & >= "1.5.0"}
|
||||
|
@ -16,6 +16,8 @@
|
||||
(library
|
||||
(name runtime)
|
||||
(public_name catala.runtime)
|
||||
(preprocess
|
||||
(pps ppx_yojson_conv))
|
||||
(libraries calendar zarith zarith_stubs_js)
|
||||
(modules runtime))
|
||||
|
||||
|
@ -19,6 +19,7 @@ type integer = Z.t
|
||||
type decimal = Q.t
|
||||
type date = CalendarLib.Date.t
|
||||
type duration = CalendarLib.Date.Period.t
|
||||
type 'a eoption = ENone of unit | ESome of 'a
|
||||
|
||||
type source_position = {
|
||||
filename : string;
|
||||
@ -29,8 +30,6 @@ type source_position = {
|
||||
law_headings : string list;
|
||||
}
|
||||
|
||||
type 'a eoption = ENone of unit | ESome of 'a
|
||||
|
||||
exception EmptyError
|
||||
exception AssertionFailed
|
||||
exception ConflictError
|
||||
@ -39,55 +38,6 @@ exception IndivisableDurations
|
||||
exception ImpossibleDate
|
||||
exception NoValueProvided of source_position
|
||||
|
||||
type runtime_value =
|
||||
| Unit
|
||||
| Bool of bool
|
||||
| Money of money
|
||||
| Integer of integer
|
||||
| Decimal of decimal
|
||||
| Date of date
|
||||
| Duration of duration
|
||||
| Enum of string list * (string * runtime_value)
|
||||
| Struct of string list * (string * runtime_value) list
|
||||
| Array of runtime_value Array.t
|
||||
| Unembeddable
|
||||
|
||||
let unembeddable _ = Unembeddable
|
||||
let embed_unit () = Unit
|
||||
let embed_bool x = Bool x
|
||||
let embed_money x = Money x
|
||||
let embed_integer x = Integer x
|
||||
let embed_decimal x = Decimal x
|
||||
let embed_date x = Date x
|
||||
let embed_duration x = Duration x
|
||||
let embed_array f x = Array (Array.map f x)
|
||||
|
||||
type event =
|
||||
| BeginCall of string list
|
||||
| EndCall of string list
|
||||
| VariableDefinition of string list * runtime_value
|
||||
| DecisionTaken of source_position
|
||||
|
||||
let log_ref : event list ref = ref []
|
||||
let reset_log () = log_ref := []
|
||||
let retrieve_log () = List.rev !log_ref
|
||||
|
||||
let log_begin_call info f x =
|
||||
log_ref := BeginCall info :: !log_ref;
|
||||
f x
|
||||
|
||||
let log_end_call info x =
|
||||
log_ref := EndCall info :: !log_ref;
|
||||
x
|
||||
|
||||
let log_variable_definition (info : string list) embed (x : 'a) =
|
||||
log_ref := VariableDefinition (info, embed x) :: !log_ref;
|
||||
x
|
||||
|
||||
let log_decision_taken pos x =
|
||||
if x then log_ref := DecisionTaken pos :: !log_ref;
|
||||
x
|
||||
|
||||
let money_of_cents_string (cents : string) : money = Z.of_string cents
|
||||
let money_of_units_int (units : int) : money = Z.(of_int units * of_int 100)
|
||||
let money_of_cents_integer (cents : integer) : money = cents
|
||||
@ -192,6 +142,62 @@ let duration_to_string (d : duration) : string =
|
||||
let duration_to_years_months_days (d : duration) : int * int * int =
|
||||
CalendarLib.Date.Period.ymd d
|
||||
|
||||
let yojson_of_money (m : money) = `Float (money_to_float m)
|
||||
let yojson_of_integer (i : integer) = `Int (integer_to_int i)
|
||||
let yojson_of_decimal (d : decimal) = `Float (decimal_to_float d)
|
||||
let yojson_of_date (d : date) = `String (date_to_string d)
|
||||
let yojson_of_duration (d : duration) = `String (duration_to_string d)
|
||||
|
||||
type runtime_value =
|
||||
| Unit
|
||||
| Bool of bool
|
||||
| Money of money
|
||||
| Integer of integer
|
||||
| Decimal of decimal
|
||||
| Date of date
|
||||
| Duration of duration
|
||||
| Enum of string list * (string * runtime_value)
|
||||
| Struct of string list * (string * runtime_value) list
|
||||
| Array of runtime_value array
|
||||
| Unembeddable
|
||||
[@@deriving yojson_of]
|
||||
|
||||
let unembeddable _ = Unembeddable
|
||||
let embed_unit () = Unit
|
||||
let embed_bool x = Bool x
|
||||
let embed_money x = Money x
|
||||
let embed_integer x = Integer x
|
||||
let embed_decimal x = Decimal x
|
||||
let embed_date x = Date x
|
||||
let embed_duration x = Duration x
|
||||
let embed_array f x = Array (Array.map f x)
|
||||
|
||||
type event =
|
||||
| BeginCall of string list
|
||||
| EndCall of string list
|
||||
| VariableDefinition of string list * runtime_value
|
||||
| DecisionTaken of source_position
|
||||
|
||||
let log_ref : event list ref = ref []
|
||||
let reset_log () = log_ref := []
|
||||
let retrieve_log () = List.rev !log_ref
|
||||
|
||||
let log_begin_call info f x =
|
||||
log_ref := BeginCall info :: !log_ref;
|
||||
f x
|
||||
|
||||
let log_end_call info x =
|
||||
log_ref := EndCall info :: !log_ref;
|
||||
x
|
||||
|
||||
let log_variable_definition (info : string list) embed (x : 'a) =
|
||||
log_ref := VariableDefinition (info, embed x) :: !log_ref;
|
||||
x
|
||||
|
||||
let log_decision_taken pos x =
|
||||
if x then log_ref := DecisionTaken pos :: !log_ref;
|
||||
x
|
||||
|
||||
let handle_default :
|
||||
'a. (unit -> 'a) array -> (unit -> bool) -> (unit -> 'a) -> 'a =
|
||||
fun exceptions just cons ->
|
||||
|
@ -58,6 +58,7 @@ type runtime_value =
|
||||
| Struct of string list * (string * runtime_value) list
|
||||
| Array of runtime_value Array.t
|
||||
| Unembeddable
|
||||
[@@deriving yojson_of]
|
||||
|
||||
val unembeddable : 'a -> runtime_value
|
||||
val embed_unit : unit -> runtime_value
|
||||
|
@ -18,6 +18,71 @@ from the root of the repository:
|
||||
make build_french_law_library_js
|
||||
```
|
||||
|
||||
## API description
|
||||
|
||||
<details>
|
||||
|
||||
<summary>API content</summary>
|
||||
|
||||
### Data types
|
||||
|
||||
#### `source_position`
|
||||
|
||||
Stores information about the log position.
|
||||
|
||||
```javascript
|
||||
{
|
||||
fileName : string
|
||||
startLine : int
|
||||
endLine : int
|
||||
startColumn : int
|
||||
endColumn : int
|
||||
lawHeadings : [string]
|
||||
}
|
||||
```
|
||||
|
||||
#### `log_event`
|
||||
|
||||
Stores information about one log event.
|
||||
|
||||
```javascript
|
||||
{
|
||||
eventType : string
|
||||
information : [string]
|
||||
sourcePosition : source_position?
|
||||
loggedValueJson : string
|
||||
}
|
||||
```
|
||||
|
||||
`loggedValueJson` is the resulting string representation of the
|
||||
`Runtime.runtime_value` serialization via `yojson` -- see
|
||||
`./src/compiler/runtime.mli`.
|
||||
|
||||
### Functions
|
||||
|
||||
#### `french_law.resetLog()`
|
||||
|
||||
Clears the log array.
|
||||
|
||||
Example of use:
|
||||
|
||||
```javascript
|
||||
french_law.resetLog(0) // Note that you have to pass an arbitrary argument.
|
||||
```
|
||||
|
||||
#### `french_law.retrieveLog()`
|
||||
|
||||
Returns the array of [`log_event`](#log_event) resulting of the computation of the
|
||||
[algorithms](#available-algorithms).
|
||||
|
||||
Example of use:
|
||||
|
||||
```javascript
|
||||
let logs = french_law.retrieveLog(0) // Note that you have to pass an arbitrary argument.
|
||||
```
|
||||
|
||||
</details>
|
||||
|
||||
## Available algorithms
|
||||
|
||||
### Allocations familiales
|
||||
|
5952
french_law/js/french_law.js
generated
5952
french_law/js/french_law.js
generated
File diff suppressed because one or more lines are too long
@ -72,70 +72,9 @@ class type log_event =
|
||||
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 loggedValue : Js.Unsafe.any Js.prop
|
||||
method loggedValueJson : Js.js_string Js.t Js.prop
|
||||
end
|
||||
|
||||
let rec embed_to_js (v : runtime_value) : Js.Unsafe.any =
|
||||
match v with
|
||||
| Unit -> Js.Unsafe.inject Js.undefined
|
||||
| Bool b -> Js.Unsafe.inject (Js.bool b)
|
||||
| Integer i -> Js.Unsafe.inject (integer_to_int i)
|
||||
| Decimal d -> Js.Unsafe.inject (decimal_to_float d)
|
||||
| Money m -> Js.Unsafe.inject (money_to_float m)
|
||||
| Date d ->
|
||||
let date = new%js Js.date_now in
|
||||
ignore (date##setUTCFullYear (integer_to_int @@ year_of_date d));
|
||||
ignore (date##setUTCMonth (integer_to_int @@ month_number_of_date d));
|
||||
ignore (date##setUTCDate (integer_to_int @@ day_of_month_of_date d));
|
||||
ignore (date##setUTCHours 0);
|
||||
ignore (date##setUTCMinutes 0);
|
||||
ignore (date##setUTCSeconds 0);
|
||||
ignore (date##setUTCMilliseconds 0);
|
||||
Js.Unsafe.inject date
|
||||
| Duration d ->
|
||||
let days, months, years = duration_to_years_months_days d in
|
||||
Js.Unsafe.inject (Js.string (Printf.sprintf "%dD%dM%dY" days months years))
|
||||
| Struct (name, fields) ->
|
||||
Js.Unsafe.inject
|
||||
(object%js
|
||||
val mutable structName =
|
||||
if List.length name = 1 then
|
||||
Js.Unsafe.inject (Js.string (List.hd name))
|
||||
else
|
||||
Js.Unsafe.inject
|
||||
(Js.array (Array.of_list (List.map Js.string name)))
|
||||
|
||||
val mutable structFields =
|
||||
Js.Unsafe.inject
|
||||
(Js.array
|
||||
(Array.of_list
|
||||
(List.map
|
||||
(fun (name, v) ->
|
||||
object%js
|
||||
val mutable fieldName =
|
||||
Js.Unsafe.inject (Js.string name)
|
||||
|
||||
val mutable fieldValue =
|
||||
Js.Unsafe.inject (embed_to_js v)
|
||||
end)
|
||||
fields)))
|
||||
end)
|
||||
| Enum (name, (case, v)) ->
|
||||
Js.Unsafe.inject
|
||||
(object%js
|
||||
val mutable enumName =
|
||||
if List.length name = 1 then
|
||||
Js.Unsafe.inject (Js.string (List.hd name))
|
||||
else
|
||||
Js.Unsafe.inject
|
||||
(Js.array (Array.of_list (List.map Js.string name)))
|
||||
|
||||
val mutable enumCase = Js.Unsafe.inject (Js.string case)
|
||||
val mutable enumPayload = Js.Unsafe.inject (embed_to_js v)
|
||||
end)
|
||||
| Array vs -> Js.Unsafe.inject (Js.array (Array.map embed_to_js vs))
|
||||
| Unembeddable -> Js.Unsafe.inject Js.null
|
||||
|
||||
let _ =
|
||||
Js.export_all
|
||||
(object%js
|
||||
@ -167,11 +106,13 @@ let _ =
|
||||
List.map Js.string info
|
||||
| DecisionTaken _ -> []))
|
||||
|
||||
val mutable loggedValue =
|
||||
match evt with
|
||||
| VariableDefinition (_, v) -> embed_to_js v
|
||||
val mutable loggedValueJson =
|
||||
(match evt with
|
||||
| VariableDefinition (_, v) -> v
|
||||
| EndCall _ | BeginCall _ | DecisionTaken _ ->
|
||||
Js.Unsafe.inject Js.undefined
|
||||
Runtime.unembeddable ())
|
||||
|> Runtime.yojson_of_runtime_value
|
||||
|> Yojson.Safe.to_string |> Js.string
|
||||
|
||||
val mutable sourcePosition =
|
||||
match evt with
|
||||
|
@ -10,7 +10,7 @@
|
||||
(modules api_web)
|
||||
(preprocess
|
||||
(pps js_of_ocaml-ppx))
|
||||
(libraries catala.runtime law_source js_of_ocaml))
|
||||
(libraries catala.runtime law_source js_of_ocaml yojson))
|
||||
|
||||
(library
|
||||
(name api)
|
||||
|
Loading…
Reference in New Issue
Block a user