Source file `date_internal.ml`

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
open Catala_runtime

(* Toplevel def of_ymd *)
let of_ymd : code_location -> integer -> integer -> integer -> date =
 fun pos y m d ->
  try
    Dates_calc.make_date ~year:(Z.to_int y) ~month:(Z.to_int m)
      ~day:(Z.to_int d)
  with Dates_calc.InvalidDate -> raise (Error (InvalidDate, [pos]))

(* Toplevel def to_ymd *)
let to_ymd : date -> integer * integer * integer =
 fun (d : date) ->
  let y, m, d = Dates_calc.date_to_ymd d in
  Z.of_int y, Z.of_int m, Z.of_int d

(* Toplevel def last_day_of_month *)
let last_day_of_month : date -> date =
 fun (d : date) -> Dates_calc.last_day_of_month d

(* Toplevel def add_rounded_down *)
let add_rounded_down : date -> duration -> date =
 fun (d : date) (dur : duration) ->
  Dates_calc.add_dates d dur ~round:Dates_calc.RoundDown

(* Toplevel def add_rounded_up *)
let add_rounded_up : date -> duration -> date =
 fun (d : date) (dur : duration) ->
  Dates_calc.add_dates d dur ~round:Dates_calc.RoundUp

let () =
  Catala_runtime.register_module "Date_internal"
    [
      "of_ymd", Stdlib.Obj.repr of_ymd;
      "to_ymd", Stdlib.Obj.repr to_ymd;
      "last_day_of_month", Stdlib.Obj.repr last_day_of_month;
      "add_rounded_down", Stdlib.Obj.repr add_rounded_down;
      "add_rounded_up", Stdlib.Obj.repr add_rounded_up;
    ]
    "*external*"