anil.recoil.org
A CLI and OCaml library for managing contacts
use ptime
+7
-64
README.md
+7
-64
README.md
···
1
# Sortal - Contact Metadata Management Library
2
3
-
Sortal is an OCaml library that provides a comprehensive system for managing contact metadata with temporal validity tracking. It stores data in XDG-compliant locations using YAML format and optionally versions all changes with git.
4
5
## Features
6
···
83
) all_contacts
84
```
85
86
-
### Integration with Eiocmd (for CLI applications)
87
-
88
-
```ocaml
89
-
open Cmdliner
90
-
91
-
let my_command env xdg profile =
92
-
(* Create store from XDG context *)
93
-
let store = Sortal.create_from_xdg xdg in
94
-
95
-
(* Search for a contact *)
96
-
let matches = Sortal.search_all store "John" in
97
-
List.iter (fun c ->
98
-
match Sortal.Contact.best_url c with
99
-
| Some url -> Logs.app (fun m -> m "%s: %s" (Sortal.Contact.name c) url)
100
-
| None -> ()
101
-
) matches;
102
-
0
103
-
104
-
(* Use Sortal's built-in commands *)
105
-
let () =
106
-
let info = Cmd.info "myapp" in
107
-
let my_cmd = Eiocmd.run ~info ~app_name:"myapp" ~service:"myapp"
108
-
Term.(const my_command) in
109
-
110
-
(* Include sortal commands as subcommands *)
111
-
let list_contacts = Eiocmd.run ~use_keyeio:false
112
-
~info:Sortal.Cmd.list_info ~app_name:"myapp" ~service:"myapp"
113
-
Term.(const (fun () -> Sortal.Cmd.list_cmd ()) $ const ()) in
114
-
115
-
let cmd = Cmd.group info [my_cmd; list_contacts] in
116
-
exit (Cmd.eval' cmd)
117
-
```
118
-
119
-
## Design Inspiration
120
-
121
-
The contact metadata structure is inspired by the Contact module from [Bushel](https://github.com/avsm/bushel), adapted to use JSON instead of YAML and stored in XDG-compliant locations.
122
-
123
-
## Dependencies
124
-
125
-
- `eio`: For effect-based I/O
126
-
- `xdge`: For XDG Base Directory Specification support
127
-
- `jsont`: For type-safe JSON encoding/decoding
128
-
- `fmt`: For pretty printing
129
-
130
-
## API Features
131
-
132
-
The library provides two main ways to use contact metadata:
133
-
134
-
1. **Core API**: Direct functions for creating, saving, loading, and searching contacts
135
-
- `create` / `create_from_xdg`: Initialize a contact store
136
-
- `save` / `lookup` / `delete` / `list`: CRUD operations
137
-
- `search_all`: Flexible search across contact names
138
-
- `find_by_name` / `find_by_name_opt`: Exact name matching
139
-
140
-
2. **Cmdliner Integration** (`Sortal.Cmd` module): Ready-to-use CLI commands
141
-
- `list_cmd`: List all contacts
142
-
- `show_cmd`: Show detailed contact information
143
-
- `search_cmd`: Search contacts by name
144
-
- `stats_cmd`: Show database statistics
145
-
- Pre-configured `Cmd.info` and argument definitions for easy integration
146
-
147
## CLI Tool
148
149
The library includes a standalone `sortal` CLI tool with full CRUD functionality:
···
188
189
## Git Versioning
190
191
-
Sortal includes a `Sortal_git_store` module that provides automatic git commits for all contact modifications:
192
193
```ocaml
194
open Sortal
···
220
221
## Project Status
222
223
-
Fully implemented and tested with 420 imported contacts.
···
1
# Sortal - Contact Metadata Management Library
2
3
+
Sortal is an OCaml library that provides a comprehensive system for managing
4
+
contact metadata with temporal validity tracking. It stores data in
5
+
XDG-compliant locations using the YAML format and optionally versions all changes
6
+
with git.
7
8
## Features
9
···
86
) all_contacts
87
```
88
89
## CLI Tool
90
91
The library includes a standalone `sortal` CLI tool with full CRUD functionality:
···
130
131
## Git Versioning
132
133
+
Sortal includes a `Sortal_git_store` module that provides automatic git commits
134
+
for all contact modifications:
135
136
```ocaml
137
open Sortal
···
163
164
## Project Status
165
166
+
Still very much just used by Anil Madhavapeddy. You're welcome to try it, but let me know...
+11
-5
bin/sortal_cli.ml
+11
-5
bin/sortal_cli.ml
···
6
Fmt.set_style_renderer Fmt.stdout `Ansi_tty;
7
Fmt.set_style_renderer Fmt.stderr `Ansi_tty;
8
9
let info = Cmd.info "sortal"
10
~version:"0.1.0"
11
~doc:"Contact metadata management"
···
17
`P "Use $(b,sortal COMMAND --help) for detailed help on each command.";
18
]
19
in
20
-
21
-
Eio_main.run @@ fun env ->
22
-
23
-
let xdg_term = Xdge.Cmd.term "sortal" env#fs () in
24
25
let make_term info main_term =
26
let term =
···
214
Cmd.v Sortal.Cmd.remove_url_info term
215
in
216
217
-
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
218
219
let cmd = Cmd.group info ~default:default_term [
220
list_cmd;
···
6
Fmt.set_style_renderer Fmt.stdout `Ansi_tty;
7
Fmt.set_style_renderer Fmt.stderr `Ansi_tty;
8
9
+
Eio_main.run @@ fun env ->
10
+
11
+
let xdg_term = Xdge.Cmd.term "sortal" env#fs ~dirs:[`Data] () in
12
+
13
let info = Cmd.info "sortal"
14
~version:"0.1.0"
15
~doc:"Contact metadata management"
···
21
`P "Use $(b,sortal COMMAND --help) for detailed help on each command.";
22
]
23
in
24
25
let make_term info main_term =
26
let term =
···
214
Cmd.v Sortal.Cmd.remove_url_info term
215
in
216
217
+
let default_term =
218
+
let open Term.Syntax in
219
+
let+ _ = xdg_term
220
+
and+ _ = Logs_cli.level () in
221
+
`Help (`Pager, None)
222
+
in
223
+
let default_term = Term.ret default_term in
224
225
let cmd = Cmd.group info ~default:default_term [
226
list_cmd;
+1
dune-project
+1
dune-project
+15
lib/core/sortal_cmd.ml
+15
lib/core/sortal_cmd.ml
···
191
Logs.err (fun m -> m "%s" msg);
192
1
193
194
(* Add email to existing contact *)
195
let add_email_cmd handle address type_ from until note xdg env =
196
let store = Sortal_store.create_from_xdg xdg in
197
let git_store = Sortal_git_store.create store env in
198
let email = Contact.make_email ?type_ ?from ?until ?note address in
199
match Sortal_git_store.add_email git_store handle email with
200
| Ok () ->
···
245
let add_org_cmd handle org_name title department from until org_email org_url xdg env =
246
let store = Sortal_store.create_from_xdg xdg in
247
let git_store = Sortal_git_store.create store env in
248
let org = Contact.make_org ?title ?department ?from ?until ?email:org_email ?url:org_url org_name in
249
match Sortal_git_store.add_organization git_store handle org with
250
| Ok () ->
···
191
Logs.err (fun m -> m "%s" msg);
192
1
193
194
+
(* Convert string option to Ptime.date option *)
195
+
let parse_date_opt (s_opt : string option) : Sortal_schema.Temporal.date option =
196
+
match s_opt with
197
+
| None -> None
198
+
| Some s ->
199
+
match Sortal_schema.Temporal.parse_date_string s with
200
+
| Some d -> Some d
201
+
| None ->
202
+
Logs.warn (fun m -> m "Invalid date format: %s (using ISO 8601: YYYY, YYYY-MM, or YYYY-MM-DD)" s);
203
+
None
204
+
205
(* Add email to existing contact *)
206
let add_email_cmd handle address type_ from until note xdg env =
207
let store = Sortal_store.create_from_xdg xdg in
208
let git_store = Sortal_git_store.create store env in
209
+
let from = parse_date_opt from in
210
+
let until = parse_date_opt until in
211
let email = Contact.make_email ?type_ ?from ?until ?note address in
212
match Sortal_git_store.add_email git_store handle email with
213
| Ok () ->
···
258
let add_org_cmd handle org_name title department from until org_email org_url xdg env =
259
let store = Sortal_store.create_from_xdg xdg in
260
let git_store = Sortal_git_store.create store env in
261
+
let from = parse_date_opt from in
262
+
let until = parse_date_opt until in
263
let org = Contact.make_org ?title ?department ?from ?until ?email:org_email ?url:org_url org_name in
264
match Sortal_git_store.add_organization git_store handle org with
265
| Ok () ->
+1
-1
lib/schema/dune
+1
-1
lib/schema/dune
-2
lib/schema/sortal_schema.ml
-2
lib/schema/sortal_schema.ml
···
1
module V1 = struct
2
-
module Date = Sortal_schema_date
3
module Temporal = Sortal_schema_temporal
4
module Feed = Sortal_schema_feed
5
module Contact = Sortal_schema_contact_v1
6
end
7
8
-
module Date = V1.Date
9
module Temporal = V1.Temporal
10
module Feed = V1.Feed
11
module Contact = V1.Contact
+3
-7
lib/schema/sortal_schema.mli
+3
-7
lib/schema/sortal_schema.mli
···
1
(** Sortal Schema - Versioned data types and serialization
2
3
This library provides versioned schema definitions for contact metadata
4
-
with no I/O dependencies. It includes:
5
- Temporal validity support (ISO 8601 dates and ranges)
6
- Feed subscription types
7
- Contact metadata schemas (versioned)
8
9
-
The schema library depends only on jsont, yamlt, bytesrw, and fmt
10
-
for serialization and formatting. *)
11
12
(** {1 Schema Version 1} *)
13
14
module V1 : sig
15
(** Version 1 of the contact schema (current stable version). *)
16
-
17
-
(** ISO 8601 date handling. *)
18
-
module Date = Sortal_schema_date
19
20
(** Temporal validity support for time-bounded fields. *)
21
module Temporal = Sortal_schema_temporal
···
33
When V2 is introduced, these will continue pointing to V1 for
34
backward compatibility. *)
35
36
-
module Date = V1.Date
37
module Temporal = V1.Temporal
38
module Feed = V1.Feed
39
module Contact = V1.Contact
···
1
(** Sortal Schema - Versioned data types and serialization
2
3
This library provides versioned schema definitions for contact metadata
4
+
with minimal I/O dependencies. It includes:
5
- Temporal validity support (ISO 8601 dates and ranges)
6
- Feed subscription types
7
- Contact metadata schemas (versioned)
8
9
+
The schema library depends on jsont, yamlt, bytesrw, fmt for serialization
10
+
and formatting, plus ptime and ptime.clock.os for date/time operations. *)
11
12
(** {1 Schema Version 1} *)
13
14
module V1 : sig
15
(** Version 1 of the contact schema (current stable version). *)
16
17
(** Temporal validity support for time-bounded fields. *)
18
module Temporal = Sortal_schema_temporal
···
30
When V2 is introduced, these will continue pointing to V1 for
31
backward compatibility. *)
32
33
module Temporal = V1.Temporal
34
module Feed = V1.Feed
35
module Contact = V1.Contact
+10
-3
lib/schema/sortal_schema_contact_v1.ml
+10
-3
lib/schema/sortal_schema_contact_v1.ml
···
369
| None -> ()
370
| Some { Sortal_schema_temporal.from; until } ->
371
match from, until with
372
-
| Some f, Some u -> pf ppf " %a" (date_style string) (Printf.sprintf "[%s to %s]" f u)
373
-
| Some f, None -> pf ppf " %a" (date_style string) (Printf.sprintf "[from %s]" f)
374
-
| None, Some u -> pf ppf " %a" (date_style string) (Printf.sprintf "[until %s]" u)
375
| None, None -> ()
376
in
377
···
369
| None -> ()
370
| Some { Sortal_schema_temporal.from; until } ->
371
match from, until with
372
+
| Some f, Some u ->
373
+
let fs = Sortal_schema_temporal.format_date f in
374
+
let us = Sortal_schema_temporal.format_date u in
375
+
pf ppf " %a" (date_style string) (Printf.sprintf "[%s to %s]" fs us)
376
+
| Some f, None ->
377
+
let fs = Sortal_schema_temporal.format_date f in
378
+
pf ppf " %a" (date_style string) (Printf.sprintf "[from %s]" fs)
379
+
| None, Some u ->
380
+
let us = Sortal_schema_temporal.format_date u in
381
+
pf ppf " %a" (date_style string) (Printf.sprintf "[until %s]" us)
382
| None, None -> ()
383
in
384
lib/schema/sortal_schema_date.ml
lib/schema/sortal_schema_date.ml.unused
lib/schema/sortal_schema_date.ml
lib/schema/sortal_schema_date.ml.unused
lib/schema/sortal_schema_date.mli
lib/schema/sortal_schema_date.mli.unused
lib/schema/sortal_schema_date.mli
lib/schema/sortal_schema_date.mli.unused
+55
-12
lib/schema/sortal_schema_temporal.ml
+55
-12
lib/schema/sortal_schema_temporal.ml
···
1
-
type date = string
2
3
type range = {
4
from: date option;
···
9
10
let always = { from = None; until = None }
11
12
-
(* Compare ISO 8601 dates lexicographically - works for YYYY, YYYY-MM, YYYY-MM-DD *)
13
-
let date_compare (d1 : date) (d2 : date) : int =
14
-
String.compare d1 d2
15
16
let date_gte d1 d2 = date_compare d1 d2 >= 0
17
···
46
r1_starts_before_r2_ends && r2_starts_before_r1_ends
47
48
let today () =
49
-
let open Unix in
50
-
let tm = localtime (time ()) in
51
-
Printf.sprintf "%04d-%02d-%02d"
52
-
(tm.tm_year + 1900)
53
-
(tm.tm_mon + 1)
54
-
tm.tm_mday
55
56
let is_current range_opt =
57
valid_at range_opt ~date:(today ())
···
76
| Some r -> overlaps r query_range
77
) list
78
79
let json_t =
80
let open Jsont in
81
let open Jsont.Object in
82
let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
83
let make_range from until = { from; until } in
84
map ~kind:"TemporalRange" make_range
85
-
|> mem_opt "from" (some string) ~enc:(fun r -> r.from)
86
-
|> mem_opt "until" (some string) ~enc:(fun r -> r.until)
87
|> finish
···
1
+
type date = Ptime.date
2
3
type range = {
4
from: date option;
···
9
10
let always = { from = None; until = None }
11
12
+
(* Compare Ptime dates (year, month, day tuples) *)
13
+
let date_compare ((y1, m1, d1) : date) ((y2, m2, d2) : date) : int =
14
+
match compare y1 y2 with
15
+
| 0 -> (
16
+
match compare m1 m2 with
17
+
| 0 -> compare d1 d2
18
+
| c -> c)
19
+
| c -> c
20
21
let date_gte d1 d2 = date_compare d1 d2 >= 0
22
···
51
r1_starts_before_r2_ends && r2_starts_before_r1_ends
52
53
let today () =
54
+
Ptime_clock.now () |> Ptime.to_date
55
56
let is_current range_opt =
57
valid_at range_opt ~date:(today ())
···
76
| Some r -> overlaps r query_range
77
) list
78
79
+
(* Parse ISO 8601 date string to Ptime.date, handling partial dates *)
80
+
let parse_date_string (s : string) : date option =
81
+
match String.split_on_char '-' s with
82
+
| [year_s] -> (
83
+
try
84
+
let year = int_of_string year_s in
85
+
Some (year, 1, 1) (* Year only → January 1st *)
86
+
with Failure _ -> None)
87
+
| [year_s; month_s] -> (
88
+
try
89
+
let year = int_of_string year_s in
90
+
let month = int_of_string month_s in
91
+
if month >= 1 && month <= 12 then
92
+
Some (year, month, 1) (* Year-Month → 1st of month *)
93
+
else None
94
+
with Failure _ -> None)
95
+
| [year_s; month_s; day_s] -> (
96
+
try
97
+
let year = int_of_string year_s in
98
+
let month = int_of_string month_s in
99
+
let day = int_of_string day_s in
100
+
if month >= 1 && month <= 12 && day >= 1 && day <= 31 then
101
+
Some (year, month, day)
102
+
else None
103
+
with Failure _ -> None)
104
+
| _ -> None
105
+
106
+
(* Format Ptime.date as ISO 8601 string YYYY-MM-DD *)
107
+
let format_date ((year, month, day) : date) : string =
108
+
Printf.sprintf "%04d-%02d-%02d" year month day
109
+
110
let json_t =
111
let open Jsont in
112
let open Jsont.Object in
113
let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
114
+
115
+
(* Create a jsont type for date that converts between string and Ptime.date *)
116
+
let date_jsont =
117
+
let dec meta s =
118
+
match parse_date_string s with
119
+
| Some d -> d
120
+
| None -> Error.msgf meta "TemporalDate: invalid ISO 8601 date: %S" s
121
+
in
122
+
let enc = format_date in
123
+
Base.string (Base.map ~kind:"TemporalDate" ~dec ~enc ())
124
+
in
125
+
126
let make_range from until = { from; until } in
127
map ~kind:"TemporalRange" make_range
128
+
|> mem_opt "from" (some date_jsont) ~enc:(fun r -> r.from)
129
+
|> mem_opt "until" (some date_jsont) ~enc:(fun r -> r.until)
130
|> finish
+24
-7
lib/schema/sortal_schema_temporal.mli
+24
-7
lib/schema/sortal_schema_temporal.mli
···
4
information in contacts, such as emails valid only during certain
5
employment periods. *)
6
7
-
(** ISO 8601 date string.
8
9
-
Supports multiple granularities:
10
-
- Year: ["2001"]
11
-
- Year-Month: ["2001-01"]
12
-
- Full date: ["2001-01-15"]
13
14
-
For querying, partial dates are treated as inclusive ranges. *)
15
-
type date = string
16
17
(** A temporal range indicating validity period. *)
18
type range = {
···
4
information in contacts, such as emails valid only during certain
5
employment periods. *)
6
7
+
(** Date represented as a Ptime.date tuple (year, month, day).
8
+
9
+
When parsing from strings, partial dates are normalized:
10
+
- Year: ["2001"] → (2001, 1, 1)
11
+
- Year-Month: ["2001-01"] → (2001, 1, 1)
12
+
- Full date: ["2001-01-15"] → (2001, 1, 15) *)
13
+
type date = Ptime.date
14
+
15
+
(** {1 Date Conversion} *)
16
+
17
+
(** [parse_date_string s] parses an ISO 8601 date string.
18
+
19
+
Accepts various formats with partial date support:
20
+
- "2001" (year only) → (2001, 1, 1)
21
+
- "2001-01" (year-month) → (2001, 1, 1)
22
+
- "2001-01-15" (full date) → (2001, 1, 15)
23
+
24
+
Returns [None] if the string is not a valid date format. *)
25
+
val parse_date_string : string -> date option
26
27
+
(** [format_date date] formats a date as ISO 8601 (YYYY-MM-DD).
28
+
29
+
{b Example:} [format_date (2001, 1, 15)] returns ["2001-01-15"] *)
30
+
val format_date : date -> string
31
32
+
(** {1 Temporal Ranges} *)
33
34
(** A temporal range indicating validity period. *)
35
type range = {
+9
-3
test/test_schema.ml
+9
-3
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 () =
···
1
(** Schema-only tests (no I/O dependencies) *)
2
3
let test_temporal () =
4
+
(* Parse dates from strings *)
5
+
let from_date = Sortal_schema.Temporal.parse_date_string "2020-01" |> Option.get in
6
+
let until_date = Sortal_schema.Temporal.parse_date_string "2023-12" |> Option.get in
7
+
let test_date_1 = Sortal_schema.Temporal.parse_date_string "2021-06" |> Option.get in
8
+
let test_date_2 = Sortal_schema.Temporal.parse_date_string "2024-01" |> Option.get in
9
+
10
+
let r = Sortal_schema.Temporal.make ~from:from_date ~until:until_date () in
11
+
assert (Sortal_schema.Temporal.valid_at (Some r) ~date:test_date_1);
12
+
assert (not (Sortal_schema.Temporal.valid_at (Some r) ~date:test_date_2));
13
print_endline "✓ Temporal ranges work"
14
15
let test_feed_types () =