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