anil.recoil.org
A CLI and OCaml library for managing contacts
ptime-date
+1
-1
lib/schema/dune
+1
-1
lib/schema/dune
+2
lib/schema/sortal_schema.ml
+2
lib/schema/sortal_schema.ml
···
1
1
module V1 = struct
2
+
module Date = Sortal_schema_date
2
3
module Temporal = Sortal_schema_temporal
3
4
module Feed = Sortal_schema_feed
4
5
module Contact = Sortal_schema_contact_v1
5
6
end
6
7
8
+
module Date = V1.Date
7
9
module Temporal = V1.Temporal
8
10
module Feed = V1.Feed
9
11
module Contact = V1.Contact
+4
lib/schema/sortal_schema.mli
+4
lib/schema/sortal_schema.mli
···
14
14
module V1 : sig
15
15
(** Version 1 of the contact schema (current stable version). *)
16
16
17
+
(** ISO 8601 date handling. *)
18
+
module Date = Sortal_schema_date
19
+
17
20
(** Temporal validity support for time-bounded fields. *)
18
21
module Temporal = Sortal_schema_temporal
19
22
···
30
33
When V2 is introduced, these will continue pointing to V1 for
31
34
backward compatibility. *)
32
35
36
+
module Date = V1.Date
33
37
module Temporal = V1.Temporal
34
38
module Feed = V1.Feed
35
39
module Contact = V1.Contact
+44
lib/schema/sortal_schema_date.ml
+44
lib/schema/sortal_schema_date.ml
···
1
+
type t = Ptime.date
2
+
3
+
let parse s =
4
+
(* Try parsing as RFC 3339 (which may include time) *)
5
+
match Ptime.of_rfc3339 s with
6
+
| Ok (ptime, _, _) -> Some (Ptime.to_date ptime)
7
+
| Error _ ->
8
+
(* Try parsing as just a date string YYYY-MM-DD *)
9
+
match String.split_on_char '-' s with
10
+
| [year_s; month_s; day_s] -> (
11
+
try
12
+
let year = int_of_string year_s in
13
+
let month = int_of_string month_s in
14
+
let day = int_of_string day_s in
15
+
if month >= 1 && month <= 12 && day >= 1 && day <= 31 then
16
+
Some (year, month, day)
17
+
else None
18
+
with Failure _ -> None)
19
+
| _ -> None
20
+
21
+
let format (year, month, day) =
22
+
Printf.sprintf "%04d-%02d-%02d" year month day
23
+
24
+
let pp ppf t = Format.pp_print_string ppf (format t)
25
+
26
+
let to_string = format
27
+
let of_string = parse
28
+
29
+
let today () =
30
+
let open Unix in
31
+
let tm = localtime (time ()) in
32
+
(tm.tm_year + 1900, tm.tm_mon + 1, tm.tm_mday)
33
+
34
+
let jsont =
35
+
let kind = "ISO 8601 date" in
36
+
let doc = "An ISO 8601 date string (YYYY-MM-DD)" in
37
+
let dec s =
38
+
match parse s with
39
+
| Some t -> t
40
+
| None ->
41
+
Jsont.Error.msgf Jsont.Meta.none "%s: invalid ISO 8601 date: %S" kind s
42
+
in
43
+
let enc = format in
44
+
Jsont.map ~kind ~doc ~dec ~enc Jsont.string
+52
lib/schema/sortal_schema_date.mli
+52
lib/schema/sortal_schema_date.mli
···
1
+
(** ISO 8601 date handling for contact data.
2
+
3
+
Provides parsing, formatting, and jsont combinators for ISO 8601 dates.
4
+
Time components in parsed strings are ignored, only the date is extracted.
5
+
6
+
@see <https://www.iso.org/iso-8601-date-and-time-format.html> ISO 8601 *)
7
+
8
+
type t = Ptime.date
9
+
(** [t] represents a date as (year, month, day) tuple. *)
10
+
11
+
val jsont : t Jsont.t
12
+
(** [jsont] is a bidirectional JSON type for ISO 8601 dates.
13
+
14
+
On decode: accepts JSON strings in ISO 8601 date format (e.g., "2024-11-03")
15
+
or RFC 3339 format with times (e.g., "2024-11-03T10:30:00Z"), extracting
16
+
only the date component.
17
+
18
+
On encode: produces dates in YYYY-MM-DD format.
19
+
20
+
{b Example:}
21
+
{[
22
+
let date = (2024, 11, 3) in
23
+
Jsont_bytesrw.encode_string Date.jsont date
24
+
(* Returns: "2024-11-03" *)
25
+
]} *)
26
+
27
+
val parse : string -> t option
28
+
(** [parse s] parses an ISO 8601 date string.
29
+
30
+
Accepts various formats:
31
+
- "2024-11-03" (date only)
32
+
- "2024-11-03T10:30:00Z" (RFC 3339 with time, extracts date)
33
+
- "2024-11-03T10:30:00-08:00" (with timezone, extracts date)
34
+
35
+
Returns [None] if the string is not a valid date format. *)
36
+
37
+
val format : t -> string
38
+
(** [format t] formats a date as ISO 8601 (YYYY-MM-DD).
39
+
40
+
{b Example output:} ["2024-11-03"] *)
41
+
42
+
val pp : Format.formatter -> t -> unit
43
+
(** [pp ppf t] pretty prints a date in ISO 8601 format. *)
44
+
45
+
val to_string : t -> string
46
+
(** [to_string t] is an alias for {!format}. *)
47
+
48
+
val of_string : string -> t option
49
+
(** [of_string s] is an alias for {!parse}. *)
50
+
51
+
val today : unit -> t
52
+
(** [today ()] returns today's date in the local timezone. *)
+42
test/test_schema.ml
+42
test/test_schema.ml
···
1
+
(** Schema-only tests (no I/O dependencies) *)
2
+
3
+
let test_temporal () =
4
+
let r = Sortal_schema.Temporal.make ~from:"2020-01" ~until:"2023-12" () in
5
+
assert (Sortal_schema.Temporal.valid_at (Some r) ~date:"2021-06");
6
+
assert (not (Sortal_schema.Temporal.valid_at (Some r) ~date:"2024-01"));
7
+
print_endline "✓ Temporal ranges work"
8
+
9
+
let test_feed_types () =
10
+
let feed = Sortal_schema.Feed.make ~feed_type:Atom ~url:"https://example.com/feed" () in
11
+
assert (Sortal_schema.Feed.url feed = "https://example.com/feed");
12
+
print_endline "✓ Feed types work"
13
+
14
+
let test_contact_construction () =
15
+
let c = Sortal_schema.Contact.make
16
+
~handle:"test"
17
+
~names:["Test User"]
18
+
~emails:[Sortal_schema.Contact.email_of_string "test@example.com"]
19
+
() in
20
+
assert (Sortal_schema.Contact.handle c = "test");
21
+
assert (Sortal_schema.Contact.name c = "Test User");
22
+
print_endline "✓ Contact construction works"
23
+
24
+
let test_json_roundtrip () =
25
+
let c = Sortal_schema.Contact.make ~handle:"json" ~names:["JSON Test"] () in
26
+
match Jsont_bytesrw.encode_string Sortal_schema.Contact.json_t c with
27
+
| Ok json ->
28
+
(match Jsont_bytesrw.decode_string Sortal_schema.Contact.json_t json with
29
+
| Ok decoded ->
30
+
assert (Sortal_schema.Contact.handle decoded = "json");
31
+
assert (Sortal_schema.Contact.name decoded = "JSON Test");
32
+
print_endline "✓ JSON roundtrip works"
33
+
| Error e -> failwith ("Decode failed: " ^ e))
34
+
| Error e -> failwith ("Encode failed: " ^ e)
35
+
36
+
let () =
37
+
print_endline "\n=== Schema Tests ===\n";
38
+
test_temporal ();
39
+
test_feed_types ();
40
+
test_contact_construction ();
41
+
test_json_roundtrip ();
42
+
print_endline "\n=== All Schema Tests Passed ===\n"