Js version of Allocations familiales

This commit is contained in:
Denis Merigoux 2021-02-01 20:09:16 +01:00
parent d88ccc38f6
commit 5c5dbc542f
20 changed files with 398 additions and 62 deletions

View File

@ -27,15 +27,15 @@ dependencies: dependencies-ocaml init-submodules
##########################################
format:
dune build @fmt --auto-promote | true
dune build @fmt --auto-promote 2> /dev/null | true
build:
@$(MAKE) --no-print-directory -C src/catala/catala_surface parser_errors.ml
@$(MAKE) --no-print-directory format
dune build src/catala.exe
dune build src/catala/catala.exe
js_build:
dune build src/catala_web/catala_web.bc.js --profile release
dune build src/catala/catala_web.bc.js --profile release
doc: generate_allocations_familiales_ml
dune build @doc
@ -143,17 +143,25 @@ test_examples: .FORCE
tests: test_suite test_examples
##########################################
# Catala examples in OCaml
# French law library
##########################################
generate_allocations_familiales_ml:
$(MAKE) -C examples/allocations_familiales allocations_familiales.ml -B
cp -f examples/allocations_familiales/allocations_familiales.ml src/french_law/law_source
FRENCH_LAW_LIB_DIR=src/french_law
allocations_familiales_ml: generate_allocations_familiales_ml
$(MAKE) -C ./ format
dune exec src/french_law/benchmark.exe
allocations_familiales_library:
$(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml \
$(FRENCH_LAW_LIB_DIR)/law_source
build_french_law_library: allocations_familiales_library format
dune build $(FRENCH_LAW_LIB_DIR)
build_french_law_library_js: allocations_familiales_library format
dune build --profile release $(FRENCH_LAW_LIB_DIR)/api_web.bc.js
ln -sf $(PWD)/_build/default/$(FRENCH_LAW_LIB_DIR)/api_web.bc.js javascript/french_law.js
run_french_law_library_benchmark: allocations_familiales_library
dune exec $(FRENCH_LAW_LIB_DIR)/bench.exe
##########################################
# Website assets
@ -163,7 +171,7 @@ grammar.html: src/catala/catala_surface/parser.mly
obelisk html -o $@ $<
catala.html: src/catala/utils/cli.ml
dune exec src/catala.exe -- --help=groff | man2html | sed -e '1,8d' \
dune exec src/catala/catala.exe -- --help=groff | man2html | sed -e '1,8d' \
| tac | sed "1,20d" | tac > $@
website-assets: doc literate_examples grammar.html catala.html js_build

View File

@ -7,11 +7,8 @@ LATEXMK=latexmk
PYGMENTIZE_FR=../../syntax_highlighting/fr/pygments/pygments/env/bin/pygmentize
PYGMENTIZE_EN=../../syntax_highlighting/en/pygments/pygments/env/bin/pygmentize
CATALA=dune exec --no-print-director ../../src/catala.exe -- $(CATALA_OPTS) --language=$(CATALA_LANG)
LEGIFRANCE_CATALA=dune exec ../../src/legifrance_catala.exe --
CATALA_EXE=../../_build/default/src/catala.exe
CATALA=dune exec --no-print-director ../../src/catala/catala.exe -- \
$(CATALA_OPTS) --language=$(CATALA_LANG)
ifeq ($(CATALA_LANG),fr)
PYGMENTIZE=$(PYGMENTIZE_FR)
@ -24,21 +21,21 @@ endif
# Targets
##########################################
%.run: %.catala_$(CATALA_LANG) $(CATALA_EXE)
%.run: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<
@$(CATALA) \
Interpret \
-s $(SCOPE) \
$<
%.ml: %.catala_$(CATALA_LANG) $(CATALA_EXE)
%.ml: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<
@$(CATALA) \
OCaml \
$<
%.tex: %.catala_$(CATALA_LANG) $(CATALA_EXE)
%.tex: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<
$(CATALA) \
--wrap \
@ -46,7 +43,7 @@ endif
LaTeX \
$<
%.html: %.catala_$(CATALA_LANG) $(CATALA_EXE)
%.html: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<
$(CATALA) \
--wrap \

1
javascript/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
node_modules/

View File

@ -0,0 +1,36 @@
var Law = require("./french_law.js");
var Benchmark = require("benchmark");
var suite = new Benchmark.Suite();
suite
.add("AllocationFamiliales#benchmark", function () {
Law.computeAllocationsFamiliales({
currentDate: new Date("2020-05-20"),
children: [
{
id: 0,
remunerationMensuelle: 0,
dateNaissance: new Date("2003-03-02"),
gardeAlternee: false,
priseEnChargeServiceSociaux: false,
},
{
id: 1,
remunerationMensuelle: 300,
dateNaissance: new Date("2013-10-30"),
gardeAlternee: true,
gardeAlterneePartageAllocation: true,
priseEnChargeServiceSociaux: false,
},
],
income: 30000,
residence: "Métropole",
});
})
.on("cycle", function (event) {
console.log(String(event.target));
})
.on("complete", function () {
console.log("Fastest is " + this.filter("fastest").map("name"));
})
.run({ async: true });

1
javascript/french_law.js Symbolic link
View File

@ -0,0 +1 @@
/home/denis/catala/_build/default/src/french_law/api_web.bc.js

25
javascript/package-lock.json generated Normal file
View File

@ -0,0 +1,25 @@
{
"requires": true,
"lockfileVersion": 1,
"dependencies": {
"benchmark": {
"version": "2.1.4",
"resolved": "https://registry.npmjs.org/benchmark/-/benchmark-2.1.4.tgz",
"integrity": "sha1-CfPeMckWQl1JjMLuVloOvzwqVik=",
"requires": {
"lodash": "^4.17.4",
"platform": "^1.3.3"
}
},
"lodash": {
"version": "4.17.20",
"resolved": "https://registry.npmjs.org/lodash/-/lodash-4.17.20.tgz",
"integrity": "sha512-PlhdFcillOINfeV7Ni6oF1TAEayyZBoZ8bcshTHqOYJYlrqzRK5hagpagky5o4HfCzzd1TRkXPMFq6cKk9rGmA=="
},
"platform": {
"version": "1.3.6",
"resolved": "https://registry.npmjs.org/platform/-/platform-1.3.6.tgz",
"integrity": "sha512-fnWVljUchTro6RiCFvCXBbNhJc2NijN7oIQxbwsyL0buWJPG85v81ehlHI9fXrJsMNgTofEoWIQeClKpgxFLrg=="
}
}
}

View File

@ -1,7 +1,27 @@
(library
(public_name catala)
(libraries catala.utils catala.surface catala.desugared catala.literate
catala.dcalc catala.lcalc))
catala.dcalc catala.lcalc)
(modules
(:standard \ catala_web catala)))
(executable
(name catala_web)
(modes byte js)
(package catala)
(public_name catala_web)
(modules catala_web)
(preprocess
(pps js_of_ocaml-ppx))
(libraries catala js_of_ocaml))
(executable
(name catala)
(modes native)
(package catala)
(modules catala)
(public_name catala)
(libraries catala))
(documentation
(package catala))

View File

@ -49,6 +49,7 @@ val duration_of_calendar_period : CalendarLib.Date.Period.t -> duration
val duration_to_calendar_period : duration -> CalendarLib.Date.Period.t
val date_of_numbers : int -> int -> int -> date
(** Usage: [date_of_numbers year month day] *)
val duration_of_numbers : int -> int -> int -> duration

View File

@ -1,9 +0,0 @@
(executable
(name catala_web)
(modes byte js)
(package catala)
(public_name catala_web)
(modules catala_web)
(preprocess
(pps js_of_ocaml-ppx))
(libraries catala js_of_ocaml))

View File

@ -1,7 +0,0 @@
(executable
(name catala)
(modes native)
(package catala)
(modules catala)
(public_name catala)
(libraries catala))

32
src/french_law/api.ml Normal file
View File

@ -0,0 +1,32 @@
(* This file is part of the French law library, a collection of functions for computing French taxes
and benefits derived from Catala programs. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
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. *)
module Allocations_familiales = Law_source.Allocations_familiales
module AF = Allocations_familiales
open Catala.Runtime
let compute_allocations_familiales ~(current_date : CalendarLib.Date.t)
~(children : AF.enfant_entree array) ~(income : int) ~(residence : AF.collectivite) : float =
let result =
AF.interface_allocations_familiales
{
AF.date_courante_in = (fun _ -> date_of_calendar_date current_date);
AF.enfants_in = (fun _ -> children);
AF.enfants_a_charge_in = no_input;
AF.ressources_menage_in = (fun _ -> money_of_units_integers income);
AF.residence_in = (fun _ -> residence);
AF.montant_verse_in = no_input;
}
in
money_to_float result.AF.montant_verse_out

23
src/french_law/api.mli Normal file
View File

@ -0,0 +1,23 @@
(* This file is part of the French law library, a collection of functions for computing French taxes
and benefits derived from Catala programs. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
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. *)
module Allocations_familiales = Law_source.Allocations_familiales
val compute_allocations_familiales :
current_date:CalendarLib.Date.t ->
children:Allocations_familiales.enfant_entree array ->
income:int ->
residence:Allocations_familiales.collectivite ->
float
(** Usage *)

107
src/french_law/api_web.ml Normal file
View File

@ -0,0 +1,107 @@
(* This file is part of the French law library, a collection of functions for computing French taxes
and benefits derived from Catala programs. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
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. *)
module Allocations_familiales = Law_source.Allocations_familiales
module AF = Allocations_familiales
open Catala.Runtime
open Js_of_ocaml
class type enfant_entree =
object
method id : int Js.readonly_prop
method remunerationMensuelle : int Js.readonly_prop
method dateNaissance : Js.date Js.t Js.readonly_prop
method gardeAlternee : bool Js.t Js.readonly_prop
method gardeAlterneePartageAllocation : bool Js.t Js.readonly_prop
method priseEnChargeServiceSociaux : bool Js.t Js.readonly_prop
method allocationVerseeServiceSociaux : bool Js.t Js.readonly_prop
end
class type allocations_familiales_input =
object
method currentDate : Js.date Js.t Js.readonly_prop
method children : enfant_entree Js.t Js.js_array Js.t Js.readonly_prop
method income : int Js.readonly_prop
method residence : Js.js_string Js.t Js.readonly_prop
end
let _ =
Js.export_all
(object%js
method computeAllocationsFamiliales (input : allocations_familiales_input Js.t) : float =
let result =
AF.interface_allocations_familiales
{
AF.date_courante_in =
(fun _ ->
date_of_numbers
input##.currentDate##getFullYear
input##.currentDate##getMonth
input##.currentDate##getDay);
AF.enfants_in =
(fun _ ->
Array.map
(fun (child : enfant_entree Js.t) ->
{
AF.d_identifiant = integer_of_int child##.id;
AF.d_date_de_naissance =
date_of_numbers
child##.dateNaissance##getFullYear
child##.dateNaissance##getMonth
child##.dateNaissance##getDay;
AF.d_garde_alternee =
( if Js.to_bool child##.gardeAlternee then
if Js.to_bool child##.gardeAlterneePartageAllocation then
OuiPartageAllocations ()
else OuiAllocataireUnique ()
else NonGardeUnique () );
AF.d_pris_en_charge_par_services_sociaux =
( if Js.to_bool child##.priseEnChargeServiceSociaux then
if Js.to_bool child##.allocationVerseeServiceSociaux then
OuiAllocationVerseeAuxServicesSociaux ()
else OuiAllocationVerseeALaFamille ()
else NonPriseEnChargeFamille () );
AF.d_remuneration_mensuelle =
money_of_units_integers child##.remunerationMensuelle;
})
(Js.to_array input##.children));
AF.enfants_a_charge_in = no_input;
AF.ressources_menage_in = (fun _ -> money_of_units_integers input##.income);
AF.residence_in =
(fun _ ->
match Js.to_string input##.residence with
| "Métropole" -> AF.Metropole ()
| "Guyane" -> AF.Guyane ()
| "Guadeloupe" -> AF.Guadeloupe ()
| "Martinique" -> AF.Martinique ()
| "La Réunion" -> AF.LaReunion ()
| "Saint Barthélemy" -> AF.SaintBarthelemy ()
| "Saint Pierre et Miquelon" -> AF.SaintPierreEtMiquelon ()
| "Saint Martin" -> AF.SaintMartin ()
| "Mayotte" -> AF.Mayotte ()
| _ -> failwith "unknown collectivite!");
AF.montant_verse_in = no_input;
}
in
money_to_float result.AF.montant_verse_out
end)

View File

@ -1,4 +1,18 @@
module AF = French_law.Wrapper.Allocations_familiales
(* This file is part of the French law library, a collection of functions for computing French taxes
and benefits derived from Catala programs. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
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. *)
module AF = French_law.Api.Allocations_familiales
open Catala.Runtime
let random_children (id : int) =
@ -59,7 +73,7 @@ let run_test () =
let residence = if Random.bool () then AF.Metropole () else AF.Guadeloupe () in
try
let amount =
French_law.Wrapper.compute_allocations_familiales ~current_date ~income ~residence ~children
French_law.Api.compute_allocations_familiales ~current_date ~income ~residence ~children
in
incr num_successful;
total_amount := Float.add !total_amount amount

View File

@ -1,13 +1,25 @@
(executable
(name benchmark)
(name bench)
(modes native)
(package catala)
(modules benchmark)
(public_name benchmark)
(modules bench)
(public_name benchmark_french_law)
(libraries catala french_law benchmark))
(executable
(name api_web)
(modes byte js)
(package catala)
(modules api_web)
(public_name french_law_web)
(preprocess
(pps js_of_ocaml-ppx))
(libraries catala law_source js_of_ocaml))
(library
(name french_law)
(public_name catala.french_law)
(synopsis
"A collection of functions for computing French taxes and benefits derived from Catala programs")
(libraries catala law_source)
(modules wrapper))
(modules api))

View File

@ -0,0 +1,93 @@
(* This file is part of the French law library, a collection of functions for computing French taxes
and benefits derived from Catala programs. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
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. *)
type garde_alternee =
| OuiPartageAllocations of unit
| OuiAllocataireUnique of unit
| NonGardeUnique of unit
type prise_en_charge_service_sociaux =
| OuiAllocationVerseeALaFamille of unit
| OuiAllocationVerseeAuxServicesSociaux of unit
| NonPriseEnChargeFamille of unit
type collectivite =
| Guadeloupe of unit
| Guyane of unit
| Martinique of unit
| LaReunion of unit
| SaintBarthelemy of unit
| SaintMartin of unit
| Metropole of unit
| SaintPierreEtMiquelon of unit
| Mayotte of unit
type prise_en_compte_evaluation_montant = Complete of unit | Partagee of unit
type versement_allocations = Normal of unit | AllocationVerseeAuxServicesSociaux of unit
type age_alternatif = Absent of unit | Present of Catala.Runtime.integer
type element_prestations_familiales =
| PrestationAccueilJeuneEnfant of unit
| AllocationsFamiliales of unit
| ComplementFamilial of unit
| AllocationLogement of unit
| AllocationEducationEnfantHandicape of unit
| AllocationSoutienFamilial of unit
| AllocationRentreeScolaire of unit
| AllocationJournalierePresenceParentale of unit
type personne = { numero_securite_sociale : Catala.Runtime.integer }
type enfant_entree = {
d_identifiant : Catala.Runtime.integer;
d_remuneration_mensuelle : Catala.Runtime.money;
d_date_de_naissance : Catala.Runtime.date;
d_garde_alternee : garde_alternee;
d_pris_en_charge_par_services_sociaux : prise_en_charge_service_sociaux;
}
type enfant = {
identifiant : Catala.Runtime.integer;
fin_obligation_scolaire : Catala.Runtime.date;
remuneration_mensuelle : Catala.Runtime.money;
date_de_naissance : Catala.Runtime.date;
age : Catala.Runtime.integer;
garde_alternee : garde_alternee;
pris_en_charge_par_services_sociaux : prise_en_charge_service_sociaux;
}
type stockage_enfant = PasEnfant of unit | UnEnfant of enfant
type interface_allocations_familiales_out = {
date_courante_out : Catala.Runtime.date;
enfants_out : enfant_entree array;
enfants_a_charge_out : enfant array;
ressources_menage_out : Catala.Runtime.money;
residence_out : collectivite;
montant_verse_out : Catala.Runtime.money;
}
type interface_allocations_familiales_in = {
date_courante_in : unit -> Catala.Runtime.date;
enfants_in : unit -> enfant_entree array;
enfants_a_charge_in : unit -> enfant array;
ressources_menage_in : unit -> Catala.Runtime.money;
residence_in : unit -> collectivite;
montant_verse_in : unit -> Catala.Runtime.money;
}
val interface_allocations_familiales :
interface_allocations_familiales_in -> interface_allocations_familiales_out

View File

@ -1,18 +0,0 @@
module Allocations_familiales = Law_source.Allocations_familiales
module AF = Allocations_familiales
open Catala.Runtime
let compute_allocations_familiales ~(current_date : CalendarLib.Date.t)
~(children : AF.enfant_entree array) ~(income : int) ~(residence : AF.collectivite) : float =
let result =
AF.interface_allocations_familiales
{
AF.date_courante_in = (fun _ -> date_of_calendar_date current_date);
AF.enfants_in = (fun _ -> children);
AF.enfants_a_charge_in = no_input;
AF.ressources_menage_in = (fun _ -> money_of_units_integers income);
AF.residence_in = (fun _ -> residence);
AF.montant_verse_in = no_input;
}
in
money_to_float result.AF.montant_verse_out

View File

@ -15,7 +15,7 @@ RESET := $(shell tput -Txterm sgr0)
CATALA_OPTS?=
CATALA=dune exec --no-buffer --no-print-director ../src/catala.exe -- Interpret $(CATALA_OPTS)
CATALA=dune exec --no-buffer --no-print-director ../src/catala/catala.exe -- Interpret $(CATALA_OPTS)
pass_tests: $(wildcard */*/output/*.out)