My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1module Feed = struct
2 type feed_type =
3 | Atom
4 | Rss
5 | Json
6
7 type t = {
8 feed_type : feed_type;
9 url : string;
10 name : string option;
11 }
12
13 let make ~feed_type ~url ?name () =
14 { feed_type; url; name }
15
16 let feed_type t = t.feed_type
17 let url t = t.url
18 let name t = t.name
19
20 let set_name t name = { t with name = Some name }
21
22 let feed_type_to_string = function
23 | Atom -> "atom"
24 | Rss -> "rss"
25 | Json -> "json"
26
27 let feed_type_of_string = function
28 | "atom" -> Some Atom
29 | "rss" -> Some Rss
30 | "json" -> Some Json
31 | _ -> None
32
33 let json_t =
34 let open Jsont in
35 let open Jsont.Object in
36 let make feed_type url name =
37 match feed_type_of_string feed_type with
38 | Some ft -> { feed_type = ft; url; name }
39 | None -> failwith ("Invalid feed type: " ^ feed_type)
40 in
41 map ~kind:"Feed" make
42 |> mem "type" string ~enc:(fun f -> feed_type_to_string f.feed_type)
43 |> mem "url" string ~enc:(fun f -> f.url)
44 |> opt_mem "name" string ~enc:(fun f -> f.name)
45 |> finish
46
47 let pp ppf t =
48 let open Fmt in
49 pf ppf "%s: %s%a"
50 (feed_type_to_string t.feed_type)
51 t.url
52 (option (fun ppf name -> pf ppf " (%s)" name)) t.name
53end
54
55module Contact = struct
56 type t = {
57 handle : string;
58 names : string list;
59 email : string option;
60 icon : string option;
61 thumbnail : string option;
62 github : string option;
63 twitter : string option;
64 bluesky : string option;
65 mastodon : string option;
66 orcid : string option;
67 url_ : string option;
68 urls_ : string list option;
69 feeds : Feed.t list option;
70 }
71
72 let make ~handle ~names ?email ?icon ?thumbnail ?github ?twitter ?bluesky ?mastodon
73 ?orcid ?url ?urls ?feeds () =
74 { handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
75 orcid; url_ = url; urls_ = urls; feeds }
76
77 let handle t = t.handle
78 let names t = t.names
79 let name t = List.hd t.names
80 let primary_name = name
81 let email t = t.email
82 let icon t = t.icon
83 let thumbnail t = t.thumbnail
84 let github t = t.github
85 let twitter t = t.twitter
86 let bluesky t = t.bluesky
87 let mastodon t = t.mastodon
88 let orcid t = t.orcid
89
90 let url t =
91 match t.url_ with
92 | Some _ as u -> u
93 | None ->
94 match t.urls_ with
95 | Some (first :: _) -> Some first
96 | _ -> None
97
98 let urls t =
99 match t.url_, t.urls_ with
100 | Some u, Some us -> u :: us
101 | Some u, None -> [u]
102 | None, Some us -> us
103 | None, None -> []
104
105 let feeds t = t.feeds
106
107 let add_feed t feed =
108 let feeds = match t.feeds with
109 | Some fs -> Some (feed :: fs)
110 | None -> Some [feed]
111 in
112 { t with feeds }
113
114 let remove_feed t url =
115 let feeds = match t.feeds with
116 | Some fs -> Some (List.filter (fun f -> Feed.url f <> url) fs)
117 | None -> None
118 in
119 { t with feeds }
120
121 let best_url t =
122 match url t with
123 | Some v -> Some v
124 | None ->
125 (match t.github with
126 | Some v -> Some ("https://github.com/" ^ v)
127 | None ->
128 (match t.email with
129 | Some v -> Some ("mailto:" ^ v)
130 | None -> None))
131
132 let json_t =
133 let open Jsont in
134 let open Jsont.Object in
135 let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
136 let make handle names email icon thumbnail github twitter bluesky mastodon orcid url urls feeds =
137 { handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
138 orcid; url_ = url; urls_ = urls; feeds }
139 in
140 map ~kind:"Contact" make
141 |> mem "handle" string ~enc:handle
142 |> mem "names" (list string) ~dec_absent:[] ~enc:names
143 |> mem_opt "email" (some string) ~enc:email
144 |> mem_opt "icon" (some string) ~enc:icon
145 |> mem_opt "thumbnail" (some string) ~enc:thumbnail
146 |> mem_opt "github" (some string) ~enc:github
147 |> mem_opt "twitter" (some string) ~enc:twitter
148 |> mem_opt "bluesky" (some string) ~enc:bluesky
149 |> mem_opt "mastodon" (some string) ~enc:mastodon
150 |> mem_opt "orcid" (some string) ~enc:orcid
151 |> mem_opt "url" (some string) ~enc:(fun t -> t.url_)
152 |> mem_opt "urls" (some (list string)) ~enc:(fun t -> t.urls_)
153 |> mem_opt "feeds" (some (list Feed.json_t)) ~enc:feeds
154 |> finish
155
156 let compare a b = String.compare a.handle b.handle
157
158 let pp ppf t =
159 let open Fmt in
160 pf ppf "@[<v>";
161 pf ppf "%a: @%a@," (styled `Bold string) "Handle" string t.handle;
162 pf ppf "%a: %a@," (styled `Bold string) "Name" string (name t);
163 let ns = names t in
164 if List.length ns > 1 then
165 pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Aliases"
166 (list ~sep:comma string) (List.tl ns);
167 (match t.email with
168 | Some e -> pf ppf "%a: %a@," (styled `Bold string) "Email" string e
169 | None -> ());
170 (match t.github with
171 | Some g -> pf ppf "%a: https://github.com/%a@,"
172 (styled `Bold string) "GitHub" string g
173 | None -> ());
174 (match t.twitter with
175 | Some tw -> pf ppf "%a: https://twitter.com/%a@,"
176 (styled `Bold string) "Twitter" string tw
177 | None -> ());
178 (match t.bluesky with
179 | Some b -> pf ppf "%a: %a@," (styled `Bold string) "Bluesky" string b
180 | None -> ());
181 (match t.mastodon with
182 | Some m -> pf ppf "%a: %a@," (styled `Bold string) "Mastodon" string m
183 | None -> ());
184 (match t.orcid with
185 | Some o -> pf ppf "%a: https://orcid.org/%a@,"
186 (styled `Bold string) "ORCID" string o
187 | None -> ());
188 (let all_urls = urls t in
189 match all_urls with
190 | [] -> ()
191 | [u] -> pf ppf "%a: %a@," (styled `Bold string) "URL" string u
192 | _ ->
193 pf ppf "%a:@," (styled `Bold string) "URLs";
194 List.iter (fun u -> pf ppf " - %s@," u) all_urls);
195 (match t.icon with
196 | Some i -> pf ppf "%a: %a@," (styled `Bold string) "Icon" string i
197 | None -> ());
198 (match t.thumbnail with
199 | Some th -> pf ppf "%a: %a@," (styled `Bold string) "Thumbnail" string th
200 | None -> ());
201 (match t.feeds with
202 | Some feeds when feeds <> [] ->
203 pf ppf "%a:@," (styled `Bold string) "Feeds";
204 List.iter (fun feed ->
205 pf ppf " - %a@," Feed.pp feed
206 ) feeds
207 | _ -> ());
208 pf ppf "@]"
209end
210
211type t = {
212 xdg : Xdge.t; [@warning "-69"]
213 data_dir : Eio.Fs.dir_ty Eio.Path.t;
214}
215
216let create fs app_name =
217 let xdg = Xdge.create fs app_name in
218 let data_dir = Xdge.data_dir xdg in
219 { xdg; data_dir }
220
221let contact_file t handle =
222 Eio.Path.(t.data_dir / (handle ^ ".json"))
223
224let save t contact =
225 let path = contact_file t (Contact.handle contact) in
226 match Jsont_bytesrw.encode_string Contact.json_t contact with
227 | Ok json_str -> Eio.Path.save ~create:(`Or_truncate 0o644) path json_str
228 | Error err -> failwith ("Failed to encode contact: " ^ err)
229
230let lookup t handle =
231 let path = contact_file t handle in
232 try
233 let content = Eio.Path.load path in
234 match Jsont_bytesrw.decode_string Contact.json_t content with
235 | Ok contact -> Some contact
236 | Error _ -> None
237 with
238 | _ -> None
239
240let delete t handle =
241 let path = contact_file t handle in
242 try
243 Eio.Path.unlink path
244 with
245 | _ -> ()
246
247let list t =
248 try
249 let entries = Eio.Path.read_dir t.data_dir in
250 List.filter_map (fun entry ->
251 if Filename.check_suffix entry ".json" then
252 let handle = Filename.chop_suffix entry ".json" in
253 lookup t handle
254 else
255 None
256 ) entries
257 with
258 | _ -> []
259
260let thumbnail_path t contact =
261 match Contact.thumbnail contact with
262 | None -> None
263 | Some relative_path ->
264 Some Eio.Path.(t.data_dir / relative_path)
265
266let handle_of_name name =
267 let name = String.lowercase_ascii name in
268 let words = String.split_on_char ' ' name in
269 let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in
270 initials ^ List.hd (List.rev words)
271
272let find_by_name t name =
273 let name_lower = String.lowercase_ascii name in
274 let all_contacts = list t in
275 let matches = List.filter (fun c ->
276 List.exists (fun n -> String.lowercase_ascii n = name_lower)
277 (Contact.names c)
278 ) all_contacts in
279 match matches with
280 | [contact] -> contact
281 | [] -> raise Not_found
282 | _ -> raise (Invalid_argument ("Multiple contacts match: " ^ name))
283
284let find_by_name_opt t name =
285 try
286 Some (find_by_name t name)
287 with
288 | Not_found | Invalid_argument _ -> None
289
290(* Convenience functions *)
291let create_from_xdg xdg =
292 let data_dir = Xdge.data_dir xdg in
293 { xdg; data_dir }
294
295let search_all t query =
296 let query_lower = String.lowercase_ascii query in
297 let all = list t in
298 let matches = List.filter (fun c ->
299 List.exists (fun name ->
300 let name_lower = String.lowercase_ascii name in
301 (* Check for exact match *)
302 String.equal name_lower query_lower ||
303 (* Check if name starts with query *)
304 String.starts_with ~prefix:query_lower name_lower ||
305 (* For multi-word names, check if any word starts with query *)
306 (String.contains name_lower ' ' &&
307 String.split_on_char ' ' name_lower |> List.exists (fun word ->
308 String.starts_with ~prefix:query_lower word
309 ))
310 ) (Contact.names c)
311 ) all in
312 List.sort Contact.compare matches
313
314let pp ppf t =
315 let all = list t in
316 Fmt.pf ppf "@[<v>%a: %d contacts stored in XDG data directory@]"
317 (Fmt.styled `Bold Fmt.string) "Sortal Store"
318 (List.length all)
319
320(* Cmdliner integration *)
321module Cmd = struct
322 open Cmdliner
323
324 (* Command implementations *)
325 let list_cmd () _env xdg _profile =
326 let store = create_from_xdg xdg in
327 let contacts = list store in
328 let sorted = List.sort Contact.compare contacts in
329
330 Logs.app (fun m -> m "Total contacts: %d" (List.length sorted));
331 List.iter (fun c ->
332 Logs.app (fun m -> m "@%s: %s"
333 (Contact.handle c)
334 (Contact.name c))
335 ) sorted;
336 0
337
338 let show_cmd handle _env xdg _profile =
339 let store = create_from_xdg xdg in
340 match lookup store handle with
341 | Some c ->
342 Format.printf "%a@." Contact.pp c;
343 0
344 | None ->
345 Logs.err (fun m -> m "Contact not found: %s" handle);
346 1
347
348 let search_cmd query _env xdg _profile =
349 let store = create_from_xdg xdg in
350 let matches = search_all store query in
351
352 if matches = [] then (
353 Logs.warn (fun m -> m "No contacts found matching: %s" query);
354 1
355 ) else (
356 Logs.app (fun m -> m "Found %d match%s:"
357 (List.length matches)
358 (if List.length matches = 1 then "" else "es"));
359 List.iter (fun c ->
360 Logs.app (fun m -> m "@%s: %s"
361 (Contact.handle c)
362 (Contact.name c));
363
364 (* Show additional details *)
365 (match Contact.email c with
366 | Some e -> Logs.app (fun m -> m " Email: %s" e)
367 | None -> ());
368 (match Contact.github c with
369 | Some g -> Logs.app (fun m -> m " GitHub: @%s" g)
370 | None -> ());
371 (match Contact.best_url c with
372 | Some u -> Logs.app (fun m -> m " URL: %s" u)
373 | None -> ())
374 ) matches;
375 0
376 )
377
378 let stats_cmd () _env xdg _profile =
379 let store = create_from_xdg xdg in
380 let contacts = list store in
381
382 let total = List.length contacts in
383 let with_email = List.filter (fun c -> Contact.email c <> None) contacts |> List.length in
384 let with_github = List.filter (fun c -> Contact.github c <> None) contacts |> List.length in
385 let with_orcid = List.filter (fun c -> Contact.orcid c <> None) contacts |> List.length in
386 let with_url = List.filter (fun c -> Contact.url c <> None) contacts |> List.length in
387 let with_feeds = List.filter (fun c -> Contact.feeds c <> None) contacts |> List.length in
388 let total_feeds = List.fold_left (fun acc c ->
389 match Contact.feeds c with
390 | Some feeds -> acc + List.length feeds
391 | None -> acc
392 ) 0 contacts in
393
394 Logs.app (fun m -> m "Contact Database Statistics:");
395 Logs.app (fun m -> m " Total contacts: %d" total);
396 Logs.app (fun m -> m " With email: %d (%.1f%%)" with_email (float_of_int with_email /. float_of_int total *. 100.));
397 Logs.app (fun m -> m " With GitHub: %d (%.1f%%)" with_github (float_of_int with_github /. float_of_int total *. 100.));
398 Logs.app (fun m -> m " With ORCID: %d (%.1f%%)" with_orcid (float_of_int with_orcid /. float_of_int total *. 100.));
399 Logs.app (fun m -> m " With URL: %d (%.1f%%)" with_url (float_of_int with_url /. float_of_int total *. 100.));
400 Logs.app (fun m -> m " With feeds: %d (%.1f%%), total %d feeds" with_feeds (float_of_int with_feeds /. float_of_int total *. 100.) total_feeds);
401 0
402
403 (* Command info objects *)
404 let list_info = Cmd.info "list" ~doc:"List all contacts"
405
406 let show_info = Cmd.info "show" ~doc:"Show detailed information about a contact"
407
408 let search_info = Cmd.info "search" ~doc:"Search contacts by name"
409
410 let stats_info = Cmd.info "stats" ~doc:"Show statistics about the contact database"
411
412 (* Argument definitions *)
413 let handle_arg =
414 Arg.(required & pos 0 (some string) None & info [] ~docv:"HANDLE"
415 ~doc:"Contact handle to display")
416
417 let query_arg =
418 Arg.(required & pos 0 (some string) None & info [] ~docv:"QUERY"
419 ~doc:"Name or partial name to search for")
420end