anil.recoil.org
My personal data management layer
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Common types and Jsont codecs for Bushel *)
7
8(** {1 Date Types} *)
9
10type date = Ptime.date
11(** A calendar date (year, month, day). *)
12
13(** {1 Jsont Codecs} *)
14
15let ptime_date_jsont : Ptime.date Jsont.t =
16 let dec s =
17 try
18 match String.split_on_char '-' s with
19 | [y; m; d] ->
20 let year = int_of_string y in
21 let month = int_of_string m in
22 let day = int_of_string d in
23 Ok (year, month, day)
24 | _ ->
25 Error (Printf.sprintf "Invalid date format: %s (expected YYYY-MM-DD)" s)
26 with _ ->
27 Error (Printf.sprintf "Invalid date: %s" s)
28 in
29 let enc (y, m, d) = Printf.sprintf "%04d-%02d-%02d" y m d in
30 Jsont.of_of_string ~kind:"Ptime.date" dec ~enc
31
32let ptime_jsont : Ptime.t Jsont.t =
33 let dec s =
34 (* Try RFC3339 first *)
35 match Ptime.of_rfc3339 s with
36 | Ok (t, _, _) -> Ok t
37 | Error _ ->
38 (* Try date-only format *)
39 try
40 match String.split_on_char '-' s with
41 | [y; m; d] ->
42 let year = int_of_string y in
43 let month = int_of_string m in
44 let day = int_of_string d in
45 (match Ptime.of_date (year, month, day) with
46 | Some t -> Ok t
47 | None -> Error (Printf.sprintf "Invalid date: %s" s))
48 | _ ->
49 Error (Printf.sprintf "Invalid timestamp: %s" s)
50 with _ ->
51 Error (Printf.sprintf "Invalid timestamp: %s" s)
52 in
53 let enc t =
54 let (y, m, d), ((hh, mm, ss), _) = Ptime.to_date_time t in
55 if hh = 0 && mm = 0 && ss = 0 then
56 Printf.sprintf "%04d-%02d-%02d" y m d
57 else
58 Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ" y m d hh mm ss
59 in
60 Jsont.of_of_string ~kind:"Ptime.t" dec ~enc
61
62let ptime_option_jsont : Ptime.t option Jsont.t =
63 let null = Jsont.null None in
64 let some = Jsont.map ~dec:(fun t -> Some t) ~enc:(function Some t -> t | None -> assert false) ptime_jsont in
65 Jsont.any ~dec_null:null ~dec_string:some ~enc:(function None -> null | Some _ -> some) ()
66
67let string_option_jsont : string option Jsont.t =
68 Jsont.option Jsont.string
69
70(** {1 Helper Functions} *)
71
72let ptime_of_date_exn date =
73 match Ptime.of_date date with
74 | Some t -> t
75 | None ->
76 let (y, m, d) = date in
77 failwith (Printf.sprintf "Invalid date: %04d-%02d-%02d" y m d)
78
79let date_of_ptime t = Ptime.to_date t
80
81let compare_dates (d1 : date) (d2 : date) =
82 let t1 = ptime_of_date_exn d1 in
83 let t2 = ptime_of_date_exn d2 in
84 Ptime.compare t1 t2
85
86let format_date (y, m, d) =
87 Printf.sprintf "%04d-%02d-%02d" y m d
88
89let month_name = function
90 | 1 -> "January" | 2 -> "February" | 3 -> "March" | 4 -> "April"
91 | 5 -> "May" | 6 -> "June" | 7 -> "July" | 8 -> "August"
92 | 9 -> "September" | 10 -> "October" | 11 -> "November" | 12 -> "December"
93 | _ -> "Unknown"
94
95let format_date_human (y, m, _d) =
96 Printf.sprintf "%s %d" (month_name m) y