A CLI and OCaml library for managing contacts
initial
+1310
+1
.gitignore
+1
.gitignore
···
1
+
_build
+4
bin/dune
+4
bin/dune
+60
bin/sortal_cli.ml
+60
bin/sortal_cli.ml
···
1
+
open Cmdliner
2
+
3
+
let run ~info main_term =
4
+
let run_main main =
5
+
Eio_main.run @@ fun env ->
6
+
let xdg = Xdge.create env#fs "sortal" in
7
+
main xdg
8
+
in
9
+
let term =
10
+
let open Term.Syntax in
11
+
let+ main = main_term
12
+
and+ log_level = Logs_cli.level () in
13
+
Fmt.set_style_renderer Fmt.stdout `Ansi_tty;
14
+
Fmt.set_style_renderer Fmt.stderr `Ansi_tty;
15
+
Logs.set_reporter (Logs_fmt.reporter ~app:Fmt.stdout ~dst:Fmt.stderr ());
16
+
Logs.set_level log_level;
17
+
run_main main
18
+
in
19
+
Cmd.v info term
20
+
21
+
(* Main command *)
22
+
let () =
23
+
let info = Cmd.info "sortal"
24
+
~version:"0.1.0"
25
+
~doc:"Contact metadata management"
26
+
~man:[
27
+
`S Manpage.s_description;
28
+
`P "Sortal manages contact metadata including URLs, emails, ORCID identifiers, \
29
+
and social media handles. Data is stored as JSON in XDG-compliant locations.";
30
+
`S Manpage.s_commands;
31
+
`P "Use $(b,sortal COMMAND --help) for detailed help on each command.";
32
+
]
33
+
in
34
+
35
+
let list_cmd_term = Term.(const (fun () -> Sortal.Cmd.list_cmd ()) $ const ()) in
36
+
let list_cmd = run ~info:Sortal.Cmd.list_info list_cmd_term in
37
+
38
+
let show_cmd_term = Term.(const (fun handle -> Sortal.Cmd.show_cmd handle) $ Sortal.Cmd.handle_arg) in
39
+
let show_cmd = run ~info:Sortal.Cmd.show_info show_cmd_term in
40
+
41
+
let search_cmd_term = Term.(const (fun query -> Sortal.Cmd.search_cmd query) $ Sortal.Cmd.query_arg) in
42
+
let search_cmd = run ~info:Sortal.Cmd.search_info search_cmd_term in
43
+
44
+
let stats_cmd_term = Term.(const (fun () -> Sortal.Cmd.stats_cmd ()) $ const ()) in
45
+
let stats_cmd = run ~info:Sortal.Cmd.stats_info stats_cmd_term in
46
+
47
+
let sync_cmd_term = Term.(const (fun () -> Sortal.Cmd.sync_cmd ()) $ const ()) in
48
+
let sync_cmd = run ~info:Sortal.Cmd.sync_info sync_cmd_term in
49
+
50
+
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
51
+
52
+
let cmd = Cmd.group info ~default:default_term [
53
+
list_cmd;
54
+
show_cmd;
55
+
search_cmd;
56
+
stats_cmd;
57
+
sync_cmd;
58
+
] in
59
+
60
+
exit (Cmd.eval' cmd)
+16
dune-project
+16
dune-project
···
1
+
(lang dune 3.20)
2
+
3
+
(name sortal)
4
+
5
+
(package
6
+
(name sortal)
7
+
(synopsis "Keep track of users and their metadata in a collective web")
8
+
(description
9
+
"Sortal provides a system for mapping usernames to various metadata including URLs, emails, ORCID identifiers, and social media handles.")
10
+
(depends
11
+
(ocaml (>= 5.1.0))
12
+
eio
13
+
eio_main
14
+
xdge
15
+
jsont
16
+
fmt))
+4
lib/dune
+4
lib/dune
+19
lib/sortal.ml
+19
lib/sortal.ml
···
1
+
module Feed = Sortal_feed
2
+
module Contact = Sortal_contact
3
+
module Store = Sortal_store
4
+
module Cmd = Sortal_cmd
5
+
6
+
type t = Store.t
7
+
8
+
let create = Store.create
9
+
let create_from_xdg = Store.create_from_xdg
10
+
let save = Store.save
11
+
let lookup = Store.lookup
12
+
let delete = Store.delete
13
+
let list = Store.list
14
+
let thumbnail_path = Store.thumbnail_path
15
+
let find_by_name = Store.find_by_name
16
+
let find_by_name_opt = Store.find_by_name_opt
17
+
let search_all = Store.search_all
18
+
let handle_of_name = Store.handle_of_name
19
+
let pp = Store.pp
+99
lib/sortal.mli
+99
lib/sortal.mli
···
1
+
(** Sortal - Username to metadata mapping with XDG storage
2
+
3
+
This library provides a system for mapping usernames to various metadata
4
+
including URLs, emails, ORCID identifiers, and social media handles.
5
+
It uses XDG Base Directory Specification for storage locations and
6
+
jsont for JSON encoding/decoding.
7
+
8
+
{b Storage:}
9
+
10
+
Contact metadata is stored as JSON files in the XDG data directory,
11
+
with one file per contact using the handle as the filename.
12
+
13
+
{b Typical Usage:}
14
+
15
+
{[
16
+
let store = Sortal.create env#fs "myapp" in
17
+
let contact = Sortal.Contact.make
18
+
~handle:"avsm"
19
+
~names:["Anil Madhavapeddy"]
20
+
~email:"anil@recoil.org"
21
+
~github:"avsm"
22
+
~orcid:"0000-0002-7890-1234"
23
+
() in
24
+
Sortal.save store contact;
25
+
26
+
match Sortal.lookup store "avsm" with
27
+
| Some c -> Printf.printf "Found: %s\n" (Sortal.Contact.name c)
28
+
| None -> Printf.printf "Not found\n"
29
+
]}
30
+
*)
31
+
32
+
(** {1 Core Modules} *)
33
+
34
+
(** Feed subscription metadata. *)
35
+
module Feed = Sortal_feed
36
+
37
+
(** Contact metadata. *)
38
+
module Contact = Sortal_contact
39
+
40
+
(** Contact store with XDG-compliant storage. *)
41
+
module Store = Sortal_store
42
+
43
+
(** Cmdliner integration for CLI applications. *)
44
+
module Cmd = Sortal_cmd
45
+
46
+
(** {1 Convenience Re-exports}
47
+
48
+
These are re-exported from {!Store} for easier top-level access. *)
49
+
50
+
(** The contact store type. *)
51
+
type t = Store.t
52
+
53
+
(** [create fs app_name] creates a new contact store.
54
+
See {!Store.create} for details. *)
55
+
val create : Eio.Fs.dir_ty Eio.Path.t -> string -> t
56
+
57
+
(** [create_from_xdg xdg] creates a contact store from an XDG context.
58
+
See {!Store.create_from_xdg} for details. *)
59
+
val create_from_xdg : Xdge.t -> t
60
+
61
+
(** [save t contact] saves a contact to the store.
62
+
See {!Store.save} for details. *)
63
+
val save : t -> Contact.t -> unit
64
+
65
+
(** [lookup t handle] retrieves a contact by handle.
66
+
See {!Store.lookup} for details. *)
67
+
val lookup : t -> string -> Contact.t option
68
+
69
+
(** [delete t handle] removes a contact from the store.
70
+
See {!Store.delete} for details. *)
71
+
val delete : t -> string -> unit
72
+
73
+
(** [list t] returns all contacts in the store.
74
+
See {!Store.list} for details. *)
75
+
val list : t -> Contact.t list
76
+
77
+
(** [thumbnail_path t contact] returns the path to a contact's thumbnail.
78
+
See {!Store.thumbnail_path} for details. *)
79
+
val thumbnail_path : t -> Contact.t -> Eio.Fs.dir_ty Eio.Path.t option
80
+
81
+
(** [find_by_name t name] searches for contacts by name.
82
+
See {!Store.find_by_name} for details. *)
83
+
val find_by_name : t -> string -> Contact.t
84
+
85
+
(** [find_by_name_opt t name] searches for contacts by name.
86
+
See {!Store.find_by_name_opt} for details. *)
87
+
val find_by_name_opt : t -> string -> Contact.t option
88
+
89
+
(** [search_all t query] searches for contacts matching a query.
90
+
See {!Store.search_all} for details. *)
91
+
val search_all : t -> string -> Contact.t list
92
+
93
+
(** [handle_of_name name] generates a handle from a full name.
94
+
See {!Store.handle_of_name} for details. *)
95
+
val handle_of_name : string -> string
96
+
97
+
(** [pp ppf t] pretty prints the contact store.
98
+
See {!Store.pp} for details. *)
99
+
val pp : Format.formatter -> t -> unit
+235
lib/sortal_cmd.ml
+235
lib/sortal_cmd.ml
···
1
+
open Cmdliner
2
+
3
+
let image_columns = 9 (* columns for 4-row square-ish thumbnail + 3 padding *)
4
+
5
+
let supports_kitty_graphics () =
6
+
let check_env var =
7
+
match Sys.getenv_opt var with
8
+
| Some _ -> true
9
+
| None -> false
10
+
in
11
+
let check_env_contains var substr =
12
+
match Sys.getenv_opt var with
13
+
| Some v -> String.lowercase_ascii v |> fun s ->
14
+
String.length s >= String.length substr &&
15
+
let rec check i =
16
+
if i > String.length s - String.length substr then false
17
+
else if String.sub s i (String.length substr) = substr then true
18
+
else check (i + 1)
19
+
in check 0
20
+
| None -> false
21
+
in
22
+
check_env "KITTY_WINDOW_ID" ||
23
+
check_env "WEZTERM_PANE" ||
24
+
check_env "GHOSTTY_RESOURCES_DIR" ||
25
+
check_env_contains "TERM_PROGRAM" "kitty" ||
26
+
check_env_contains "TERM_PROGRAM" "wezterm" ||
27
+
check_env_contains "TERM_PROGRAM" "ghostty" ||
28
+
check_env_contains "TERM" "kitty"
29
+
30
+
let display_png_thumbnail path =
31
+
let png_data = Eio.Path.load path in
32
+
let placement = Kgp.Placement.make ~rows:4 ~cursor:`Static () in
33
+
let cmd = Kgp.transmit_and_display ~format:`Png ~placement () in
34
+
Kgp.to_string cmd ~data:png_data
35
+
36
+
let display_block_placeholder () =
37
+
(* 4 rows of patterned block characters as fallback *)
38
+
let row1 = "▓▒░▒▓▒" in
39
+
let row2 = "▒░▒▓▒░" in
40
+
let row3 = "░▒▓▒░▒" in
41
+
let row4 = "▒▓▒░▒▓" in
42
+
Printf.sprintf "%s\n%s\n%s\n%s\x1b[4A" row1 row2 row3 row4 (* print 4 rows, move up 4 *)
43
+
44
+
let move_right n = Printf.sprintf "\x1b[%dC" n
45
+
let move_down_and_back () = Printf.sprintf "\n\x1b[%dC" image_columns
46
+
47
+
let image_rows = 4 (* height of thumbnail in rows *)
48
+
49
+
(* 1-row thumbnail for listings *)
50
+
let display_small_thumbnail path =
51
+
let png_data = Eio.Path.load path in
52
+
let placement = Kgp.Placement.make ~rows:1 () in
53
+
let cmd = Kgp.transmit_and_display ~format:`Png ~placement () in
54
+
Kgp.to_string cmd ~data:png_data
55
+
56
+
let small_placeholder () = "▓░ " (* 1-row patterned placeholder *)
57
+
58
+
let list_cmd () xdg =
59
+
let store = Sortal_store.create_from_xdg xdg in
60
+
let contacts = Sortal_store.list store in
61
+
let sorted = List.sort Sortal_contact.compare contacts in
62
+
let use_graphics = supports_kitty_graphics () in
63
+
Printf.printf "Total contacts: %d\n" (List.length sorted);
64
+
List.iter (fun c ->
65
+
(match Sortal_store.png_thumbnail_path store c with
66
+
| Some path ->
67
+
if use_graphics then
68
+
print_string (display_small_thumbnail path)
69
+
else
70
+
print_string (small_placeholder ())
71
+
| None ->
72
+
print_string " "); (* spacing when no thumbnail *)
73
+
Printf.printf "@%s: %s\n" (Sortal_contact.handle c) (Sortal_contact.name c)
74
+
) sorted;
75
+
0
76
+
77
+
let show_cmd handle xdg =
78
+
let store = Sortal_store.create_from_xdg xdg in
79
+
match Sortal_store.lookup store handle with
80
+
| Some c ->
81
+
let has_thumbnail = match Sortal_store.png_thumbnail_path store c with
82
+
| Some path ->
83
+
if supports_kitty_graphics () then
84
+
print_string (display_png_thumbnail path)
85
+
else
86
+
print_string (display_block_placeholder ());
87
+
print_string (move_right image_columns);
88
+
true
89
+
| None -> false
90
+
in
91
+
let lines_output = ref 0 in
92
+
let indent () =
93
+
incr lines_output;
94
+
if has_thumbnail && !lines_output < image_rows then
95
+
print_string (move_down_and_back ())
96
+
else
97
+
print_newline ()
98
+
in
99
+
let field label value =
100
+
match value with
101
+
| Some v -> Printf.printf "%s: %s" label v; indent ()
102
+
| None -> ()
103
+
in
104
+
(* Line 1: Handle and Name *)
105
+
Printf.printf "@%s: %s" (Sortal_contact.handle c) (Sortal_contact.name c);
106
+
indent ();
107
+
(* Line 2: Email *)
108
+
field "Email" (Sortal_contact.email c);
109
+
(* Line 3: GitHub *)
110
+
field "GitHub" (Option.map (fun g -> "https://github.com/" ^ g) (Sortal_contact.github c));
111
+
(* Line 4: URL *)
112
+
field "URL" (Sortal_contact.best_url c);
113
+
(* Ensure we've output enough lines to clear the image area *)
114
+
if has_thumbnail then begin
115
+
while !lines_output < image_rows do
116
+
indent ()
117
+
done
118
+
end;
119
+
(* Additional fields below the image *)
120
+
Option.iter (fun tw -> Printf.printf "Twitter: https://twitter.com/%s\n" tw) (Sortal_contact.twitter c);
121
+
Option.iter (fun b -> Printf.printf "Bluesky: %s\n" b) (Sortal_contact.bluesky c);
122
+
Option.iter (fun m -> Printf.printf "Mastodon: %s\n" m) (Sortal_contact.mastodon c);
123
+
Option.iter (fun o -> Printf.printf "ORCID: https://orcid.org/%s\n" o) (Sortal_contact.orcid c);
124
+
0
125
+
| None -> Logs.err (fun m -> m "Contact not found: %s" handle); 1
126
+
127
+
let search_cmd query xdg =
128
+
let store = Sortal_store.create_from_xdg xdg in
129
+
match Sortal_store.search_all store query with
130
+
| [] ->
131
+
Logs.warn (fun m -> m "No contacts found matching: %s" query);
132
+
1
133
+
| matches ->
134
+
Logs.app (fun m -> m "Found %d match%s:"
135
+
(List.length matches)
136
+
(if List.length matches = 1 then "" else "es"));
137
+
List.iter (fun c ->
138
+
Logs.app (fun m -> m "@%s: %s" (Sortal_contact.handle c) (Sortal_contact.name c));
139
+
Option.iter (fun e -> Logs.app (fun m -> m " Email: %s" e)) (Sortal_contact.email c);
140
+
Option.iter (fun g -> Logs.app (fun m -> m " GitHub: @%s" g)) (Sortal_contact.github c);
141
+
Option.iter (fun u -> Logs.app (fun m -> m " URL: %s" u)) (Sortal_contact.best_url c)
142
+
) matches;
143
+
0
144
+
145
+
let stats_cmd () xdg =
146
+
let store = Sortal_store.create_from_xdg xdg in
147
+
let contacts = Sortal_store.list store in
148
+
let total = List.length contacts in
149
+
let count pred = List.filter pred contacts |> List.length in
150
+
let with_email = count (fun c -> Option.is_some (Sortal_contact.email c)) in
151
+
let with_github = count (fun c -> Option.is_some (Sortal_contact.github c)) in
152
+
let with_orcid = count (fun c -> Option.is_some (Sortal_contact.orcid c)) in
153
+
let with_url = count (fun c -> Option.is_some (Sortal_contact.url c)) in
154
+
let with_feeds = count (fun c -> Option.is_some (Sortal_contact.feeds c)) in
155
+
let total_feeds =
156
+
List.fold_left (fun acc c ->
157
+
acc + Option.fold ~none:0 ~some:List.length (Sortal_contact.feeds c)
158
+
) 0 contacts
159
+
in
160
+
let pct n = float_of_int n /. float_of_int total *. 100. in
161
+
Logs.app (fun m -> m "Contact Database Statistics:");
162
+
Logs.app (fun m -> m " Total contacts: %d" total);
163
+
Logs.app (fun m -> m " With email: %d (%.1f%%)" with_email (pct with_email));
164
+
Logs.app (fun m -> m " With GitHub: %d (%.1f%%)" with_github (pct with_github));
165
+
Logs.app (fun m -> m " With ORCID: %d (%.1f%%)" with_orcid (pct with_orcid));
166
+
Logs.app (fun m -> m " With URL: %d (%.1f%%)" with_url (pct with_url));
167
+
Logs.app (fun m -> m " With feeds: %d (%.1f%%), total %d feeds" with_feeds (pct with_feeds) total_feeds);
168
+
0
169
+
170
+
let is_png path =
171
+
let ext = String.lowercase_ascii (Filename.extension path) in
172
+
ext = ".png"
173
+
174
+
let convert_to_png src_path =
175
+
let base = Filename.remove_extension src_path in
176
+
let dst_path = base ^ ".png" in
177
+
let cmd = Printf.sprintf "magick %s %s" (Filename.quote src_path) (Filename.quote dst_path) in
178
+
let ret = Unix.system cmd in
179
+
match ret with
180
+
| Unix.WEXITED 0 -> Ok dst_path
181
+
| Unix.WEXITED n -> Error (Printf.sprintf "magick exited with code %d" n)
182
+
| Unix.WSIGNALED n -> Error (Printf.sprintf "magick killed by signal %d" n)
183
+
| Unix.WSTOPPED n -> Error (Printf.sprintf "magick stopped by signal %d" n)
184
+
185
+
let sync_cmd () xdg =
186
+
let store = Sortal_store.create_from_xdg xdg in
187
+
let contacts = Sortal_store.list store in
188
+
Logs.app (fun m -> m "Syncing %d contacts..." (List.length contacts));
189
+
let converted = ref 0 in
190
+
let skipped = ref 0 in
191
+
let no_thumbnail = ref 0 in
192
+
let errors = ref 0 in
193
+
List.iter (fun contact ->
194
+
let handle = Sortal_contact.handle contact in
195
+
match Sortal_store.thumbnail_path store contact with
196
+
| None ->
197
+
Logs.info (fun m -> m "@%s: no thumbnail" handle);
198
+
incr no_thumbnail
199
+
| Some eio_path ->
200
+
let path = Eio.Path.native_exn eio_path in
201
+
if is_png path then begin
202
+
Logs.info (fun m -> m "@%s: already PNG (%s)" handle (Filename.basename path));
203
+
incr skipped
204
+
end else begin
205
+
Logs.app (fun m -> m "@%s: converting %s to PNG..." handle (Filename.basename path));
206
+
match convert_to_png path with
207
+
| Ok new_path ->
208
+
Logs.app (fun m -> m " Converted: %s -> %s"
209
+
(Filename.basename path) (Filename.basename new_path));
210
+
incr converted
211
+
| Error msg ->
212
+
Logs.err (fun m -> m " Failed to convert %s: %s" path msg);
213
+
incr errors
214
+
end
215
+
) contacts;
216
+
Logs.app (fun m -> m "Sync complete:");
217
+
Logs.app (fun m -> m " %d contacts without thumbnails" !no_thumbnail);
218
+
Logs.app (fun m -> m " %d already PNG (skipped)" !skipped);
219
+
Logs.app (fun m -> m " %d converted to PNG" !converted);
220
+
Logs.app (fun m -> m " %d errors" !errors);
221
+
if !errors > 0 then 1 else 0
222
+
223
+
let list_info = Cmd.info "list" ~doc:"List all contacts"
224
+
let show_info = Cmd.info "show" ~doc:"Show detailed information about a contact"
225
+
let search_info = Cmd.info "search" ~doc:"Search contacts by name"
226
+
let stats_info = Cmd.info "stats" ~doc:"Show statistics about the contact database"
227
+
let sync_info = Cmd.info "sync" ~doc:"Synchronize and normalize contact data"
228
+
229
+
let handle_arg =
230
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"HANDLE"
231
+
~doc:"Contact handle to display")
232
+
233
+
let query_arg =
234
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"QUERY"
235
+
~doc:"Name or partial name to search for")
+56
lib/sortal_cmd.mli
+56
lib/sortal_cmd.mli
···
1
+
(** Cmdliner terms and commands for contact management.
2
+
3
+
This module provides ready-to-use Cmdliner terms for building
4
+
CLI applications that work with contact metadata. *)
5
+
6
+
(** {1 Command Implementations} *)
7
+
8
+
(** [list_cmd] is a Cmdliner command that lists all contacts.
9
+
10
+
Usage: Integrate into your CLI with [Cmd.group] or use standalone.
11
+
Returns a function that takes an XDG context and returns an exit code. *)
12
+
val list_cmd : unit -> (Xdge.t -> int)
13
+
14
+
(** [show_cmd handle] creates a command to show detailed contact information.
15
+
16
+
@param handle The contact handle to display *)
17
+
val show_cmd : string -> (Xdge.t -> int)
18
+
19
+
(** [search_cmd query] creates a command to search contacts by name.
20
+
21
+
@param query The search query string *)
22
+
val search_cmd : string -> (Xdge.t -> int)
23
+
24
+
(** [stats_cmd] is a command that shows database statistics. *)
25
+
val stats_cmd : unit -> (Xdge.t -> int)
26
+
27
+
(** [sync_cmd] is a command that synchronizes and normalizes contact data.
28
+
29
+
Currently performs the following operations:
30
+
- Converts non-JPG thumbnail images to PNG using ImageMagick *)
31
+
val sync_cmd : unit -> (Xdge.t -> int)
32
+
33
+
(** {1 Cmdliner Info Objects} *)
34
+
35
+
(** [list_info] is the command info for the list command. *)
36
+
val list_info : Cmdliner.Cmd.info
37
+
38
+
(** [show_info] is the command info for the show command. *)
39
+
val show_info : Cmdliner.Cmd.info
40
+
41
+
(** [search_info] is the command info for the search command. *)
42
+
val search_info : Cmdliner.Cmd.info
43
+
44
+
(** [stats_info] is the command info for the stats command. *)
45
+
val stats_info : Cmdliner.Cmd.info
46
+
47
+
(** [sync_info] is the command info for the sync command. *)
48
+
val sync_info : Cmdliner.Cmd.info
49
+
50
+
(** {1 Cmdliner Argument Definitions} *)
51
+
52
+
(** [handle_arg] is the positional argument for a contact handle. *)
53
+
val handle_arg : string Cmdliner.Term.t
54
+
55
+
(** [query_arg] is the positional argument for a search query. *)
56
+
val query_arg : string Cmdliner.Term.t
+115
lib/sortal_contact.ml
+115
lib/sortal_contact.ml
···
1
+
type t = {
2
+
handle : string;
3
+
names : string list;
4
+
email : string option;
5
+
icon : string option;
6
+
thumbnail : string option;
7
+
github : string option;
8
+
twitter : string option;
9
+
bluesky : string option;
10
+
mastodon : string option;
11
+
orcid : string option;
12
+
url_ : string option;
13
+
urls_ : string list option;
14
+
feeds : Sortal_feed.t list option;
15
+
}
16
+
17
+
let make ~handle ~names ?email ?icon ?thumbnail ?github ?twitter ?bluesky ?mastodon
18
+
?orcid ?url ?urls ?feeds () =
19
+
{ handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
20
+
orcid; url_ = url; urls_ = urls; feeds }
21
+
22
+
let handle t = t.handle
23
+
let names t = t.names
24
+
let name t = List.hd t.names
25
+
let primary_name = name
26
+
let email t = t.email
27
+
let icon t = t.icon
28
+
let thumbnail t = t.thumbnail
29
+
let github t = t.github
30
+
let twitter t = t.twitter
31
+
let bluesky t = t.bluesky
32
+
let mastodon t = t.mastodon
33
+
let orcid t = t.orcid
34
+
35
+
let url t =
36
+
t.url_ |> Option.fold ~none:(Option.bind t.urls_ (Fun.flip List.nth_opt 0)) ~some:Option.some
37
+
38
+
let urls t =
39
+
match t.url_, t.urls_ with
40
+
| Some u, Some us -> u :: us
41
+
| Some u, None -> [u]
42
+
| None, Some us -> us
43
+
| None, None -> []
44
+
45
+
let feeds t = t.feeds
46
+
47
+
let add_feed t feed =
48
+
{ t with feeds = Some (feed :: Option.value t.feeds ~default:[]) }
49
+
50
+
let remove_feed t url =
51
+
{ t with feeds = Option.map (List.filter (fun f -> Sortal_feed.url f <> url)) t.feeds }
52
+
53
+
let best_url t =
54
+
url t
55
+
|> Option.fold ~none:(Option.map (fun g -> "https://github.com/" ^ g) t.github) ~some:Option.some
56
+
|> Option.fold ~none:(Option.map (fun e -> "mailto:" ^ e) t.email) ~some:Option.some
57
+
58
+
let json_t =
59
+
let open Jsont in
60
+
let open Jsont.Object in
61
+
let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
62
+
let make handle names email icon thumbnail github twitter bluesky mastodon orcid url urls feeds =
63
+
{ handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
64
+
orcid; url_ = url; urls_ = urls; feeds }
65
+
in
66
+
map ~kind:"Contact" make
67
+
|> mem "handle" string ~enc:handle
68
+
|> mem "names" (list string) ~dec_absent:[] ~enc:names
69
+
|> mem_opt "email" (some string) ~enc:email
70
+
|> mem_opt "icon" (some string) ~enc:icon
71
+
|> mem_opt "thumbnail" (some string) ~enc:thumbnail
72
+
|> mem_opt "github" (some string) ~enc:github
73
+
|> mem_opt "twitter" (some string) ~enc:twitter
74
+
|> mem_opt "bluesky" (some string) ~enc:bluesky
75
+
|> mem_opt "mastodon" (some string) ~enc:mastodon
76
+
|> mem_opt "orcid" (some string) ~enc:orcid
77
+
|> mem_opt "url" (some string) ~enc:(fun t -> t.url_)
78
+
|> mem_opt "urls" (some (list string)) ~enc:(fun t -> t.urls_)
79
+
|> mem_opt "feeds" (some (list Sortal_feed.json_t)) ~enc:feeds
80
+
|> finish
81
+
82
+
let compare a b = String.compare a.handle b.handle
83
+
84
+
let pp ppf t =
85
+
let open Fmt in
86
+
let label = styled (`Fg `Cyan) string in
87
+
let url_style = styled (`Fg `Blue) in
88
+
let field lbl fmt_v = Option.iter (fun v -> pf ppf "%a: %a@," label lbl fmt_v v) in
89
+
pf ppf "@[<v>";
90
+
pf ppf "%a: %a@," label "Handle" (styled `Bold (fun ppf s -> pf ppf "@%s" s)) t.handle;
91
+
pf ppf "%a: %a@," label "Name" (styled `Bold string) (name t);
92
+
if List.length (names t) > 1 then
93
+
pf ppf "%a: @[<h>%a@]@," label "Aliases"
94
+
(list ~sep:comma string) (List.tl (names t));
95
+
field "Email" (styled (`Fg `Yellow) string) t.email;
96
+
field "GitHub" (url_style (fun ppf g -> pf ppf "https://github.com/%s" g)) t.github;
97
+
field "Twitter" (url_style (fun ppf tw -> pf ppf "https://twitter.com/%s" tw)) t.twitter;
98
+
field "Bluesky" (styled (`Fg `Magenta) string) t.bluesky;
99
+
field "Mastodon" (styled (`Fg `Magenta) string) t.mastodon;
100
+
field "ORCID" (url_style (fun ppf o -> pf ppf "https://orcid.org/%s" o)) t.orcid;
101
+
(match urls t with
102
+
| [] -> ()
103
+
| [u] -> pf ppf "%a: %a@," label "URL" (url_style string) u
104
+
| all_urls ->
105
+
pf ppf "%a:@," label "URLs";
106
+
List.iter (fun u -> pf ppf " - %a@," (url_style string) u) all_urls);
107
+
field "Icon" (url_style string) t.icon;
108
+
field "Thumbnail" (styled (`Fg `White) string) t.thumbnail;
109
+
Option.iter (function
110
+
| [] -> ()
111
+
| feeds ->
112
+
pf ppf "%a:@," label "Feeds";
113
+
List.iter (fun feed -> pf ppf " - %a@," Sortal_feed.pp feed) feeds
114
+
) t.feeds;
115
+
pf ppf "@]"
+137
lib/sortal_contact.mli
+137
lib/sortal_contact.mli
···
1
+
(** Individual contact metadata.
2
+
3
+
A contact represents metadata about a person, including their name(s),
4
+
social media handles, professional identifiers, and other contact information. *)
5
+
6
+
type t
7
+
8
+
(** [make ~handle ~names ?email ?icon ?thumbnail ?github ?twitter ?bluesky ?mastodon
9
+
?orcid ?url ?feeds ()] creates a new contact.
10
+
11
+
@param handle A unique identifier/username for this contact (required)
12
+
@param names A list of names for this contact, with the first being primary (required)
13
+
@param email Email address
14
+
@param icon URL to an avatar/icon image
15
+
@param thumbnail Path to a local thumbnail image file
16
+
@param github GitHub username (without the [\@] prefix)
17
+
@param twitter Twitter/X username (without the [\@] prefix)
18
+
@param bluesky Bluesky handle
19
+
@param mastodon Mastodon handle (including instance)
20
+
@param orcid ORCID identifier
21
+
@param url Personal or professional website URL (primary URL)
22
+
@param urls Additional website URLs
23
+
@param feeds List of feed subscriptions (Atom/RSS/JSON) associated with this contact *)
24
+
val make :
25
+
handle:string ->
26
+
names:string list ->
27
+
?email:string ->
28
+
?icon:string ->
29
+
?thumbnail:string ->
30
+
?github:string ->
31
+
?twitter:string ->
32
+
?bluesky:string ->
33
+
?mastodon:string ->
34
+
?orcid:string ->
35
+
?url:string ->
36
+
?urls:string list ->
37
+
?feeds:Sortal_feed.t list ->
38
+
unit ->
39
+
t
40
+
41
+
(** {1 Accessors} *)
42
+
43
+
(** [handle t] returns the unique handle/username. *)
44
+
val handle : t -> string
45
+
46
+
(** [names t] returns all names associated with this contact. *)
47
+
val names : t -> string list
48
+
49
+
(** [name t] returns the primary (first) name. *)
50
+
val name : t -> string
51
+
52
+
(** [primary_name t] returns the primary (first) name.
53
+
This is an alias for {!name} for clarity. *)
54
+
val primary_name : t -> string
55
+
56
+
(** [email t] returns the email address if available. *)
57
+
val email : t -> string option
58
+
59
+
(** [icon t] returns the icon/avatar URL if available. *)
60
+
val icon : t -> string option
61
+
62
+
(** [thumbnail t] returns the path to the local thumbnail image if available.
63
+
This is a relative path from the Sortal data directory. *)
64
+
val thumbnail : t -> string option
65
+
66
+
(** [github t] returns the GitHub username if available. *)
67
+
val github : t -> string option
68
+
69
+
(** [twitter t] returns the Twitter/X username if available. *)
70
+
val twitter : t -> string option
71
+
72
+
(** [bluesky t] returns the Bluesky handle if available. *)
73
+
val bluesky : t -> string option
74
+
75
+
(** [mastodon t] returns the Mastodon handle if available. *)
76
+
val mastodon : t -> string option
77
+
78
+
(** [orcid t] returns the ORCID identifier if available. *)
79
+
val orcid : t -> string option
80
+
81
+
(** [url t] returns the primary URL if available.
82
+
83
+
Returns the [url] field if set, otherwise returns the first element
84
+
of [urls] if available, or [None] if neither is set. *)
85
+
val url : t -> string option
86
+
87
+
(** [urls t] returns all URLs associated with this contact.
88
+
89
+
Combines the [url] field (if set) with the [urls] list (if set).
90
+
The primary [url] appears first if present. Returns an empty list
91
+
if neither [url] nor [urls] is set. *)
92
+
val urls : t -> string list
93
+
94
+
(** [feeds t] returns the list of feed subscriptions if available. *)
95
+
val feeds : t -> Sortal_feed.t list option
96
+
97
+
(** [add_feed t feed] returns a new contact with the feed added. *)
98
+
val add_feed : t -> Sortal_feed.t -> t
99
+
100
+
(** [remove_feed t url] returns a new contact with the feed matching the URL removed. *)
101
+
val remove_feed : t -> string -> t
102
+
103
+
(** {1 Derived Information} *)
104
+
105
+
(** [best_url t] returns the best available URL for this contact.
106
+
107
+
Priority order:
108
+
1. Personal URL (if set)
109
+
2. GitHub profile URL (if GitHub username is set)
110
+
3. Email as mailto: link (if email is set)
111
+
4. None if no URL-like information is available *)
112
+
val best_url : t -> string option
113
+
114
+
(** {1 JSON Encoding} *)
115
+
116
+
(** [json_t] is the jsont encoder/decoder for contacts.
117
+
118
+
The JSON schema includes all contact fields with optional values
119
+
omitted when not present:
120
+
{[
121
+
{
122
+
"handle": "avsm",
123
+
"names": ["Anil Madhavapeddy"],
124
+
"email": "anil@recoil.org",
125
+
"github": "avsm",
126
+
"orcid": "0000-0002-7890-1234"
127
+
}
128
+
]} *)
129
+
val json_t : t Jsont.t
130
+
131
+
(** {1 Utilities} *)
132
+
133
+
(** [compare a b] compares two contacts by their handles. *)
134
+
val compare : t -> t -> int
135
+
136
+
(** [pp ppf t] pretty prints a contact with formatting. *)
137
+
val pp : Format.formatter -> t -> unit
+51
lib/sortal_feed.ml
+51
lib/sortal_feed.ml
···
1
+
type feed_type =
2
+
| Atom
3
+
| Rss
4
+
| Json
5
+
6
+
type t = {
7
+
feed_type : feed_type;
8
+
url : string;
9
+
name : string option;
10
+
}
11
+
12
+
let make ~feed_type ~url ?name () =
13
+
{ feed_type; url; name }
14
+
15
+
let feed_type t = t.feed_type
16
+
let url t = t.url
17
+
let name t = t.name
18
+
19
+
let set_name t name = { t with name = Some name }
20
+
21
+
let feed_type_to_string = function
22
+
| Atom -> "atom"
23
+
| Rss -> "rss"
24
+
| Json -> "json"
25
+
26
+
let feed_type_of_string = function
27
+
| "atom" -> Some Atom
28
+
| "rss" -> Some Rss
29
+
| "json" -> Some Json
30
+
| _ -> None
31
+
32
+
let json_t =
33
+
let open Jsont in
34
+
let open Jsont.Object in
35
+
let make feed_type url name =
36
+
match feed_type_of_string feed_type with
37
+
| Some ft -> { feed_type = ft; url; name }
38
+
| None -> failwith ("Invalid feed type: " ^ feed_type)
39
+
in
40
+
map ~kind:"Feed" make
41
+
|> mem "type" string ~enc:(fun f -> feed_type_to_string f.feed_type)
42
+
|> mem "url" string ~enc:(fun f -> f.url)
43
+
|> opt_mem "name" string ~enc:(fun f -> f.name)
44
+
|> finish
45
+
46
+
let pp ppf t =
47
+
let open Fmt in
48
+
pf ppf "%a: %a%a"
49
+
(styled (`Fg `Green) string) (feed_type_to_string t.feed_type)
50
+
(styled (`Fg `Blue) string) t.url
51
+
(option (fun ppf name -> pf ppf " (%a)" (styled `Faint string) name)) t.name
+43
lib/sortal_feed.mli
+43
lib/sortal_feed.mli
···
1
+
(** Feed subscription with type and URL.
2
+
3
+
A feed represents a subscription to a content source (Atom, RSS, or JSONFeed). *)
4
+
5
+
type t
6
+
7
+
(** Feed type identifier. *)
8
+
type feed_type =
9
+
| Atom (** Atom feed format *)
10
+
| Rss (** RSS feed format *)
11
+
| Json (** JSON Feed format *)
12
+
13
+
(** [make ~feed_type ~url ?name ()] creates a new feed.
14
+
15
+
@param feed_type The type of feed (Atom, RSS, or JSON)
16
+
@param url The feed URL
17
+
@param name Optional human-readable name/label for the feed *)
18
+
val make : feed_type:feed_type -> url:string -> ?name:string -> unit -> t
19
+
20
+
(** [feed_type t] returns the feed type. *)
21
+
val feed_type : t -> feed_type
22
+
23
+
(** [url t] returns the feed URL. *)
24
+
val url : t -> string
25
+
26
+
(** [name t] returns the feed name if set. *)
27
+
val name : t -> string option
28
+
29
+
(** [set_name t name] returns a new feed with the name updated. *)
30
+
val set_name : t -> string -> t
31
+
32
+
(** [feed_type_to_string ft] converts a feed type to a string. *)
33
+
val feed_type_to_string : feed_type -> string
34
+
35
+
(** [feed_type_of_string s] parses a feed type from a string.
36
+
Returns [None] if the string is not recognized. *)
37
+
val feed_type_of_string : string -> feed_type option
38
+
39
+
(** [json_t] is the jsont encoder/decoder for feeds. *)
40
+
val json_t : t Jsont.t
41
+
42
+
(** [pp ppf t] pretty prints a feed. *)
43
+
val pp : Format.formatter -> t -> unit
+126
lib/sortal_store.ml
+126
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 ^ ".json"))
17
+
18
+
let save t contact =
19
+
let path = contact_file t (Sortal_contact.handle contact) in
20
+
match Jsont_bytesrw.encode_string Sortal_contact.json_t contact with
21
+
| Ok json_str -> Eio.Path.save ~create:(`Or_truncate 0o644) path json_str
22
+
| Error err -> failwith ("Failed to encode contact: " ^ err)
23
+
24
+
let lookup t handle =
25
+
let path = contact_file t handle in
26
+
try
27
+
Eio.Path.load path
28
+
|> Jsont_bytesrw.decode_string Sortal_contact.json_t
29
+
|> Result.to_option
30
+
with _ -> None
31
+
32
+
let delete t handle =
33
+
let path = contact_file t handle in
34
+
try
35
+
Eio.Path.unlink path
36
+
with
37
+
| _ -> ()
38
+
39
+
let list t =
40
+
try
41
+
let entries = Eio.Path.read_dir t.data_dir in
42
+
List.filter_map (fun entry ->
43
+
if Filename.check_suffix entry ".json" then
44
+
let handle = Filename.chop_suffix entry ".json" in
45
+
lookup t handle
46
+
else
47
+
None
48
+
) entries
49
+
with
50
+
| _ -> []
51
+
52
+
let thumbnail_path t contact =
53
+
Sortal_contact.thumbnail contact
54
+
|> Option.map (fun relative_path -> Eio.Path.(t.data_dir / relative_path))
55
+
56
+
let png_thumbnail_path t contact =
57
+
match Sortal_contact.thumbnail contact with
58
+
| None -> None
59
+
| Some relative_path ->
60
+
let base = Filename.remove_extension relative_path in
61
+
let png_path = base ^ ".png" in
62
+
let full_path = Eio.Path.(t.data_dir / png_path) in
63
+
try
64
+
ignore (Eio.Path.load full_path);
65
+
Some full_path
66
+
with _ -> None
67
+
68
+
let handle_of_name name =
69
+
let name = String.lowercase_ascii name in
70
+
let words = String.split_on_char ' ' name in
71
+
let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in
72
+
initials ^ List.hd (List.rev words)
73
+
74
+
let find_by_name t name =
75
+
let name_lower = String.lowercase_ascii name in
76
+
let all_contacts = list t in
77
+
let matches = List.filter (fun c ->
78
+
List.exists (fun n -> String.lowercase_ascii n = name_lower)
79
+
(Sortal_contact.names c)
80
+
) all_contacts in
81
+
match matches with
82
+
| [contact] -> contact
83
+
| [] -> raise Not_found
84
+
| _ -> raise (Invalid_argument ("Multiple contacts match: " ^ name))
85
+
86
+
let find_by_name_opt t name =
87
+
try
88
+
Some (find_by_name t name)
89
+
with
90
+
| Not_found | Invalid_argument _ -> None
91
+
92
+
let contains_substring ~needle haystack =
93
+
let needle_len = String.length needle in
94
+
let haystack_len = String.length haystack in
95
+
if needle_len = 0 then true
96
+
else if needle_len > haystack_len then false
97
+
else
98
+
let rec check i =
99
+
if i > haystack_len - needle_len then false
100
+
else if String.sub haystack i needle_len = needle then true
101
+
else check (i + 1)
102
+
in
103
+
check 0
104
+
105
+
let search_all t query =
106
+
let query_lower = String.lowercase_ascii query in
107
+
let all = list t in
108
+
let matches = List.filter (fun c ->
109
+
List.exists (fun name ->
110
+
let name_lower = String.lowercase_ascii name in
111
+
String.equal name_lower query_lower ||
112
+
String.starts_with ~prefix:query_lower name_lower ||
113
+
contains_substring ~needle:query_lower name_lower ||
114
+
(String.contains name_lower ' ' &&
115
+
String.split_on_char ' ' name_lower |> List.exists (fun word ->
116
+
String.starts_with ~prefix:query_lower word
117
+
))
118
+
) (Sortal_contact.names c)
119
+
) all in
120
+
List.sort Sortal_contact.compare matches
121
+
122
+
let pp ppf t =
123
+
let all = list t in
124
+
Fmt.pf ppf "@[<v>%a: %d contacts stored in XDG data directory@]"
125
+
(Fmt.styled `Bold Fmt.string) "Sortal Store"
126
+
(List.length all)
+134
lib/sortal_store.mli
+134
lib/sortal_store.mli
···
1
+
(** Contact store with XDG-compliant storage.
2
+
3
+
The contact store manages reading and writing contact metadata
4
+
using XDG-compliant storage locations. *)
5
+
6
+
type t
7
+
8
+
(** [create fs app_name] creates a new contact store.
9
+
10
+
The store will use XDG data directories for persistent storage
11
+
of contact metadata. Each contact is stored as a separate JSON
12
+
file named after its handle.
13
+
14
+
@param fs Eio filesystem for file operations
15
+
@param app_name Application name for XDG directory structure *)
16
+
val create : Eio.Fs.dir_ty Eio.Path.t -> string -> t
17
+
18
+
(** [create_from_xdg xdg] creates a contact store from an XDG context.
19
+
20
+
This is a convenience function for creating a store when you already
21
+
have an XDG context (e.g., from your own XDG initialization).
22
+
The store will use the XDG data directory for the application.
23
+
24
+
@param xdg An existing XDG context
25
+
@return A contact store using the XDG data directory *)
26
+
val create_from_xdg : Xdge.t -> t
27
+
28
+
(** {1 Storage Operations} *)
29
+
30
+
(** [save t contact] saves a contact to the store.
31
+
32
+
The contact is serialized to JSON and written to a file
33
+
named "handle.json" in the XDG data directory.
34
+
35
+
If a contact with the same handle already exists, it is overwritten. *)
36
+
val save : t -> Sortal_contact.t -> unit
37
+
38
+
(** [lookup t handle] retrieves a contact by handle.
39
+
40
+
Searches for a file named "handle.json" in the XDG data directory
41
+
and deserializes it if found.
42
+
43
+
@return [Some contact] if found, [None] if not found or deserialization fails *)
44
+
val lookup : t -> string -> Sortal_contact.t option
45
+
46
+
(** [delete t handle] removes a contact from the store.
47
+
48
+
Deletes the file "handle.json" from the XDG data directory.
49
+
Does nothing if the contact does not exist. *)
50
+
val delete : t -> string -> unit
51
+
52
+
(** [list t] returns all contacts in the store.
53
+
54
+
Scans the XDG data directory for all .json files and attempts
55
+
to deserialize them as contacts. Files that fail to parse are
56
+
silently skipped.
57
+
58
+
@return A list of all successfully loaded contacts *)
59
+
val list : t -> Sortal_contact.t list
60
+
61
+
(** [thumbnail_path t contact] returns the absolute filesystem path to the contact's thumbnail.
62
+
63
+
Returns [None] if the contact has no thumbnail set, or [Some path] with
64
+
the full path to the thumbnail file in Sortal's data directory.
65
+
66
+
@param t The Sortal store
67
+
@param contact The contact whose thumbnail path to retrieve *)
68
+
val thumbnail_path : t -> Sortal_contact.t -> Eio.Fs.dir_ty Eio.Path.t option
69
+
70
+
(** [png_thumbnail_path t contact] returns the path to the PNG version of the contact's thumbnail.
71
+
72
+
Returns [None] if the contact has no thumbnail set or if no PNG version exists.
73
+
This looks for a .png file with the same base name as the contact's thumbnail.
74
+
Use this after running [sync] to get the converted PNG thumbnails.
75
+
76
+
@param t The Sortal store
77
+
@param contact The contact whose PNG thumbnail path to retrieve *)
78
+
val png_thumbnail_path : t -> Sortal_contact.t -> Eio.Fs.dir_ty Eio.Path.t option
79
+
80
+
(** {1 Searching} *)
81
+
82
+
(** [find_by_name t name] searches for contacts by name.
83
+
84
+
Performs a case-insensitive search through all contacts,
85
+
checking if any of their names match the provided name.
86
+
87
+
@param name The name to search for (case-insensitive)
88
+
@return The matching contact if exactly one match is found
89
+
@raise Not_found if no contacts match the name
90
+
@raise Invalid_argument if multiple contacts match the name *)
91
+
val find_by_name : t -> string -> Sortal_contact.t
92
+
93
+
(** [find_by_name_opt t name] searches for contacts by name, returning an option.
94
+
95
+
Like {!find_by_name} but returns [None] instead of raising exceptions
96
+
when no match or multiple matches are found.
97
+
98
+
@param name The name to search for (case-insensitive)
99
+
@return [Some contact] if exactly one match is found, [None] otherwise *)
100
+
val find_by_name_opt : t -> string -> Sortal_contact.t option
101
+
102
+
(** [search_all t query] searches for contacts matching a query string.
103
+
104
+
Performs a flexible search through all contact names, looking for:
105
+
- Exact matches (case-insensitive)
106
+
- Names that start with the query
107
+
- Multi-word names where any word starts with the query
108
+
109
+
This is useful for autocomplete or fuzzy search functionality.
110
+
111
+
@param t The contact store
112
+
@param query The search query (case-insensitive)
113
+
@return A list of matching contacts, sorted by handle *)
114
+
val search_all : t -> string -> Sortal_contact.t list
115
+
116
+
(** {1 Utilities} *)
117
+
118
+
(** [handle_of_name name] generates a handle from a full name.
119
+
120
+
Creates a handle by concatenating the initials of all words
121
+
in the name with the full last name, all in lowercase.
122
+
123
+
Examples:
124
+
- "Anil Madhavapeddy" -> "ammadhavapeddy"
125
+
- "John Smith" -> "jssmith"
126
+
127
+
@param name The full name to convert
128
+
@return A suggested handle *)
129
+
val handle_of_name : string -> string
130
+
131
+
(** {1 Pretty Printing} *)
132
+
133
+
(** [pp ppf t] pretty prints the contact store showing statistics. *)
134
+
val pp : Format.formatter -> t -> unit
+3
test/dune
+3
test/dune
+207
test/test_sortal.ml
+207
test/test_sortal.ml
···
1
+
(** Tests for the Sortal library *)
2
+
3
+
open Eio.Std
4
+
5
+
let test_contact_creation () =
6
+
let c = Sortal.Contact.make
7
+
~handle:"test"
8
+
~names:["Test User"; "T. User"]
9
+
~email:"test@example.com"
10
+
~github:"testuser"
11
+
() in
12
+
assert (Sortal.Contact.handle c = "test");
13
+
assert (Sortal.Contact.name c = "Test User");
14
+
assert (List.length (Sortal.Contact.names c) = 2);
15
+
assert (Sortal.Contact.email c = Some "test@example.com");
16
+
assert (Sortal.Contact.github c = Some "testuser");
17
+
assert (Sortal.Contact.twitter c = None);
18
+
traceln "✓ Contact creation works"
19
+
20
+
let test_best_url () =
21
+
let c1 = Sortal.Contact.make
22
+
~handle:"test1"
23
+
~names:["Test 1"]
24
+
~url:"https://example.com"
25
+
~github:"test1"
26
+
() in
27
+
assert (Sortal.Contact.best_url c1 = Some "https://example.com");
28
+
29
+
let c2 = Sortal.Contact.make
30
+
~handle:"test2"
31
+
~names:["Test 2"]
32
+
~github:"test2"
33
+
() in
34
+
assert (Sortal.Contact.best_url c2 = Some "https://github.com/test2");
35
+
36
+
let c3 = Sortal.Contact.make
37
+
~handle:"test3"
38
+
~names:["Test 3"]
39
+
~email:"test3@example.com"
40
+
() in
41
+
assert (Sortal.Contact.best_url c3 = Some "mailto:test3@example.com");
42
+
43
+
let c4 = Sortal.Contact.make
44
+
~handle:"test4"
45
+
~names:["Test 4"]
46
+
() in
47
+
assert (Sortal.Contact.best_url c4 = None);
48
+
49
+
traceln "✓ Best URL selection works"
50
+
51
+
let test_json_encoding () =
52
+
let c = Sortal.Contact.make
53
+
~handle:"json_test"
54
+
~names:["JSON Test"]
55
+
~email:"json@example.com"
56
+
~github:"jsontest"
57
+
~orcid:"0000-0001-2345-6789"
58
+
() in
59
+
60
+
match Jsont_bytesrw.encode_string Sortal.Contact.json_t c with
61
+
| Ok json_str ->
62
+
(match Jsont_bytesrw.decode_string Sortal.Contact.json_t json_str with
63
+
| Ok decoded ->
64
+
assert (Sortal.Contact.handle decoded = "json_test");
65
+
assert (Sortal.Contact.email decoded = Some "json@example.com");
66
+
assert (Sortal.Contact.github decoded = Some "jsontest");
67
+
assert (Sortal.Contact.orcid decoded = Some "0000-0001-2345-6789");
68
+
traceln "✓ JSON encoding/decoding works"
69
+
| Error err ->
70
+
failwith ("JSON decode failed: " ^ err))
71
+
| Error err ->
72
+
failwith ("JSON encode failed: " ^ err)
73
+
74
+
let test_handle_generation () =
75
+
assert (Sortal.handle_of_name "John Smith" = "jssmith");
76
+
assert (Sortal.handle_of_name "Alice Barbara Cooper" = "abccooper");
77
+
assert (Sortal.handle_of_name "Bob" = "bbob");
78
+
traceln "✓ Handle generation works"
79
+
80
+
let test_store_operations () =
81
+
Eio_main.run @@ fun env ->
82
+
83
+
(* Create a store with a test app name *)
84
+
let store = Sortal.create env#fs "sortal-test" in
85
+
86
+
(* Create test contacts *)
87
+
let c1 = Sortal.Contact.make
88
+
~handle:"alice"
89
+
~names:["Alice Anderson"]
90
+
~email:"alice@example.com"
91
+
() in
92
+
93
+
let c2 = Sortal.Contact.make
94
+
~handle:"bob"
95
+
~names:["Bob Brown"; "Robert Brown"]
96
+
~github:"bobbrown"
97
+
() in
98
+
99
+
(* Test save *)
100
+
Sortal.save store c1;
101
+
Sortal.save store c2;
102
+
traceln "✓ Saving contacts works";
103
+
104
+
(* Test lookup *)
105
+
(match Sortal.lookup store "alice" with
106
+
| Some c ->
107
+
assert (Sortal.Contact.name c = "Alice Anderson");
108
+
traceln "✓ Lookup works"
109
+
| None -> failwith "Lookup failed to find saved contact");
110
+
111
+
(* Test lookup of non-existent contact *)
112
+
(match Sortal.lookup store "nonexistent" with
113
+
| None -> traceln "✓ Lookup correctly returns None for missing contact"
114
+
| Some _ -> failwith "Lookup should return None for non-existent contact");
115
+
116
+
(* Test list *)
117
+
let all = Sortal.list store in
118
+
assert (List.length all >= 2);
119
+
traceln "✓ List returns saved contacts (%d total)" (List.length all);
120
+
121
+
(* Test find_by_name *)
122
+
let found = Sortal.find_by_name store "Bob Brown" in
123
+
assert (Sortal.Contact.handle found = "bob");
124
+
traceln "✓ Find by name works";
125
+
126
+
(* Test find_by_name_opt *)
127
+
(match Sortal.find_by_name_opt store "Alice Anderson" with
128
+
| Some c ->
129
+
assert (Sortal.Contact.handle c = "alice");
130
+
traceln "✓ Find by name (optional) works"
131
+
| None -> failwith "find_by_name_opt failed");
132
+
133
+
(match Sortal.find_by_name_opt store "Nobody" with
134
+
| None -> traceln "✓ Find by name (optional) returns None for missing"
135
+
| Some _ -> failwith "find_by_name_opt should return None");
136
+
137
+
(* Test delete *)
138
+
Sortal.delete store "alice";
139
+
(match Sortal.lookup store "alice" with
140
+
| None -> traceln "✓ Delete works"
141
+
| Some _ -> failwith "Contact should have been deleted");
142
+
143
+
(* Clean up remaining test contact *)
144
+
Sortal.delete store "bob";
145
+
traceln "✓ Test cleanup complete"
146
+
147
+
let test_contact_compare () =
148
+
let c1 = Sortal.Contact.make ~handle:"alice" ~names:["Alice"] () in
149
+
let c2 = Sortal.Contact.make ~handle:"bob" ~names:["Bob"] () in
150
+
let c3 = Sortal.Contact.make ~handle:"alice" ~names:["Alice2"] () in
151
+
152
+
assert (Sortal.Contact.compare c1 c2 < 0);
153
+
assert (Sortal.Contact.compare c2 c1 > 0);
154
+
assert (Sortal.Contact.compare c1 c3 = 0);
155
+
traceln "✓ Contact comparison works"
156
+
157
+
let test_urls () =
158
+
(* Test with only url set *)
159
+
let c1 = Sortal.Contact.make
160
+
~handle:"test1"
161
+
~names:["Test 1"]
162
+
~url:"https://example.com"
163
+
() in
164
+
assert (Sortal.Contact.url c1 = Some "https://example.com");
165
+
assert (Sortal.Contact.urls c1 = ["https://example.com"]);
166
+
167
+
(* Test with only urls set *)
168
+
let c2 = Sortal.Contact.make
169
+
~handle:"test2"
170
+
~names:["Test 2"]
171
+
~urls:["https://one.com"; "https://two.com"]
172
+
() in
173
+
assert (Sortal.Contact.url c2 = Some "https://one.com");
174
+
assert (Sortal.Contact.urls c2 = ["https://one.com"; "https://two.com"]);
175
+
176
+
(* Test with both url and urls set *)
177
+
let c3 = Sortal.Contact.make
178
+
~handle:"test3"
179
+
~names:["Test 3"]
180
+
~url:"https://primary.com"
181
+
~urls:["https://secondary.com"; "https://tertiary.com"]
182
+
() in
183
+
assert (Sortal.Contact.url c3 = Some "https://primary.com");
184
+
assert (Sortal.Contact.urls c3 = ["https://primary.com"; "https://secondary.com"; "https://tertiary.com"]);
185
+
186
+
(* Test with neither set *)
187
+
let c4 = Sortal.Contact.make
188
+
~handle:"test4"
189
+
~names:["Test 4"]
190
+
() in
191
+
assert (Sortal.Contact.url c4 = None);
192
+
assert (Sortal.Contact.urls c4 = []);
193
+
194
+
traceln "✓ URLs field works correctly"
195
+
196
+
let () =
197
+
traceln "\n=== Running Sortal Tests ===\n";
198
+
199
+
test_contact_creation ();
200
+
test_best_url ();
201
+
test_json_encoding ();
202
+
test_handle_generation ();
203
+
test_contact_compare ();
204
+
test_urls ();
205
+
test_store_operations ();
206
+
207
+
traceln "\n=== All Tests Passed ===\n"