anil.recoil.org
A CLI and OCaml library for managing contacts
refactor
+828
-510
+223
README.md
+223
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
+
7
+
- **Temporal Support**: Track how contact information changes over time (emails, organizations, URLs)
8
+
- **XDG-compliant storage**: Contact metadata stored in standard XDG data directories
9
+
- **YAML format**: Human-readable YAML files with type-safe encoding/decoding using yamlt
10
+
- **Rich metadata**: Support for multiple names, emails (typed), organizations, services (GitHub, social media), ORCID, URLs, and Atom feeds
11
+
- **Git Versioning**: Optional automatic git commits for all changes with descriptive messages
12
+
- **CLI Interface**: Full command-line interface for CRUD operations on contacts
13
+
- **Simple API**: Easy-to-use functions for saving, loading, searching, and deleting contacts
14
+
15
+
## Metadata Fields
16
+
17
+
Each contact can include:
18
+
19
+
- `handle`: Unique identifier/username (required)
20
+
- `names`: List of full names with primary name first (required)
21
+
- `email`: Email address
22
+
- `icon`: Avatar/icon URL
23
+
- `thumbnail`: Path to a local thumbnail image file
24
+
- `github`: GitHub username
25
+
- `twitter`: Twitter/X username
26
+
- `bluesky`: Bluesky handle
27
+
- `mastodon`: Mastodon handle (with instance)
28
+
- `orcid`: ORCID identifier
29
+
- `url`: Personal/professional website
30
+
- `atom_feeds`: List of Atom/RSS feed URLs
31
+
32
+
## Storage
33
+
34
+
Contact data is stored as individual YAML files in the XDG data directory:
35
+
36
+
- Default location: `$HOME/.local/share/sortal/`
37
+
- Override with: `SORTAL_DATA_DIR` or `XDG_DATA_HOME`
38
+
- Each contact stored as: `{handle}.yaml`
39
+
- Format: Human-readable YAML with temporal data support
40
+
41
+
## Usage Example
42
+
43
+
### Basic Usage
44
+
45
+
```ocaml
46
+
(* Create a contact store from filesystem *)
47
+
let store = Sortal.create env#fs "myapp" in
48
+
49
+
(* Or create from an existing XDG context (recommended when using eiocmd) *)
50
+
let store = Sortal.create_from_xdg xdg in
51
+
52
+
(* Create a new contact *)
53
+
let contact = Sortal.Contact.make
54
+
~handle:"avsm"
55
+
~names:["Anil Madhavapeddy"]
56
+
~email:"anil@recoil.org"
57
+
~github:"avsm"
58
+
~orcid:"0000-0002-7890-1234"
59
+
() in
60
+
61
+
(* Save the contact *)
62
+
Sortal.save store contact;
63
+
64
+
(* Lookup by handle *)
65
+
match Sortal.lookup store "avsm" with
66
+
| Some c -> Printf.printf "Found: %s\n" (Sortal.Contact.name c)
67
+
| None -> Printf.printf "Not found\n"
68
+
69
+
(* Search for contacts by name *)
70
+
let matches = Sortal.search_all store "Anil" in
71
+
List.iter (fun c ->
72
+
Printf.printf "%s: %s\n"
73
+
(Sortal.Contact.handle c)
74
+
(Sortal.Contact.name c)
75
+
) matches
76
+
77
+
(* List all contacts *)
78
+
let all_contacts = Sortal.list store in
79
+
List.iter (fun c ->
80
+
Printf.printf "%s: %s\n"
81
+
(Sortal.Contact.handle c)
82
+
(Sortal.Contact.name c)
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:
150
+
151
+
```bash
152
+
# Initialize git versioning (optional)
153
+
sortal git-init
154
+
155
+
# List all contacts
156
+
sortal list
157
+
158
+
# Show details for a specific contact
159
+
sortal show avsm
160
+
161
+
# Search for contacts
162
+
sortal search "Anil"
163
+
164
+
# Show database statistics
165
+
sortal stats
166
+
167
+
# Add a new contact
168
+
sortal add jsmith --name "John Smith" --email "john@example.com" --kind person
169
+
170
+
# Add metadata to contacts
171
+
sortal add-org jsmith "Acme Corp" --title "Software Engineer" --from 2020-01
172
+
sortal add-service jsmith "https://github.com/jsmith" --kind github --handle jsmith
173
+
sortal add-email jsmith "john.work@example.com" --type work --from 2020-01
174
+
sortal add-url jsmith "https://jsmith.example.com" --label "Personal website"
175
+
176
+
# Remove metadata
177
+
sortal remove-email jsmith "old@example.com"
178
+
sortal remove-service jsmith "https://old-service.com"
179
+
sortal remove-org jsmith "Old Company"
180
+
sortal remove-url jsmith "https://old-url.com"
181
+
182
+
# Delete a contact
183
+
sortal delete jsmith
184
+
185
+
# Synchronize data (convert thumbnails to PNG)
186
+
sortal sync
187
+
```
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
195
+
196
+
(* Create a git-backed store *)
197
+
let git_store = Git_store.create store env in
198
+
199
+
(* Initialize git repository *)
200
+
let () = match Git_store.init git_store with
201
+
| Ok () -> Logs.app (fun m -> m "Git initialized")
202
+
| Error msg -> Logs.err (fun m -> m "Error: %s" msg)
203
+
in
204
+
205
+
(* Save a contact - automatically commits with descriptive message *)
206
+
let contact = Contact.make ~handle:"jsmith" ~names:["John Smith"] () in
207
+
match Git_store.save git_store contact with
208
+
| Ok () -> Logs.app (fun m -> m "Contact saved and committed")
209
+
| Error msg -> Logs.err (fun m -> m "Error: %s" msg)
210
+
```
211
+
212
+
**Commit Messages**: All git store operations create descriptive commit messages:
213
+
- `save`: "Add contact @handle (Name)" or "Update contact @handle (Name)"
214
+
- `delete`: "Delete contact @handle (Name)"
215
+
- `add_email`: "Update @handle: add email address@example.com"
216
+
- `remove_email`: "Update @handle: remove email address@example.com"
217
+
- `add_service`: "Update @handle: add service Kind (url)"
218
+
- `add_organization`: "Update @handle: add organization Org Name"
219
+
- And similar for all other operations
220
+
221
+
## Project Status
222
+
223
+
Fully implemented and tested with 420 imported contacts.
+12
-1
bin/dune
+12
-1
bin/dune
···
1
1
(executable
2
2
(name sortal_cli)
3
3
(public_name sortal)
4
-
(libraries eio eio_main sortal xdge cmdliner logs logs.cli logs.fmt fmt fmt.tty))
4
+
(libraries
5
+
sortal
6
+
sortal.schema
7
+
eio
8
+
eio_main
9
+
xdge
10
+
cmdliner
11
+
logs
12
+
logs.cli
13
+
logs.fmt
14
+
fmt
15
+
fmt.tty))
+11
-3
dune-project
+11
-3
dune-project
···
4
4
5
5
(package
6
6
(name sortal)
7
-
(synopsis "Keep track of users and their metadata in a collective web")
7
+
(synopsis "Contact metadata management with XDG storage and versioned schemas")
8
8
(description
9
-
"Sortal provides a system for mapping usernames to various metadata including URLs, emails, ORCID identifiers, and social media handles.")
9
+
"Sortal provides contact metadata management with versioned schemas,
10
+
XDG-compliant storage, git versioning, and CLI tools.
11
+
12
+
The library is split into two components:
13
+
- sortal.schema: Versioned data types with minimal dependencies
14
+
- sortal: Core library with storage, git integration, and CLI support")
10
15
(depends
11
16
(ocaml (>= 5.1.0))
12
17
eio
···
14
19
xdge
15
20
jsont
16
21
yamlt
17
-
fmt))
22
+
bytesrw
23
+
fmt
24
+
cmdliner
25
+
logs))
+17
lib/core/dune
+17
lib/core/dune
+365
lib/core/sortal_store.ml
+365
lib/core/sortal_store.ml
···
1
+
module Contact = Sortal_schema.Contact
2
+
module Temporal = Sortal_schema.Temporal
3
+
4
+
type t = {
5
+
xdg : Xdge.t; [@warning "-69"]
6
+
data_dir : Eio.Fs.dir_ty Eio.Path.t;
7
+
}
8
+
9
+
let create fs app_name =
10
+
let xdg = Xdge.create fs app_name in
11
+
let data_dir = Xdge.data_dir xdg in
12
+
{ xdg; data_dir }
13
+
14
+
let create_from_xdg xdg =
15
+
let data_dir = Xdge.data_dir xdg in
16
+
{ xdg; data_dir }
17
+
18
+
let contact_file t handle =
19
+
Eio.Path.(t.data_dir / (handle ^ ".yaml"))
20
+
21
+
let save t contact =
22
+
let path = contact_file t (Contact.handle contact) in
23
+
let buf = Buffer.create 4096 in
24
+
let writer = Bytesrw.Bytes.Writer.of_buffer buf in
25
+
match Yamlt.encode Contact.json_t contact ~eod:true writer with
26
+
| Ok () -> Eio.Path.save ~create:(`Or_truncate 0o644) path (Buffer.contents buf)
27
+
| Error err -> failwith ("Failed to encode contact: " ^ err)
28
+
29
+
let lookup t handle =
30
+
let path = contact_file t handle in
31
+
try
32
+
let yaml_str = Eio.Path.load path in
33
+
let reader = Bytesrw.Bytes.Reader.of_string yaml_str in
34
+
match Yamlt.decode Contact.json_t reader with
35
+
| Ok contact -> Some contact
36
+
| Error msg ->
37
+
Logs.warn (fun m -> m "Failed to decode contact %s: %s" handle msg);
38
+
None
39
+
with exn ->
40
+
Logs.warn (fun m -> m "Failed to load contact %s: %s" handle (Printexc.to_string exn));
41
+
None
42
+
43
+
let delete t handle =
44
+
let path = contact_file t handle in
45
+
try
46
+
Eio.Path.unlink path
47
+
with
48
+
| _ -> ()
49
+
50
+
(* Contact modification helpers *)
51
+
let update_contact t handle f =
52
+
match lookup t handle with
53
+
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
54
+
| Some contact ->
55
+
let updated = f contact in
56
+
save t updated;
57
+
Ok ()
58
+
59
+
let add_email t handle (email : Contact.email) =
60
+
match lookup t handle with
61
+
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
62
+
| Some contact ->
63
+
let emails = Contact.emails contact in
64
+
(* Check for duplicate email address *)
65
+
if List.exists (fun (e : Contact.email) -> e.address = email.address) emails then
66
+
Error (Printf.sprintf "Email %s already exists for contact @%s" email.address handle)
67
+
else
68
+
update_contact t handle (fun contact ->
69
+
let emails = Contact.emails contact in
70
+
Contact.make
71
+
~handle:(Contact.handle contact)
72
+
~names:(Contact.names contact)
73
+
~kind:(Contact.kind contact)
74
+
~emails:(emails @ [email])
75
+
~organizations:(Contact.organizations contact)
76
+
~urls:(Contact.urls contact)
77
+
~services:(Contact.services contact)
78
+
?icon:(Contact.icon contact)
79
+
?thumbnail:(Contact.thumbnail contact)
80
+
?orcid:(Contact.orcid contact)
81
+
?feeds:(Contact.feeds contact)
82
+
()
83
+
)
84
+
85
+
let remove_email t handle address =
86
+
update_contact t handle (fun contact ->
87
+
let emails = Contact.emails contact
88
+
|> List.filter (fun (e : Contact.email) -> e.address <> address) in
89
+
Contact.make
90
+
~handle:(Contact.handle contact)
91
+
~names:(Contact.names contact)
92
+
~kind:(Contact.kind contact)
93
+
~emails
94
+
~organizations:(Contact.organizations contact)
95
+
~urls:(Contact.urls contact)
96
+
~services:(Contact.services contact)
97
+
?icon:(Contact.icon contact)
98
+
?thumbnail:(Contact.thumbnail contact)
99
+
?orcid:(Contact.orcid contact)
100
+
?feeds:(Contact.feeds contact)
101
+
()
102
+
)
103
+
104
+
let add_service t handle (service : Contact.service) =
105
+
match lookup t handle with
106
+
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
107
+
| Some contact ->
108
+
let services = Contact.services contact in
109
+
(* Check for duplicate service URL *)
110
+
if List.exists (fun (s : Contact.service) -> s.url = service.url) services then
111
+
Error (Printf.sprintf "Service URL %s already exists for contact @%s" service.url handle)
112
+
else
113
+
update_contact t handle (fun contact ->
114
+
let services = Contact.services contact in
115
+
Contact.make
116
+
~handle:(Contact.handle contact)
117
+
~names:(Contact.names contact)
118
+
~kind:(Contact.kind contact)
119
+
~emails:(Contact.emails contact)
120
+
~organizations:(Contact.organizations contact)
121
+
~urls:(Contact.urls contact)
122
+
~services:(services @ [service])
123
+
?icon:(Contact.icon contact)
124
+
?thumbnail:(Contact.thumbnail contact)
125
+
?orcid:(Contact.orcid contact)
126
+
?feeds:(Contact.feeds contact)
127
+
()
128
+
)
129
+
130
+
let remove_service t handle url =
131
+
update_contact t handle (fun contact ->
132
+
let services = Contact.services contact
133
+
|> List.filter (fun (s : Contact.service) -> s.url <> url) in
134
+
Contact.make
135
+
~handle:(Contact.handle contact)
136
+
~names:(Contact.names contact)
137
+
~kind:(Contact.kind contact)
138
+
~emails:(Contact.emails contact)
139
+
~organizations:(Contact.organizations contact)
140
+
~urls:(Contact.urls contact)
141
+
~services
142
+
?icon:(Contact.icon contact)
143
+
?thumbnail:(Contact.thumbnail contact)
144
+
?orcid:(Contact.orcid contact)
145
+
?feeds:(Contact.feeds contact)
146
+
()
147
+
)
148
+
149
+
let add_organization t handle (org : Contact.organization) =
150
+
match lookup t handle with
151
+
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
152
+
| Some contact ->
153
+
let orgs = Contact.organizations contact in
154
+
(* Check for exact duplicate organization (same name, title, and department) *)
155
+
let is_duplicate = List.exists (fun (o : Contact.organization) ->
156
+
o.name = org.name &&
157
+
o.title = org.title &&
158
+
o.department = org.department
159
+
) orgs in
160
+
if is_duplicate then
161
+
Error (Printf.sprintf "Organization %s with the same title/department already exists for contact @%s" org.name handle)
162
+
else
163
+
update_contact t handle (fun contact ->
164
+
let orgs = Contact.organizations contact in
165
+
Contact.make
166
+
~handle:(Contact.handle contact)
167
+
~names:(Contact.names contact)
168
+
~kind:(Contact.kind contact)
169
+
~emails:(Contact.emails contact)
170
+
~organizations:(orgs @ [org])
171
+
~urls:(Contact.urls contact)
172
+
~services:(Contact.services contact)
173
+
?icon:(Contact.icon contact)
174
+
?thumbnail:(Contact.thumbnail contact)
175
+
?orcid:(Contact.orcid contact)
176
+
?feeds:(Contact.feeds contact)
177
+
()
178
+
)
179
+
180
+
let remove_organization t handle name =
181
+
update_contact t handle (fun contact ->
182
+
let orgs = Contact.organizations contact
183
+
|> List.filter (fun (o : Contact.organization) -> o.name <> name) in
184
+
Contact.make
185
+
~handle:(Contact.handle contact)
186
+
~names:(Contact.names contact)
187
+
~kind:(Contact.kind contact)
188
+
~emails:(Contact.emails contact)
189
+
~organizations:orgs
190
+
~urls:(Contact.urls contact)
191
+
~services:(Contact.services contact)
192
+
?icon:(Contact.icon contact)
193
+
?thumbnail:(Contact.thumbnail contact)
194
+
?orcid:(Contact.orcid contact)
195
+
?feeds:(Contact.feeds contact)
196
+
()
197
+
)
198
+
199
+
let add_url t handle (url_entry : Contact.url_entry) =
200
+
match lookup t handle with
201
+
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
202
+
| Some contact ->
203
+
let urls = Contact.urls contact in
204
+
(* Check for duplicate URL *)
205
+
if List.exists (fun (u : Contact.url_entry) -> u.url = url_entry.url) urls then
206
+
Error (Printf.sprintf "URL %s already exists for contact @%s" url_entry.url handle)
207
+
else
208
+
update_contact t handle (fun contact ->
209
+
let urls = Contact.urls contact in
210
+
Contact.make
211
+
~handle:(Contact.handle contact)
212
+
~names:(Contact.names contact)
213
+
~kind:(Contact.kind contact)
214
+
~emails:(Contact.emails contact)
215
+
~organizations:(Contact.organizations contact)
216
+
~urls:(urls @ [url_entry])
217
+
~services:(Contact.services contact)
218
+
?icon:(Contact.icon contact)
219
+
?thumbnail:(Contact.thumbnail contact)
220
+
?orcid:(Contact.orcid contact)
221
+
?feeds:(Contact.feeds contact)
222
+
()
223
+
)
224
+
225
+
let remove_url t handle url =
226
+
update_contact t handle (fun contact ->
227
+
let urls = Contact.urls contact
228
+
|> List.filter (fun (u : Contact.url_entry) -> u.url <> url) in
229
+
Contact.make
230
+
~handle:(Contact.handle contact)
231
+
~names:(Contact.names contact)
232
+
~kind:(Contact.kind contact)
233
+
~emails:(Contact.emails contact)
234
+
~organizations:(Contact.organizations contact)
235
+
~urls
236
+
~services:(Contact.services contact)
237
+
?icon:(Contact.icon contact)
238
+
?thumbnail:(Contact.thumbnail contact)
239
+
?orcid:(Contact.orcid contact)
240
+
?feeds:(Contact.feeds contact)
241
+
()
242
+
)
243
+
244
+
let list t =
245
+
try
246
+
let entries = Eio.Path.read_dir t.data_dir in
247
+
List.filter_map (fun entry ->
248
+
if Filename.check_suffix entry ".yaml" then
249
+
let handle = Filename.chop_suffix entry ".yaml" in
250
+
lookup t handle
251
+
else
252
+
None
253
+
) entries
254
+
with
255
+
| _ -> []
256
+
257
+
let thumbnail_path t contact =
258
+
Contact.thumbnail contact
259
+
|> Option.map (fun relative_path -> Eio.Path.(t.data_dir / relative_path))
260
+
261
+
let png_thumbnail_path t contact =
262
+
match Contact.thumbnail contact with
263
+
| None -> None
264
+
| Some relative_path ->
265
+
let base = Filename.remove_extension relative_path in
266
+
let png_path = base ^ ".png" in
267
+
let full_path = Eio.Path.(t.data_dir / png_path) in
268
+
try
269
+
ignore (Eio.Path.load full_path);
270
+
Some full_path
271
+
with _ -> None
272
+
273
+
let handle_of_name name =
274
+
let name = String.lowercase_ascii name in
275
+
let words = String.split_on_char ' ' name in
276
+
let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in
277
+
initials ^ List.hd (List.rev words)
278
+
279
+
let find_by_name t name =
280
+
let name_lower = String.lowercase_ascii name in
281
+
let all_contacts = list t in
282
+
let matches = List.filter (fun c ->
283
+
List.exists (fun n -> String.lowercase_ascii n = name_lower)
284
+
(Contact.names c)
285
+
) all_contacts in
286
+
match matches with
287
+
| [contact] -> contact
288
+
| [] -> raise Not_found
289
+
| _ -> raise (Invalid_argument ("Multiple contacts match: " ^ name))
290
+
291
+
let find_by_name_opt t name =
292
+
try
293
+
Some (find_by_name t name)
294
+
with
295
+
| Not_found | Invalid_argument _ -> None
296
+
297
+
let contains_substring ~needle haystack =
298
+
let needle_len = String.length needle in
299
+
let haystack_len = String.length haystack in
300
+
if needle_len = 0 then true
301
+
else if needle_len > haystack_len then false
302
+
else
303
+
let rec check i =
304
+
if i > haystack_len - needle_len then false
305
+
else if String.sub haystack i needle_len = needle then true
306
+
else check (i + 1)
307
+
in
308
+
check 0
309
+
310
+
let search_all t query =
311
+
let query_lower = String.lowercase_ascii query in
312
+
let all = list t in
313
+
let matches = List.filter (fun c ->
314
+
List.exists (fun name ->
315
+
let name_lower = String.lowercase_ascii name in
316
+
String.equal name_lower query_lower ||
317
+
String.starts_with ~prefix:query_lower name_lower ||
318
+
contains_substring ~needle:query_lower name_lower ||
319
+
(String.contains name_lower ' ' &&
320
+
String.split_on_char ' ' name_lower |> List.exists (fun word ->
321
+
String.starts_with ~prefix:query_lower word
322
+
))
323
+
) (Contact.names c)
324
+
) all in
325
+
List.sort Contact.compare matches
326
+
327
+
let find_by_email_at t ~email ~date =
328
+
let all = list t in
329
+
List.find_opt (fun c ->
330
+
let emails_at_date = Contact.emails_at c ~date in
331
+
List.exists (fun e -> e.Contact.address = email) emails_at_date
332
+
) all
333
+
334
+
let find_by_org t ~org ?from ?until () =
335
+
let org_lower = String.lowercase_ascii org in
336
+
let all = list t in
337
+
let matches = List.filter (fun c ->
338
+
let orgs : Contact.organization list = Contact.organizations c in
339
+
let filtered_orgs = match from, until with
340
+
| None, None -> orgs
341
+
| _, _ -> Temporal.filter ~get:(fun (o : Contact.organization) -> o.range)
342
+
~from ~until orgs
343
+
in
344
+
List.exists (fun (o : Contact.organization) ->
345
+
contains_substring ~needle:org_lower
346
+
(String.lowercase_ascii o.name)
347
+
) filtered_orgs
348
+
) all in
349
+
List.sort Contact.compare matches
350
+
351
+
let list_at t ~date =
352
+
let all = list t in
353
+
List.filter (fun c ->
354
+
(* Contact is active if it has any email, org, or URL valid at date *)
355
+
let has_email = Contact.emails_at c ~date <> [] in
356
+
let has_org = Contact.organization_at c ~date <> None in
357
+
let has_url = Contact.url_at c ~date <> None in
358
+
has_email || has_org || has_url
359
+
) all
360
+
361
+
let pp ppf t =
362
+
let all = list t in
363
+
Fmt.pf ppf "@[<v>%a: %d contacts stored in XDG data directory@]"
364
+
(Fmt.styled `Bold Fmt.string) "Sortal Store"
365
+
(List.length all)
-4
lib/dune
-4
lib/dune
+4
lib/schema/dune
+4
lib/schema/dune
+9
lib/schema/sortal_schema.ml
+9
lib/schema/sortal_schema.ml
+35
lib/schema/sortal_schema.mli
+35
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
+
(** Temporal validity support for time-bounded fields. *)
18
+
module Temporal = Sortal_schema_temporal
19
+
20
+
(** Feed subscription metadata. *)
21
+
module Feed = Sortal_schema_feed
22
+
23
+
(** Contact metadata with temporal support. *)
24
+
module Contact = Sortal_schema_contact_v1
25
+
end
26
+
27
+
(** {1 Current Version Aliases}
28
+
29
+
These aliases point to the current stable schema version (V1).
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
+3
-3
lib/sortal.ml
lib/core/sortal.ml
+3
-3
lib/sortal.ml
lib/core/sortal.ml
···
1
-
module Temporal = Sortal_temporal
2
-
module Feed = Sortal_feed
3
-
module Contact = Sortal_contact
1
+
module Temporal = Sortal_schema.Temporal
2
+
module Feed = Sortal_schema.Feed
3
+
module Contact = Sortal_schema.Contact
4
4
module Store = Sortal_store
5
5
module Git_store = Sortal_git_store
6
6
module Cmd = Sortal_cmd
+13
-4
lib/sortal.mli
lib/core/sortal.mli
+13
-4
lib/sortal.mli
lib/core/sortal.mli
···
32
32
]}
33
33
*)
34
34
35
-
(** {1 Core Modules} *)
35
+
(** {1 Schema Modules}
36
+
37
+
These modules define the data types and serialization formats.
38
+
They are re-exported from {!Sortal_schema} for convenience.
39
+
For version-specific access, use [Sortal_schema.V1.*]. *)
36
40
37
41
(** Temporal validity support for time-bounded contact fields. *)
38
-
module Temporal = Sortal_temporal
42
+
module Temporal = Sortal_schema.Temporal
39
43
40
44
(** Feed subscription metadata. *)
41
-
module Feed = Sortal_feed
45
+
module Feed = Sortal_schema.Feed
42
46
43
47
(** Contact metadata with temporal support. *)
44
-
module Contact = Sortal_contact
48
+
module Contact = Sortal_schema.Contact
49
+
50
+
(** {1 Core Modules} *)
45
51
46
52
(** Contact store with XDG-compliant storage. *)
47
53
module Store = Sortal_store
54
+
55
+
(** Git-backed contact store with automatic version control. *)
56
+
module Git_store = Sortal_git_store
48
57
49
58
(** Cmdliner integration for CLI applications. *)
50
59
module Cmd = Sortal_cmd
+33
-30
lib/sortal_cmd.ml
lib/core/sortal_cmd.ml
+33
-30
lib/sortal_cmd.ml
lib/core/sortal_cmd.ml
···
1
1
open Cmdliner
2
2
3
+
module Contact = Sortal_schema.Contact
4
+
module Temporal = Sortal_schema.Temporal
5
+
3
6
let is_png path =
4
7
let ext = String.lowercase_ascii (Filename.extension path) in
5
8
ext = ".png"
···
18
21
let list_cmd xdg =
19
22
let store = Sortal_store.create_from_xdg xdg in
20
23
let contacts = Sortal_store.list store in
21
-
let sorted = List.sort Sortal_contact.compare contacts in
24
+
let sorted = List.sort Contact.compare contacts in
22
25
Printf.printf "Total contacts: %d\n" (List.length sorted);
23
26
List.iter (fun c ->
24
-
Printf.printf "@%s: %s\n" (Sortal_contact.handle c) (Sortal_contact.name c)
27
+
Printf.printf "@%s: %s\n" (Contact.handle c) (Contact.name c)
25
28
) sorted;
26
29
0
27
30
···
30
33
match Sortal_store.lookup store handle with
31
34
| Some c ->
32
35
(* Use the pretty printer for rich temporal display *)
33
-
Fmt.pr "%a@." Sortal_contact.pp c;
36
+
Fmt.pr "%a@." Contact.pp c;
34
37
0
35
38
| None -> Logs.err (fun m -> m "Contact not found: %s" handle); 1
36
39
···
45
48
(List.length matches)
46
49
(if List.length matches = 1 then "" else "es"));
47
50
List.iter (fun c ->
48
-
Logs.app (fun m -> m "@%s: %s" (Sortal_contact.handle c) (Sortal_contact.name c));
49
-
Option.iter (fun e -> Logs.app (fun m -> m " Email: %s" e)) (Sortal_contact.current_email c);
50
-
Option.iter (fun u -> Logs.app (fun m -> m " URL: %s" u)) (Sortal_contact.best_url c)
51
+
Logs.app (fun m -> m "@%s: %s" (Contact.handle c) (Contact.name c));
52
+
Option.iter (fun e -> Logs.app (fun m -> m " Email: %s" e)) (Contact.current_email c);
53
+
Option.iter (fun u -> Logs.app (fun m -> m " URL: %s" u)) (Contact.best_url c)
51
54
) matches;
52
55
0
53
56
···
56
59
let contacts = Sortal_store.list store in
57
60
let total = List.length contacts in
58
61
let count pred = List.filter pred contacts |> List.length in
59
-
let with_email = count (fun c -> Sortal_contact.emails c <> []) in
60
-
let with_org = count (fun c -> Sortal_contact.organizations c <> []) in
61
-
let with_url = count (fun c -> Sortal_contact.urls c <> []) in
62
-
let with_service = count (fun c -> Sortal_contact.services c <> []) in
63
-
let with_orcid = count (fun c -> Option.is_some (Sortal_contact.orcid c)) in
64
-
let with_feeds = count (fun c -> Option.is_some (Sortal_contact.feeds c)) in
62
+
let with_email = count (fun c -> Contact.emails c <> []) in
63
+
let with_org = count (fun c -> Contact.organizations c <> []) in
64
+
let with_url = count (fun c -> Contact.urls c <> []) in
65
+
let with_service = count (fun c -> Contact.services c <> []) in
66
+
let with_orcid = count (fun c -> Option.is_some (Contact.orcid c)) in
67
+
let with_feeds = count (fun c -> Option.is_some (Contact.feeds c)) in
65
68
let total_feeds =
66
69
List.fold_left (fun acc c ->
67
-
acc + Option.fold ~none:0 ~some:List.length (Sortal_contact.feeds c)
70
+
acc + Option.fold ~none:0 ~some:List.length (Contact.feeds c)
68
71
) 0 contacts
69
72
in
70
73
let total_services =
71
74
List.fold_left (fun acc c ->
72
-
acc + List.length (Sortal_contact.services c)
75
+
acc + List.length (Contact.services c)
73
76
) 0 contacts
74
77
in
75
78
let pct n = float_of_int n /. float_of_int total *. 100. in
···
92
95
let no_thumbnail = ref 0 in
93
96
let errors = ref 0 in
94
97
List.iter (fun contact ->
95
-
let handle = Sortal_contact.handle contact in
98
+
let handle = Contact.handle contact in
96
99
match Sortal_store.thumbnail_path store contact with
97
100
| None ->
98
101
Logs.info (fun m -> m "@%s: no thumbnail" handle);
···
147
150
1
148
151
| None ->
149
152
let emails = match email with
150
-
| Some e -> [Sortal_contact.make_email e]
153
+
| Some e -> [Contact.make_email e]
151
154
| None -> []
152
155
in
153
156
let services = match github with
154
-
| Some gh -> [Sortal_contact.make_service ~kind:Sortal_contact.Github ~handle:gh (Printf.sprintf "https://github.com/%s" gh)]
157
+
| Some gh -> [Contact.make_service ~kind:Contact.Github ~handle:gh (Printf.sprintf "https://github.com/%s" gh)]
155
158
| None -> []
156
159
in
157
160
let urls = match url with
158
-
| Some u -> [Sortal_contact.make_url u]
161
+
| Some u -> [Contact.make_url u]
159
162
| None -> []
160
163
in
161
-
let contact = Sortal_contact.make
164
+
let contact = Contact.make
162
165
~handle
163
166
~names
164
167
?kind
···
170
173
in
171
174
match Sortal_git_store.save git_store contact with
172
175
| Ok () ->
173
-
Logs.app (fun m -> m "Created contact @%s: %s" handle (Sortal_contact.name contact));
176
+
Logs.app (fun m -> m "Created contact @%s: %s" handle (Contact.name contact));
174
177
0
175
178
| Error msg ->
176
179
Logs.err (fun m -> m "Failed to save contact: %s" msg);
···
192
195
let add_email_cmd handle address type_ from until note xdg env =
193
196
let store = Sortal_store.create_from_xdg xdg in
194
197
let git_store = Sortal_git_store.create store env in
195
-
let email = Sortal_contact.make_email ?type_ ?from ?until ?note address in
198
+
let email = Contact.make_email ?type_ ?from ?until ?note address in
196
199
match Sortal_git_store.add_email git_store handle email with
197
200
| Ok () ->
198
201
Logs.app (fun m -> m "Added email %s to @%s" address handle);
···
217
220
let add_service_cmd handle url kind service_handle label xdg env =
218
221
let store = Sortal_store.create_from_xdg xdg in
219
222
let git_store = Sortal_git_store.create store env in
220
-
let service = Sortal_contact.make_service ?kind ?handle:service_handle ?label url in
223
+
let service = Contact.make_service ?kind ?handle:service_handle ?label url in
221
224
match Sortal_git_store.add_service git_store handle service with
222
225
| Ok () ->
223
226
Logs.app (fun m -> m "Added service %s to @%s" url handle);
···
242
245
let add_org_cmd handle org_name title department from until org_email org_url xdg env =
243
246
let store = Sortal_store.create_from_xdg xdg in
244
247
let git_store = Sortal_git_store.create store env in
245
-
let org = Sortal_contact.make_org ?title ?department ?from ?until ?email:org_email ?url:org_url org_name in
248
+
let org = Contact.make_org ?title ?department ?from ?until ?email:org_email ?url:org_url org_name in
246
249
match Sortal_git_store.add_organization git_store handle org with
247
250
| Ok () ->
248
251
Logs.app (fun m -> m "Added organization %s to @%s" org_name handle);
···
267
270
let add_url_cmd handle url label xdg env =
268
271
let store = Sortal_store.create_from_xdg xdg in
269
272
let git_store = Sortal_git_store.create store env in
270
-
let url_entry = Sortal_contact.make_url ?label url in
273
+
let url_entry = Contact.make_url ?label url in
271
274
match Sortal_git_store.add_url git_store handle url_entry with
272
275
| Ok () ->
273
276
Logs.app (fun m -> m "Added URL %s to @%s" url handle);
···
338
341
339
342
let add_kind_arg =
340
343
let kind_conv =
341
-
let parse s = match Sortal_contact.contact_kind_of_string s with
344
+
let parse s = match Contact.contact_kind_of_string s with
342
345
| Some k -> Ok k
343
346
| None -> Error (`Msg (Printf.sprintf "Invalid kind: %s" s))
344
347
in
345
-
let print ppf k = Format.pp_print_string ppf (Sortal_contact.contact_kind_to_string k) in
348
+
let print ppf k = Format.pp_print_string ppf (Contact.contact_kind_to_string k) in
346
349
Arg.conv (parse, print)
347
350
in
348
351
Arg.(value & opt (some kind_conv) None & info ["k"; "kind"] ~docv:"KIND"
···
371
374
372
375
let email_type_arg =
373
376
let type_conv =
374
-
let parse s = match Sortal_contact.email_type_of_string s with
377
+
let parse s = match Contact.email_type_of_string s with
375
378
| Some t -> Ok t
376
379
| None -> Error (`Msg (Printf.sprintf "Invalid email type: %s" s))
377
380
in
378
-
let print ppf t = Format.pp_print_string ppf (Sortal_contact.email_type_to_string t) in
381
+
let print ppf t = Format.pp_print_string ppf (Contact.email_type_to_string t) in
379
382
Arg.conv (parse, print)
380
383
in
381
384
Arg.(value & opt (some type_conv) None & info ["t"; "type"] ~docv:"TYPE"
···
396
399
397
400
let service_kind_arg =
398
401
let kind_conv =
399
-
let parse s = match Sortal_contact.service_kind_of_string s with
402
+
let parse s = match Contact.service_kind_of_string s with
400
403
| Some k -> Ok k
401
404
| None -> Error (`Msg (Printf.sprintf "Invalid service kind: %s" s))
402
405
in
403
-
let print ppf k = Format.pp_print_string ppf (Sortal_contact.service_kind_to_string k) in
406
+
let print ppf k = Format.pp_print_string ppf (Contact.service_kind_to_string k) in
404
407
Arg.conv (parse, print)
405
408
in
406
409
Arg.(value & opt (some kind_conv) None & info ["k"; "kind"] ~docv:"KIND"
+9
-6
lib/sortal_cmd.mli
lib/core/sortal_cmd.mli
+9
-6
lib/sortal_cmd.mli
lib/core/sortal_cmd.mli
···
3
3
This module provides ready-to-use Cmdliner terms for building
4
4
CLI applications that work with contact metadata. *)
5
5
6
+
module Contact = Sortal_schema.Contact
7
+
module Temporal = Sortal_schema.Temporal
8
+
6
9
(** {1 Command Implementations} *)
7
10
8
11
(** [list_cmd] is a Cmdliner command that lists all contacts.
···
47
50
@param orcid Optional ORCID identifier
48
51
@param xdg XDG context
49
52
@param env Eio environment for git operations *)
50
-
val add_cmd : string -> string list -> Sortal_contact.contact_kind option ->
53
+
val add_cmd : string -> string list -> Contact.contact_kind option ->
51
54
string option -> string option -> string option -> string option ->
52
55
Xdge.t -> Eio_unix.Stdenv.base -> int
53
56
···
68
71
@param note Contextual note
69
72
@param xdg XDG context
70
73
@param env Eio environment for git operations *)
71
-
val add_email_cmd : string -> string -> Sortal_contact.email_type option ->
74
+
val add_email_cmd : string -> string -> Contact.email_type option ->
72
75
string option -> string option -> string option ->
73
76
Xdge.t -> Eio_unix.Stdenv.base -> int
74
77
···
84
87
@param label Human-readable label
85
88
@param xdg XDG context
86
89
@param env Eio environment for git operations *)
87
-
val add_service_cmd : string -> string -> Sortal_contact.service_kind option ->
90
+
val add_service_cmd : string -> string -> Contact.service_kind option ->
88
91
string option -> string option -> Xdge.t -> Eio_unix.Stdenv.base -> int
89
92
90
93
(** [remove_service_cmd handle url xdg env] removes a service from a contact. *)
···
170
173
val add_names_arg : string list Cmdliner.Term.t
171
174
172
175
(** [add_kind_arg] is the optional argument for contact kind. *)
173
-
val add_kind_arg : Sortal_contact.contact_kind option Cmdliner.Term.t
176
+
val add_kind_arg : Contact.contact_kind option Cmdliner.Term.t
174
177
175
178
(** [add_email_arg] is the optional argument for email. *)
176
179
val add_email_arg : string option Cmdliner.Term.t
···
188
191
val email_address_arg : string Cmdliner.Term.t
189
192
190
193
(** [email_type_arg] is the optional argument for email type. *)
191
-
val email_type_arg : Sortal_contact.email_type option Cmdliner.Term.t
194
+
val email_type_arg : Contact.email_type option Cmdliner.Term.t
192
195
193
196
(** [date_arg name] creates a date argument with the given option name. *)
194
197
val date_arg : string -> string option Cmdliner.Term.t
···
200
203
val service_url_arg : string Cmdliner.Term.t
201
204
202
205
(** [service_kind_arg] is the optional argument for service kind. *)
203
-
val service_kind_arg : Sortal_contact.service_kind option Cmdliner.Term.t
206
+
val service_kind_arg : Contact.service_kind option Cmdliner.Term.t
204
207
205
208
(** [service_handle_arg] is the optional argument for service handle. *)
206
209
val service_handle_arg : string option Cmdliner.Term.t
-12
lib/sortal_contact.mli
-12
lib/sortal_contact.mli
···
1
-
(** Individual contact metadata.
2
-
3
-
This module re-exports the current contact schema version (V1).
4
-
See {!Sortal_contact_v1} for the full API documentation. *)
5
-
6
-
(** {1 Current Schema Version} *)
7
-
8
-
module V1 = Sortal_contact_v1
9
-
(** Current schema version. All functions below are aliases to V1. *)
10
-
11
-
include module type of Sortal_contact_v1
12
-
(** @inline *)
+29
-29
lib/sortal_contact_v1.ml
lib/schema/sortal_schema_contact_v1.ml
+29
-29
lib/sortal_contact_v1.ml
lib/schema/sortal_schema_contact_v1.ml
···
15
15
kind: service_kind option;
16
16
handle: string option;
17
17
label: string option;
18
-
range: Sortal_temporal.range option;
18
+
range: Sortal_schema_temporal.range option;
19
19
primary: bool;
20
20
}
21
21
···
24
24
type email = {
25
25
address: string;
26
26
type_: email_type option;
27
-
range: Sortal_temporal.range option;
27
+
range: Sortal_schema_temporal.range option;
28
28
note: string option;
29
29
}
30
30
···
32
32
name: string;
33
33
title: string option;
34
34
department: string option;
35
-
range: Sortal_temporal.range option;
35
+
range: Sortal_schema_temporal.range option;
36
36
email: string option;
37
37
url: string option;
38
38
}
···
40
40
type url_entry = {
41
41
url: string;
42
42
label: string option;
43
-
range: Sortal_temporal.range option;
43
+
range: Sortal_schema_temporal.range option;
44
44
}
45
45
46
46
type t = {
···
55
55
icon: string option;
56
56
thumbnail: string option;
57
57
orcid: string option;
58
-
feeds: Sortal_feed.t list option;
58
+
feeds: Sortal_schema_feed.t list option;
59
59
}
60
60
61
61
(* Helpers *)
62
62
let make_email ?type_ ?from ?until ?note address =
63
63
let range = match from, until with
64
64
| None, None -> None
65
-
| _, _ -> Some (Sortal_temporal.make ?from ?until ())
65
+
| _, _ -> Some (Sortal_schema_temporal.make ?from ?until ())
66
66
in
67
67
{ address; type_; range; note }
68
68
···
72
72
let make_org ?title ?department ?from ?until ?email ?url name =
73
73
let range = match from, until with
74
74
| None, None -> None
75
-
| _, _ -> Some (Sortal_temporal.make ?from ?until ())
75
+
| _, _ -> Some (Sortal_schema_temporal.make ?from ?until ())
76
76
in
77
77
{ name; title; department; range; email; url }
78
78
79
79
let make_url ?label ?from ?until url =
80
80
let range = match from, until with
81
81
| None, None -> None
82
-
| _, _ -> Some (Sortal_temporal.make ?from ?until ())
82
+
| _, _ -> Some (Sortal_schema_temporal.make ?from ?until ())
83
83
in
84
84
{ url; label; range }
85
85
···
89
89
let make_service ?kind ?handle ?label ?from ?until ?(primary = false) url =
90
90
let range = match from, until with
91
91
| None, None -> None
92
-
| _, _ -> Some (Sortal_temporal.make ?from ?until ())
92
+
| _, _ -> Some (Sortal_schema_temporal.make ?from ?until ())
93
93
in
94
94
{ url; kind; handle; label; range; primary }
95
95
···
119
119
120
120
(* Temporal queries *)
121
121
let emails_at t ~date =
122
-
Sortal_temporal.at_date ~get:(fun (e : email) -> e.range) ~date t.emails
122
+
Sortal_schema_temporal.at_date ~get:(fun (e : email) -> e.range) ~date t.emails
123
123
124
124
let email_at t ~date =
125
125
match emails_at t ~date with
···
127
127
| [] -> None
128
128
129
129
let current_email t =
130
-
match Sortal_temporal.current ~get:(fun (e : email) -> e.range) t.emails with
130
+
match Sortal_schema_temporal.current ~get:(fun (e : email) -> e.range) t.emails with
131
131
| Some e -> Some e.address
132
132
| None -> None
133
133
134
134
let organization_at t ~date =
135
-
match Sortal_temporal.at_date ~get:(fun (o : organization) -> o.range) ~date t.organizations with
135
+
match Sortal_schema_temporal.at_date ~get:(fun (o : organization) -> o.range) ~date t.organizations with
136
136
| o :: _ -> Some o
137
137
| [] -> None
138
138
139
139
let current_organization t =
140
-
Sortal_temporal.current ~get:(fun (o : organization) -> o.range) t.organizations
140
+
Sortal_schema_temporal.current ~get:(fun (o : organization) -> o.range) t.organizations
141
141
142
142
let url_at t ~date =
143
-
match Sortal_temporal.at_date ~get:(fun (u : url_entry) -> u.range) ~date t.urls with
143
+
match Sortal_schema_temporal.at_date ~get:(fun (u : url_entry) -> u.range) ~date t.urls with
144
144
| u :: _ -> Some u.url
145
145
| [] -> None
146
146
147
147
let current_url t =
148
-
match Sortal_temporal.current ~get:(fun (u : url_entry) -> u.range) t.urls with
148
+
match Sortal_schema_temporal.current ~get:(fun (u : url_entry) -> u.range) t.urls with
149
149
| Some u -> Some u.url
150
150
| None -> None
151
151
···
161
161
) t.services
162
162
163
163
let services_at t ~date =
164
-
Sortal_temporal.at_date ~get:(fun (s : service) -> s.range) ~date t.services
164
+
Sortal_schema_temporal.at_date ~get:(fun (s : service) -> s.range) ~date t.services
165
165
166
166
let current_services t =
167
-
List.filter (fun (s : service) -> Sortal_temporal.is_current s.range) t.services
167
+
List.filter (fun (s : service) -> Sortal_schema_temporal.is_current s.range) t.services
168
168
169
169
let primary_service t (kind : service_kind) =
170
170
List.find_opt (fun (s : service) ->
···
186
186
{ t with feeds = Some (feed :: Option.value t.feeds ~default:[]) }
187
187
188
188
let remove_feed t url =
189
-
{ t with feeds = Option.map (List.filter (fun f -> Sortal_feed.url f <> url)) t.feeds }
189
+
{ t with feeds = Option.map (List.filter (fun f -> Sortal_schema_feed.url f <> url)) t.feeds }
190
190
191
191
(* Comparison *)
192
192
let compare a b = String.compare a.handle b.handle
···
281
281
|> mem_opt "kind" (some string) ~enc:(fun (s : service) -> enc_kind_opt s.kind)
282
282
|> mem_opt "handle" (some string) ~enc:(fun (s : service) -> s.handle)
283
283
|> mem_opt "label" (some string) ~enc:(fun (s : service) -> s.label)
284
-
|> mem_opt "range" (some Sortal_temporal.json_t) ~enc:(fun (s : service) -> s.range)
284
+
|> mem_opt "range" (some Sortal_schema_temporal.json_t) ~enc:(fun (s : service) -> s.range)
285
285
|> mem "primary" bool ~dec_absent:false ~enc:(fun (s : service) -> s.primary)
286
286
|> finish
287
287
···
300
300
map ~kind:"Email" make
301
301
|> mem "address" string ~enc:(fun (e : email) -> e.address)
302
302
|> mem_opt "type" (some email_type_json) ~enc:(fun (e : email) -> e.type_)
303
-
|> mem_opt "range" (some Sortal_temporal.json_t) ~enc:(fun (e : email) -> e.range)
303
+
|> mem_opt "range" (some Sortal_schema_temporal.json_t) ~enc:(fun (e : email) -> e.range)
304
304
|> mem_opt "note" (some string) ~enc:(fun (e : email) -> e.note)
305
305
|> finish
306
306
···
315
315
|> mem "name" string ~enc:(fun (o : organization) -> o.name)
316
316
|> mem_opt "title" (some string) ~enc:(fun (o : organization) -> o.title)
317
317
|> mem_opt "department" (some string) ~enc:(fun (o : organization) -> o.department)
318
-
|> mem_opt "range" (some Sortal_temporal.json_t) ~enc:(fun (o : organization) -> o.range)
318
+
|> mem_opt "range" (some Sortal_schema_temporal.json_t) ~enc:(fun (o : organization) -> o.range)
319
319
|> mem_opt "email" (some string) ~enc:(fun (o : organization) -> o.email)
320
320
|> mem_opt "url" (some string) ~enc:(fun (o : organization) -> o.url)
321
321
|> finish
···
328
328
map ~kind:"URL" make
329
329
|> mem "url" string ~enc:(fun (u : url_entry) -> u.url)
330
330
|> mem_opt "label" (some string) ~enc:(fun (u : url_entry) -> u.label)
331
-
|> mem_opt "range" (some Sortal_temporal.json_t) ~enc:(fun (u : url_entry) -> u.range)
331
+
|> mem_opt "range" (some Sortal_schema_temporal.json_t) ~enc:(fun (u : url_entry) -> u.range)
332
332
|> finish
333
333
334
334
let json_t =
···
354
354
|> mem_opt "icon" (some string) ~enc:(fun c -> c.icon)
355
355
|> mem_opt "thumbnail" (some string) ~enc:(fun c -> c.thumbnail)
356
356
|> mem_opt "orcid" (some string) ~enc:(fun c -> c.orcid)
357
-
|> mem_opt "feeds" (some (list Sortal_feed.json_t)) ~enc:(fun c -> c.feeds)
357
+
|> mem_opt "feeds" (some (list Sortal_schema_feed.json_t)) ~enc:(fun c -> c.feeds)
358
358
|> finish
359
359
360
360
(* Pretty printing *)
···
367
367
368
368
let pp_range ppf = function
369
369
| None -> ()
370
-
| Some { Sortal_temporal.from; until } ->
370
+
| Some { Sortal_schema_temporal.from; until } ->
371
371
match from, until with
372
372
| Some f, Some u -> pf ppf " %a" (date_style string) (Printf.sprintf "[%s to %s]" f u)
373
373
| Some f, None -> pf ppf " %a" (date_style string) (Printf.sprintf "[from %s]" f)
···
399
399
(match e.note with Some n -> " - " ^ n | None -> "")
400
400
pp_range e.range
401
401
(fun ppf current -> if current then pf ppf " %a" (styled (`Fg `Magenta) string) "[current]" else ())
402
-
(Sortal_temporal.is_current e.range)
402
+
(Sortal_schema_temporal.is_current e.range)
403
403
) (emails t)
404
404
end;
405
405
···
411
411
Option.iter (fun title -> pf ppf " - %s" title) o.title;
412
412
Option.iter (fun dept -> pf ppf " (%s)" dept) o.department;
413
413
pf ppf "%a" pp_range o.range;
414
-
if Sortal_temporal.is_current o.range then
414
+
if Sortal_schema_temporal.is_current o.range then
415
415
pf ppf " %a" (styled (`Fg `Magenta) string) "[current]";
416
416
pf ppf "@,";
417
417
Option.iter (fun email -> pf ppf " Email: %a@," (styled (`Fg `Yellow) string) email) o.email;
···
426
426
pf ppf " %a" (url_style string) u.url;
427
427
Option.iter (fun lbl -> pf ppf " (%s)" lbl) u.label;
428
428
pf ppf "%a" pp_range u.range;
429
-
if Sortal_temporal.is_current u.range then
429
+
if Sortal_schema_temporal.is_current u.range then
430
430
pf ppf " %a" (styled (`Fg `Magenta) string) "[current]";
431
431
pf ppf "@,"
432
432
) (urls t)
···
442
442
Option.iter (fun lbl -> pf ppf " - %s" lbl) s.label;
443
443
pf ppf "%a" pp_range s.range;
444
444
if s.primary then pf ppf " %a" (styled (`Fg `Yellow) string) "[primary]";
445
-
if Sortal_temporal.is_current s.range then
445
+
if Sortal_schema_temporal.is_current s.range then
446
446
pf ppf " %a" (styled (`Fg `Magenta) string) "[current]";
447
447
pf ppf "@,"
448
448
) (services t)
···
457
457
| [] -> ()
458
458
| feeds ->
459
459
pf ppf "%a:@," label "Feeds";
460
-
List.iter (fun feed -> pf ppf " - %a@," Sortal_feed.pp feed) feeds
460
+
List.iter (fun feed -> pf ppf " - %a@," Sortal_schema_feed.pp feed) feeds
461
461
) t.feeds;
462
462
463
463
pf ppf "@]"
+21
-21
lib/sortal_contact_v1.mli
lib/schema/sortal_schema_contact_v1.mli
+21
-21
lib/sortal_contact_v1.mli
lib/schema/sortal_schema_contact_v1.mli
···
39
39
kind: service_kind option; (** Optional service categorization *)
40
40
handle: string option; (** Optional short handle/username *)
41
41
label: string option; (** Human description: "Cambridge GitLab", "Work account" *)
42
-
range: Sortal_temporal.range option; (** Temporal validity *)
42
+
range: Sortal_schema_temporal.range option; (** Temporal validity *)
43
43
primary: bool; (** Is this the primary/preferred service of its kind? *)
44
44
}
45
45
···
48
48
type email = {
49
49
address: string;
50
50
type_: email_type option;
51
-
range: Sortal_temporal.range option; (** Validity period *)
51
+
range: Sortal_schema_temporal.range option; (** Validity period *)
52
52
note: string option; (** Context note, e.g., "NetApp position" *)
53
53
}
54
54
···
56
56
name: string;
57
57
title: string option;
58
58
department: string option;
59
-
range: Sortal_temporal.range option; (** Employment period *)
59
+
range: Sortal_schema_temporal.range option; (** Employment period *)
60
60
email: string option; (** Work email during this period *)
61
61
url: string option; (** Work homepage during this period *)
62
62
}
···
64
64
type url_entry = {
65
65
url: string;
66
66
label: string option; (** Human-readable label *)
67
-
range: Sortal_temporal.range option; (** Validity period *)
67
+
range: Sortal_schema_temporal.range option; (** Validity period *)
68
68
}
69
69
70
70
type t = {
···
85
85
orcid: string option; (** ORCID identifier *)
86
86
87
87
(* Other *)
88
-
feeds: Sortal_feed.t list option; (** Feed subscriptions *)
88
+
feeds: Sortal_schema_feed.t list option; (** Feed subscriptions *)
89
89
}
90
90
91
91
(** {1 Construction} *)
···
107
107
?icon:string ->
108
108
?thumbnail:string ->
109
109
?orcid:string ->
110
-
?feeds:Sortal_feed.t list ->
110
+
?feeds:Sortal_schema_feed.t list ->
111
111
unit ->
112
112
t
113
113
···
121
121
@param note Contextual note *)
122
122
val make_email :
123
123
?type_:email_type ->
124
-
?from:Sortal_temporal.date ->
125
-
?until:Sortal_temporal.date ->
124
+
?from:Sortal_schema_temporal.date ->
125
+
?until:Sortal_schema_temporal.date ->
126
126
?note:string ->
127
127
string ->
128
128
email
···
137
137
val make_org :
138
138
?title:string ->
139
139
?department:string ->
140
-
?from:Sortal_temporal.date ->
141
-
?until:Sortal_temporal.date ->
140
+
?from:Sortal_schema_temporal.date ->
141
+
?until:Sortal_schema_temporal.date ->
142
142
?email:string ->
143
143
?url:string ->
144
144
string ->
···
149
149
(** [make_url ?label ?from ?until url] creates a URL entry. *)
150
150
val make_url :
151
151
?label:string ->
152
-
?from:Sortal_temporal.date ->
153
-
?until:Sortal_temporal.date ->
152
+
?from:Sortal_schema_temporal.date ->
153
+
?until:Sortal_schema_temporal.date ->
154
154
string ->
155
155
url_entry
156
156
···
173
173
?kind:service_kind ->
174
174
?handle:string ->
175
175
?label:string ->
176
-
?from:Sortal_temporal.date ->
177
-
?until:Sortal_temporal.date ->
176
+
?from:Sortal_schema_temporal.date ->
177
+
?until:Sortal_schema_temporal.date ->
178
178
?primary:bool ->
179
179
string ->
180
180
service
···
197
197
val icon : t -> string option
198
198
val thumbnail : t -> string option
199
199
val orcid : t -> string option
200
-
val feeds : t -> Sortal_feed.t list option
200
+
val feeds : t -> Sortal_schema_feed.t list option
201
201
202
202
(** {1 Temporal Queries} *)
203
203
204
204
(** [email_at t ~date] returns the primary email valid at [date]. *)
205
-
val email_at : t -> date:Sortal_temporal.date -> string option
205
+
val email_at : t -> date:Sortal_schema_temporal.date -> string option
206
206
207
207
(** [emails_at t ~date] returns all emails valid at [date]. *)
208
-
val emails_at : t -> date:Sortal_temporal.date -> email list
208
+
val emails_at : t -> date:Sortal_schema_temporal.date -> email list
209
209
210
210
(** [current_email t] returns the current primary email. *)
211
211
val current_email : t -> string option
212
212
213
213
(** [organization_at t ~date] returns the organization at [date]. *)
214
-
val organization_at : t -> date:Sortal_temporal.date -> organization option
214
+
val organization_at : t -> date:Sortal_schema_temporal.date -> organization option
215
215
216
216
(** [current_organization t] returns the current organization. *)
217
217
val current_organization : t -> organization option
218
218
219
219
(** [url_at t ~date] returns the primary URL valid at [date]. *)
220
-
val url_at : t -> date:Sortal_temporal.date -> string option
220
+
val url_at : t -> date:Sortal_schema_temporal.date -> string option
221
221
222
222
(** [current_url t] returns the current primary URL. *)
223
223
val current_url : t -> string option
···
234
234
val services_of_kind : t -> service_kind -> service list
235
235
236
236
(** [services_at t ~date] returns all services valid at [date]. *)
237
-
val services_at : t -> date:Sortal_temporal.date -> service list
237
+
val services_at : t -> date:Sortal_schema_temporal.date -> service list
238
238
239
239
(** [current_services t] returns all currently valid services. *)
240
240
val current_services : t -> service list
···
244
244
245
245
(** {1 Modification} *)
246
246
247
-
val add_feed : t -> Sortal_feed.t -> t
247
+
val add_feed : t -> Sortal_schema_feed.t -> t
248
248
val remove_feed : t -> string -> t
249
249
250
250
(** {1 Comparison and Display} *)
lib/sortal_feed.ml
lib/schema/sortal_schema_feed.ml
lib/sortal_feed.ml
lib/schema/sortal_schema_feed.ml
lib/sortal_feed.mli
lib/schema/sortal_schema_feed.mli
lib/sortal_feed.mli
lib/schema/sortal_schema_feed.mli
+10
-8
lib/sortal_git_store.ml
lib/core/sortal_git_store.ml
+10
-8
lib/sortal_git_store.ml
lib/core/sortal_git_store.ml
···
1
+
module Contact = Sortal_schema.Contact
2
+
1
3
type t = {
2
4
store : Sortal_store.t;
3
5
env : Eio_unix.Stdenv.base;
···
78
80
run_git t ["commit"; "-m"; msg]
79
81
80
82
let save t contact =
81
-
let handle = Sortal_contact.handle contact in
82
-
let name = Sortal_contact.name contact in
83
+
let handle = Contact.handle contact in
84
+
let name = Contact.name contact in
83
85
let filename = handle ^ ".yaml" in
84
86
85
87
(* Check if contact already exists *)
···
106
108
match Sortal_store.lookup t.store handle with
107
109
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
108
110
| Some contact ->
109
-
let name = Sortal_contact.name contact in
111
+
let name = Contact.name contact in
110
112
let filename = handle ^ ".yaml" in
111
113
112
114
(* Delete from store *)
···
129
131
let filename = handle ^ ".yaml" in
130
132
commit_file t filename msg
131
133
132
-
let add_email t handle (email : Sortal_contact_v1.email) =
134
+
let add_email t handle (email : Contact.email) =
133
135
let msg = Printf.sprintf "Update @%s: add email %s"
134
136
handle email.address in
135
137
match Sortal_store.add_email t.store handle email with
···
152
154
let filename = handle ^ ".yaml" in
153
155
commit_file t filename msg
154
156
155
-
let add_service t handle (service : Sortal_contact_v1.service) =
157
+
let add_service t handle (service : Contact.service) =
156
158
let kind_str = match service.kind with
157
-
| Some k -> Sortal_contact.service_kind_to_string k
159
+
| Some k -> Contact.service_kind_to_string k
158
160
| None -> "unknown"
159
161
in
160
162
let msg = Printf.sprintf "Update @%s: add service %s (%s)"
···
179
181
let filename = handle ^ ".yaml" in
180
182
commit_file t filename msg
181
183
182
-
let add_organization t handle (org : Sortal_contact_v1.organization) =
184
+
let add_organization t handle (org : Contact.organization) =
183
185
let msg = Printf.sprintf "Update @%s: add organization %s"
184
186
handle org.name in
185
187
match Sortal_store.add_organization t.store handle org with
···
202
204
let filename = handle ^ ".yaml" in
203
205
commit_file t filename msg
204
206
205
-
let add_url t handle (url_entry : Sortal_contact_v1.url_entry) =
207
+
let add_url t handle (url_entry : Contact.url_entry) =
206
208
let msg = Printf.sprintf "Update @%s: add URL %s"
207
209
handle url_entry.url in
208
210
match Sortal_store.add_url t.store handle url_entry with
+8
-6
lib/sortal_git_store.mli
lib/core/sortal_git_store.mli
+8
-6
lib/sortal_git_store.mli
lib/core/sortal_git_store.mli
···
5
5
automatically committed to a git repository with descriptive commit
6
6
messages. *)
7
7
8
+
module Contact = Sortal_schema.Contact
9
+
8
10
type t
9
11
(** A git-backed contact store. *)
10
12
···
32
34
33
35
(** {1 Contact Operations} *)
34
36
35
-
val save : t -> Sortal_contact.t -> (unit, string) result
37
+
val save : t -> Contact.t -> (unit, string) result
36
38
(** [save t contact] saves a contact and commits the change to git.
37
39
38
40
If the contact is new, commits with message "Add contact @handle (Name)".
···
50
52
51
53
(** {1 Contact Modification} *)
52
54
53
-
val add_email : t -> string -> Sortal_contact.email -> (unit, string) result
55
+
val add_email : t -> string -> Contact.email -> (unit, string) result
54
56
(** [add_email t handle email] adds an email to a contact and commits.
55
57
56
58
Commits with message "Update @handle: add email address@example.com". *)
···
60
62
61
63
Commits with message "Update @handle: remove email address@example.com". *)
62
64
63
-
val add_service : t -> string -> Sortal_contact.service -> (unit, string) result
65
+
val add_service : t -> string -> Contact.service -> (unit, string) result
64
66
(** [add_service t handle service] adds a service to a contact and commits.
65
67
66
68
Commits with message "Update @handle: add service Kind (url)". *)
···
70
72
71
73
Commits with message "Update @handle: remove service url". *)
72
74
73
-
val add_organization : t -> string -> Sortal_contact.organization -> (unit, string) result
75
+
val add_organization : t -> string -> Contact.organization -> (unit, string) result
74
76
(** [add_organization t handle org] adds an organization and commits.
75
77
76
78
Commits with message "Update @handle: add organization Org Name". *)
···
80
82
81
83
Commits with message "Update @handle: remove organization Org Name". *)
82
84
83
-
val add_url : t -> string -> Sortal_contact.url_entry -> (unit, string) result
85
+
val add_url : t -> string -> Contact.url_entry -> (unit, string) result
84
86
(** [add_url t handle url_entry] adds a URL and commits.
85
87
86
88
Commits with message "Update @handle: add URL url". *)
···
92
94
93
95
(** {1 Low-level Operations} *)
94
96
95
-
val update_contact : t -> string -> (Sortal_contact.t -> Sortal_contact.t) ->
97
+
val update_contact : t -> string -> (Contact.t -> Contact.t) ->
96
98
msg:string -> (unit, string) result
97
99
(** [update_contact t handle f ~msg] updates a contact and commits with custom message.
98
100
-362
lib/sortal_store.ml
-362
lib/sortal_store.ml
···
1
-
type t = {
2
-
xdg : Xdge.t; [@warning "-69"]
3
-
data_dir : Eio.Fs.dir_ty Eio.Path.t;
4
-
}
5
-
6
-
let create fs app_name =
7
-
let xdg = Xdge.create fs app_name in
8
-
let data_dir = Xdge.data_dir xdg in
9
-
{ xdg; data_dir }
10
-
11
-
let create_from_xdg xdg =
12
-
let data_dir = Xdge.data_dir xdg in
13
-
{ xdg; data_dir }
14
-
15
-
let contact_file t handle =
16
-
Eio.Path.(t.data_dir / (handle ^ ".yaml"))
17
-
18
-
let save t contact =
19
-
let path = contact_file t (Sortal_contact.handle contact) in
20
-
let buf = Buffer.create 4096 in
21
-
let writer = Bytesrw.Bytes.Writer.of_buffer buf in
22
-
match Yamlt.encode Sortal_contact.json_t contact ~eod:true writer with
23
-
| Ok () -> Eio.Path.save ~create:(`Or_truncate 0o644) path (Buffer.contents buf)
24
-
| Error err -> failwith ("Failed to encode contact: " ^ err)
25
-
26
-
let lookup t handle =
27
-
let path = contact_file t handle in
28
-
try
29
-
let yaml_str = Eio.Path.load path in
30
-
let reader = Bytesrw.Bytes.Reader.of_string yaml_str in
31
-
match Yamlt.decode Sortal_contact.json_t reader with
32
-
| Ok contact -> Some contact
33
-
| Error msg ->
34
-
Logs.warn (fun m -> m "Failed to decode contact %s: %s" handle msg);
35
-
None
36
-
with exn ->
37
-
Logs.warn (fun m -> m "Failed to load contact %s: %s" handle (Printexc.to_string exn));
38
-
None
39
-
40
-
let delete t handle =
41
-
let path = contact_file t handle in
42
-
try
43
-
Eio.Path.unlink path
44
-
with
45
-
| _ -> ()
46
-
47
-
(* Contact modification helpers *)
48
-
let update_contact t handle f =
49
-
match lookup t handle with
50
-
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
51
-
| Some contact ->
52
-
let updated = f contact in
53
-
save t updated;
54
-
Ok ()
55
-
56
-
let add_email t handle (email : Sortal_contact_v1.email) =
57
-
match lookup t handle with
58
-
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
59
-
| Some contact ->
60
-
let emails = Sortal_contact.emails contact in
61
-
(* Check for duplicate email address *)
62
-
if List.exists (fun (e : Sortal_contact_v1.email) -> e.address = email.address) emails then
63
-
Error (Printf.sprintf "Email %s already exists for contact @%s" email.address handle)
64
-
else
65
-
update_contact t handle (fun contact ->
66
-
let emails = Sortal_contact.emails contact in
67
-
Sortal_contact.make
68
-
~handle:(Sortal_contact.handle contact)
69
-
~names:(Sortal_contact.names contact)
70
-
~kind:(Sortal_contact.kind contact)
71
-
~emails:(emails @ [email])
72
-
~organizations:(Sortal_contact.organizations contact)
73
-
~urls:(Sortal_contact.urls contact)
74
-
~services:(Sortal_contact.services contact)
75
-
?icon:(Sortal_contact.icon contact)
76
-
?thumbnail:(Sortal_contact.thumbnail contact)
77
-
?orcid:(Sortal_contact.orcid contact)
78
-
?feeds:(Sortal_contact.feeds contact)
79
-
()
80
-
)
81
-
82
-
let remove_email t handle address =
83
-
update_contact t handle (fun contact ->
84
-
let emails = Sortal_contact.emails contact
85
-
|> List.filter (fun (e : Sortal_contact.email) -> e.address <> address) in
86
-
Sortal_contact.make
87
-
~handle:(Sortal_contact.handle contact)
88
-
~names:(Sortal_contact.names contact)
89
-
~kind:(Sortal_contact.kind contact)
90
-
~emails
91
-
~organizations:(Sortal_contact.organizations contact)
92
-
~urls:(Sortal_contact.urls contact)
93
-
~services:(Sortal_contact.services contact)
94
-
?icon:(Sortal_contact.icon contact)
95
-
?thumbnail:(Sortal_contact.thumbnail contact)
96
-
?orcid:(Sortal_contact.orcid contact)
97
-
?feeds:(Sortal_contact.feeds contact)
98
-
()
99
-
)
100
-
101
-
let add_service t handle (service : Sortal_contact_v1.service) =
102
-
match lookup t handle with
103
-
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
104
-
| Some contact ->
105
-
let services = Sortal_contact.services contact in
106
-
(* Check for duplicate service URL *)
107
-
if List.exists (fun (s : Sortal_contact_v1.service) -> s.url = service.url) services then
108
-
Error (Printf.sprintf "Service URL %s already exists for contact @%s" service.url handle)
109
-
else
110
-
update_contact t handle (fun contact ->
111
-
let services = Sortal_contact.services contact in
112
-
Sortal_contact.make
113
-
~handle:(Sortal_contact.handle contact)
114
-
~names:(Sortal_contact.names contact)
115
-
~kind:(Sortal_contact.kind contact)
116
-
~emails:(Sortal_contact.emails contact)
117
-
~organizations:(Sortal_contact.organizations contact)
118
-
~urls:(Sortal_contact.urls contact)
119
-
~services:(services @ [service])
120
-
?icon:(Sortal_contact.icon contact)
121
-
?thumbnail:(Sortal_contact.thumbnail contact)
122
-
?orcid:(Sortal_contact.orcid contact)
123
-
?feeds:(Sortal_contact.feeds contact)
124
-
()
125
-
)
126
-
127
-
let remove_service t handle url =
128
-
update_contact t handle (fun contact ->
129
-
let services = Sortal_contact.services contact
130
-
|> List.filter (fun (s : Sortal_contact.service) -> s.url <> url) in
131
-
Sortal_contact.make
132
-
~handle:(Sortal_contact.handle contact)
133
-
~names:(Sortal_contact.names contact)
134
-
~kind:(Sortal_contact.kind contact)
135
-
~emails:(Sortal_contact.emails contact)
136
-
~organizations:(Sortal_contact.organizations contact)
137
-
~urls:(Sortal_contact.urls contact)
138
-
~services
139
-
?icon:(Sortal_contact.icon contact)
140
-
?thumbnail:(Sortal_contact.thumbnail contact)
141
-
?orcid:(Sortal_contact.orcid contact)
142
-
?feeds:(Sortal_contact.feeds contact)
143
-
()
144
-
)
145
-
146
-
let add_organization t handle (org : Sortal_contact_v1.organization) =
147
-
match lookup t handle with
148
-
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
149
-
| Some contact ->
150
-
let orgs = Sortal_contact.organizations contact in
151
-
(* Check for exact duplicate organization (same name, title, and department) *)
152
-
let is_duplicate = List.exists (fun (o : Sortal_contact_v1.organization) ->
153
-
o.name = org.name &&
154
-
o.title = org.title &&
155
-
o.department = org.department
156
-
) orgs in
157
-
if is_duplicate then
158
-
Error (Printf.sprintf "Organization %s with the same title/department already exists for contact @%s" org.name handle)
159
-
else
160
-
update_contact t handle (fun contact ->
161
-
let orgs = Sortal_contact.organizations contact in
162
-
Sortal_contact.make
163
-
~handle:(Sortal_contact.handle contact)
164
-
~names:(Sortal_contact.names contact)
165
-
~kind:(Sortal_contact.kind contact)
166
-
~emails:(Sortal_contact.emails contact)
167
-
~organizations:(orgs @ [org])
168
-
~urls:(Sortal_contact.urls contact)
169
-
~services:(Sortal_contact.services contact)
170
-
?icon:(Sortal_contact.icon contact)
171
-
?thumbnail:(Sortal_contact.thumbnail contact)
172
-
?orcid:(Sortal_contact.orcid contact)
173
-
?feeds:(Sortal_contact.feeds contact)
174
-
()
175
-
)
176
-
177
-
let remove_organization t handle name =
178
-
update_contact t handle (fun contact ->
179
-
let orgs = Sortal_contact.organizations contact
180
-
|> List.filter (fun (o : Sortal_contact.organization) -> o.name <> name) in
181
-
Sortal_contact.make
182
-
~handle:(Sortal_contact.handle contact)
183
-
~names:(Sortal_contact.names contact)
184
-
~kind:(Sortal_contact.kind contact)
185
-
~emails:(Sortal_contact.emails contact)
186
-
~organizations:orgs
187
-
~urls:(Sortal_contact.urls contact)
188
-
~services:(Sortal_contact.services contact)
189
-
?icon:(Sortal_contact.icon contact)
190
-
?thumbnail:(Sortal_contact.thumbnail contact)
191
-
?orcid:(Sortal_contact.orcid contact)
192
-
?feeds:(Sortal_contact.feeds contact)
193
-
()
194
-
)
195
-
196
-
let add_url t handle (url_entry : Sortal_contact_v1.url_entry) =
197
-
match lookup t handle with
198
-
| None -> Error (Printf.sprintf "Contact not found: %s" handle)
199
-
| Some contact ->
200
-
let urls = Sortal_contact.urls contact in
201
-
(* Check for duplicate URL *)
202
-
if List.exists (fun (u : Sortal_contact_v1.url_entry) -> u.url = url_entry.url) urls then
203
-
Error (Printf.sprintf "URL %s already exists for contact @%s" url_entry.url handle)
204
-
else
205
-
update_contact t handle (fun contact ->
206
-
let urls = Sortal_contact.urls contact in
207
-
Sortal_contact.make
208
-
~handle:(Sortal_contact.handle contact)
209
-
~names:(Sortal_contact.names contact)
210
-
~kind:(Sortal_contact.kind contact)
211
-
~emails:(Sortal_contact.emails contact)
212
-
~organizations:(Sortal_contact.organizations contact)
213
-
~urls:(urls @ [url_entry])
214
-
~services:(Sortal_contact.services contact)
215
-
?icon:(Sortal_contact.icon contact)
216
-
?thumbnail:(Sortal_contact.thumbnail contact)
217
-
?orcid:(Sortal_contact.orcid contact)
218
-
?feeds:(Sortal_contact.feeds contact)
219
-
()
220
-
)
221
-
222
-
let remove_url t handle url =
223
-
update_contact t handle (fun contact ->
224
-
let urls = Sortal_contact.urls contact
225
-
|> List.filter (fun (u : Sortal_contact.url_entry) -> u.url <> url) in
226
-
Sortal_contact.make
227
-
~handle:(Sortal_contact.handle contact)
228
-
~names:(Sortal_contact.names contact)
229
-
~kind:(Sortal_contact.kind contact)
230
-
~emails:(Sortal_contact.emails contact)
231
-
~organizations:(Sortal_contact.organizations contact)
232
-
~urls
233
-
~services:(Sortal_contact.services contact)
234
-
?icon:(Sortal_contact.icon contact)
235
-
?thumbnail:(Sortal_contact.thumbnail contact)
236
-
?orcid:(Sortal_contact.orcid contact)
237
-
?feeds:(Sortal_contact.feeds contact)
238
-
()
239
-
)
240
-
241
-
let list t =
242
-
try
243
-
let entries = Eio.Path.read_dir t.data_dir in
244
-
List.filter_map (fun entry ->
245
-
if Filename.check_suffix entry ".yaml" then
246
-
let handle = Filename.chop_suffix entry ".yaml" in
247
-
lookup t handle
248
-
else
249
-
None
250
-
) entries
251
-
with
252
-
| _ -> []
253
-
254
-
let thumbnail_path t contact =
255
-
Sortal_contact.thumbnail contact
256
-
|> Option.map (fun relative_path -> Eio.Path.(t.data_dir / relative_path))
257
-
258
-
let png_thumbnail_path t contact =
259
-
match Sortal_contact.thumbnail contact with
260
-
| None -> None
261
-
| Some relative_path ->
262
-
let base = Filename.remove_extension relative_path in
263
-
let png_path = base ^ ".png" in
264
-
let full_path = Eio.Path.(t.data_dir / png_path) in
265
-
try
266
-
ignore (Eio.Path.load full_path);
267
-
Some full_path
268
-
with _ -> None
269
-
270
-
let handle_of_name name =
271
-
let name = String.lowercase_ascii name in
272
-
let words = String.split_on_char ' ' name in
273
-
let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in
274
-
initials ^ List.hd (List.rev words)
275
-
276
-
let find_by_name t name =
277
-
let name_lower = String.lowercase_ascii name in
278
-
let all_contacts = list t in
279
-
let matches = List.filter (fun c ->
280
-
List.exists (fun n -> String.lowercase_ascii n = name_lower)
281
-
(Sortal_contact.names c)
282
-
) all_contacts in
283
-
match matches with
284
-
| [contact] -> contact
285
-
| [] -> raise Not_found
286
-
| _ -> raise (Invalid_argument ("Multiple contacts match: " ^ name))
287
-
288
-
let find_by_name_opt t name =
289
-
try
290
-
Some (find_by_name t name)
291
-
with
292
-
| Not_found | Invalid_argument _ -> None
293
-
294
-
let contains_substring ~needle haystack =
295
-
let needle_len = String.length needle in
296
-
let haystack_len = String.length haystack in
297
-
if needle_len = 0 then true
298
-
else if needle_len > haystack_len then false
299
-
else
300
-
let rec check i =
301
-
if i > haystack_len - needle_len then false
302
-
else if String.sub haystack i needle_len = needle then true
303
-
else check (i + 1)
304
-
in
305
-
check 0
306
-
307
-
let search_all t query =
308
-
let query_lower = String.lowercase_ascii query in
309
-
let all = list t in
310
-
let matches = List.filter (fun c ->
311
-
List.exists (fun name ->
312
-
let name_lower = String.lowercase_ascii name in
313
-
String.equal name_lower query_lower ||
314
-
String.starts_with ~prefix:query_lower name_lower ||
315
-
contains_substring ~needle:query_lower name_lower ||
316
-
(String.contains name_lower ' ' &&
317
-
String.split_on_char ' ' name_lower |> List.exists (fun word ->
318
-
String.starts_with ~prefix:query_lower word
319
-
))
320
-
) (Sortal_contact.names c)
321
-
) all in
322
-
List.sort Sortal_contact.compare matches
323
-
324
-
let find_by_email_at t ~email ~date =
325
-
let all = list t in
326
-
List.find_opt (fun c ->
327
-
let emails_at_date = Sortal_contact.emails_at c ~date in
328
-
List.exists (fun e -> e.Sortal_contact_v1.address = email) emails_at_date
329
-
) all
330
-
331
-
let find_by_org t ~org ?from ?until () =
332
-
let org_lower = String.lowercase_ascii org in
333
-
let all = list t in
334
-
let matches = List.filter (fun c ->
335
-
let orgs : Sortal_contact_v1.organization list = Sortal_contact.organizations c in
336
-
let filtered_orgs = match from, until with
337
-
| None, None -> orgs
338
-
| _, _ -> Sortal_temporal.filter ~get:(fun (o : Sortal_contact_v1.organization) -> o.range)
339
-
~from ~until orgs
340
-
in
341
-
List.exists (fun (o : Sortal_contact_v1.organization) ->
342
-
contains_substring ~needle:org_lower
343
-
(String.lowercase_ascii o.name)
344
-
) filtered_orgs
345
-
) all in
346
-
List.sort Sortal_contact.compare matches
347
-
348
-
let list_at t ~date =
349
-
let all = list t in
350
-
List.filter (fun c ->
351
-
(* Contact is active if it has any email, org, or URL valid at date *)
352
-
let has_email = Sortal_contact.emails_at c ~date <> [] in
353
-
let has_org = Sortal_contact.organization_at c ~date <> None in
354
-
let has_url = Sortal_contact.url_at c ~date <> None in
355
-
has_email || has_org || has_url
356
-
) all
357
-
358
-
let pp ppf t =
359
-
let all = list t in
360
-
Fmt.pf ppf "@[<v>%a: %d contacts stored in XDG data directory@]"
361
-
(Fmt.styled `Bold Fmt.string) "Sortal Store"
362
-
(List.length all)
+21
-18
lib/sortal_store.mli
lib/core/sortal_store.mli
+21
-18
lib/sortal_store.mli
lib/core/sortal_store.mli
···
4
4
using XDG-compliant storage locations. Contacts are stored as
5
5
YAML files (one per contact) using the handle as the filename. *)
6
6
7
+
module Contact = Sortal_schema.Contact
8
+
module Temporal = Sortal_schema.Temporal
9
+
7
10
type t
8
11
9
12
(** [create fs app_name] creates a new contact store.
···
34
37
named "handle.yaml" in the XDG data directory.
35
38
36
39
If a contact with the same handle already exists, it is overwritten. *)
37
-
val save : t -> Sortal_contact.t -> unit
40
+
val save : t -> Contact.t -> unit
38
41
39
42
(** [lookup t handle] retrieves a contact by handle.
40
43
···
42
45
and deserializes it if found.
43
46
44
47
@return [Some contact] if found, [None] if not found or deserialization fails *)
45
-
val lookup : t -> string -> Sortal_contact.t option
48
+
val lookup : t -> string -> Contact.t option
46
49
47
50
(** [delete t handle] removes a contact from the store.
48
51
···
59
62
@param email The email entry to add
60
63
@return [Ok ()] on success, [Error msg] if contact not found
61
64
@raise Failure if the contact cannot be saved *)
62
-
val add_email : t -> string -> Sortal_contact.email -> (unit, string) result
65
+
val add_email : t -> string -> Contact.email -> (unit, string) result
63
66
64
67
(** [remove_email t handle address] removes an email from a contact.
65
68
···
77
80
@param handle The contact handle
78
81
@param service The service entry to add
79
82
@return [Ok ()] on success, [Error msg] if contact not found *)
80
-
val add_service : t -> string -> Sortal_contact.service -> (unit, string) result
83
+
val add_service : t -> string -> Contact.service -> (unit, string) result
81
84
82
85
(** [remove_service t handle url] removes a service from a contact.
83
86
···
95
98
@param handle The contact handle
96
99
@param org The organization entry to add
97
100
@return [Ok ()] on success, [Error msg] if contact not found *)
98
-
val add_organization : t -> string -> Sortal_contact.organization -> (unit, string) result
101
+
val add_organization : t -> string -> Contact.organization -> (unit, string) result
99
102
100
103
(** [remove_organization t handle name] removes an organization from a contact.
101
104
···
113
116
@param handle The contact handle
114
117
@param url_entry The URL entry to add
115
118
@return [Ok ()] on success, [Error msg] if contact not found *)
116
-
val add_url : t -> string -> Sortal_contact.url_entry -> (unit, string) result
119
+
val add_url : t -> string -> Contact.url_entry -> (unit, string) result
117
120
118
121
(** [remove_url t handle url] removes a URL from a contact.
119
122
···
133
136
@param handle The contact handle
134
137
@param f Function to transform the contact
135
138
@return [Ok ()] on success, [Error msg] if contact not found *)
136
-
val update_contact : t -> string -> (Sortal_contact.t -> Sortal_contact.t) -> (unit, string) result
139
+
val update_contact : t -> string -> (Contact.t -> Contact.t) -> (unit, string) result
137
140
138
141
(** [list t] returns all contacts in the store.
139
142
···
142
145
silently skipped.
143
146
144
147
@return A list of all successfully loaded contacts *)
145
-
val list : t -> Sortal_contact.t list
148
+
val list : t -> Contact.t list
146
149
147
150
(** [thumbnail_path t contact] returns the absolute filesystem path to the contact's thumbnail.
148
151
···
151
154
152
155
@param t The Sortal store
153
156
@param contact The contact whose thumbnail path to retrieve *)
154
-
val thumbnail_path : t -> Sortal_contact.t -> Eio.Fs.dir_ty Eio.Path.t option
157
+
val thumbnail_path : t -> Contact.t -> Eio.Fs.dir_ty Eio.Path.t option
155
158
156
159
(** [png_thumbnail_path t contact] returns the path to the PNG version of the contact's thumbnail.
157
160
···
161
164
162
165
@param t The Sortal store
163
166
@param contact The contact whose PNG thumbnail path to retrieve *)
164
-
val png_thumbnail_path : t -> Sortal_contact.t -> Eio.Fs.dir_ty Eio.Path.t option
167
+
val png_thumbnail_path : t -> Contact.t -> Eio.Fs.dir_ty Eio.Path.t option
165
168
166
169
(** {1 Searching} *)
167
170
···
174
177
@return The matching contact if exactly one match is found
175
178
@raise Not_found if no contacts match the name
176
179
@raise Invalid_argument if multiple contacts match the name *)
177
-
val find_by_name : t -> string -> Sortal_contact.t
180
+
val find_by_name : t -> string -> Contact.t
178
181
179
182
(** [find_by_name_opt t name] searches for contacts by name, returning an option.
180
183
···
183
186
184
187
@param name The name to search for (case-insensitive)
185
188
@return [Some contact] if exactly one match is found, [None] otherwise *)
186
-
val find_by_name_opt : t -> string -> Sortal_contact.t option
189
+
val find_by_name_opt : t -> string -> Contact.t option
187
190
188
191
(** [search_all t query] searches for contacts matching a query string.
189
192
···
197
200
@param t The contact store
198
201
@param query The search query (case-insensitive)
199
202
@return A list of matching contacts, sorted by handle *)
200
-
val search_all : t -> string -> Sortal_contact.t list
203
+
val search_all : t -> string -> Contact.t list
201
204
202
205
(** {1 Temporal Queries} *)
203
206
···
208
211
@param email Email address to search for
209
212
@param date ISO 8601 date string
210
213
@return The first matching contact, or [None] if not found *)
211
-
val find_by_email_at : t -> email:string -> date:Sortal_temporal.date ->
212
-
Sortal_contact.t option
214
+
val find_by_email_at : t -> email:string -> date:Temporal.date ->
215
+
Contact.t option
213
216
214
217
(** [find_by_org t ~org ?from ?until ()] finds contacts who worked at an organization.
215
218
···
220
223
@param from Start date of period to check (inclusive, optional)
221
224
@param until End date of period to check (exclusive, optional)
222
225
@return List of matching contacts, sorted by handle *)
223
-
val find_by_org : t -> org:string -> ?from:Sortal_temporal.date ->
224
-
?until:Sortal_temporal.date -> unit -> Sortal_contact.t list
226
+
val find_by_org : t -> org:string -> ?from:Temporal.date ->
227
+
?until:Temporal.date -> unit -> Contact.t list
225
228
226
229
(** [list_at t ~date] returns contacts that were active at a specific date.
227
230
···
230
233
231
234
@param date ISO 8601 date string
232
235
@return List of active contacts at that date *)
233
-
val list_at : t -> date:Sortal_temporal.date -> Sortal_contact.t list
236
+
val list_at : t -> date:Temporal.date -> Contact.t list
234
237
235
238
(** {1 Utilities} *)
236
239
lib/sortal_temporal.ml
lib/schema/sortal_schema_temporal.ml
lib/sortal_temporal.ml
lib/schema/sortal_schema_temporal.ml
lib/sortal_temporal.mli
lib/schema/sortal_schema_temporal.mli
lib/sortal_temporal.mli
lib/schema/sortal_schema_temporal.mli