My aggregated monorepo of OCaml code, automaintained
Replace bushel contacts with sortal
- Remove bushel_contact.ml, use Sortal_schema.Contact directly
- Add typed service_kind variants: ActivityPub (with Mastodon/Pixelfed/PeerTube),
Bluesky, Github, Git, Twitter, Photo, Custom
- Add convenience accessors: github_handle, twitter_handle, mastodon_handle,
bluesky_handle
- Add find_by_handle and lookup_by_name to Sortal_store
- Update bushel_loader to load contacts from Sortal XDG store
- Fix sortal sync to skip PNG conversion when PNG already exists
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+229
-221
-4
ocaml-bushel/lib/bushel.ml
-4
ocaml-bushel/lib/bushel.ml
···
12
12
13
13
{1 Entry Types}
14
14
15
-
- {!Contact} - People/researchers with social links
16
15
- {!Note} - Blog posts and research notes
17
16
- {!Paper} - Academic papers with BibTeX metadata
18
17
- {!Project} - Research projects
···
44
43
*)
45
44
46
45
(** {1 Entry Types} *)
47
-
48
-
module Contact = Bushel_contact
49
-
(** Contact/person entries. *)
50
46
51
47
module Note = Bushel_note
52
48
(** Blog post and research note entries. *)
-154
ocaml-bushel/lib/bushel_contact.ml
-154
ocaml-bushel/lib/bushel_contact.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** Contact/person entry type for Bushel *)
7
-
8
-
type t = {
9
-
names : string list;
10
-
handle : string;
11
-
email : string option;
12
-
icon : string option;
13
-
github : string option;
14
-
twitter : string option;
15
-
bluesky : string option;
16
-
mastodon : string option;
17
-
orcid : string option;
18
-
url : string option;
19
-
atom : string list option;
20
-
}
21
-
22
-
type ts = t list
23
-
24
-
(** {1 Constructors} *)
25
-
26
-
let v ?email ?github ?twitter ?bluesky ?mastodon ?orcid ?icon ?url ?atom handle names =
27
-
{ names; handle; email; github; twitter; bluesky; mastodon; orcid; url; icon; atom }
28
-
29
-
let make names email icon github twitter bluesky mastodon orcid url atom =
30
-
v ?email ?github ?twitter ?bluesky ?mastodon ?orcid ?icon ?url ?atom "" names
31
-
32
-
(** {1 Accessors} *)
33
-
34
-
let names { names; _ } = names
35
-
36
-
let name c =
37
-
match c.names with
38
-
| n :: _ -> n
39
-
| [] -> failwith (Printf.sprintf "Contact with handle '%s' has empty names list" c.handle)
40
-
41
-
let handle { handle; _ } = handle
42
-
let email { email; _ } = email
43
-
let icon { icon; _ } = icon
44
-
let github { github; _ } = github
45
-
let twitter { twitter; _ } = twitter
46
-
let bluesky { bluesky; _ } = bluesky
47
-
let mastodon { mastodon; _ } = mastodon
48
-
let orcid { orcid; _ } = orcid
49
-
let url { url; _ } = url
50
-
let atom { atom; _ } = atom
51
-
52
-
(** {1 Jsont Codec} *)
53
-
54
-
let jsont : t Jsont.t =
55
-
let open Jsont in
56
-
let open Jsont.Object in
57
-
let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
58
-
map ~kind:"Contact" make
59
-
|> mem "names" (list string) ~dec_absent:[] ~enc:names
60
-
|> mem_opt "email" (some string) ~enc:email
61
-
|> mem_opt "icon" (some string) ~enc:icon
62
-
|> mem_opt "github" (some string) ~enc:github
63
-
|> mem_opt "twitter" (some string) ~enc:twitter
64
-
|> mem_opt "bluesky" (some string) ~enc:bluesky
65
-
|> mem_opt "mastodon" (some string) ~enc:mastodon
66
-
|> mem_opt "orcid" (some string) ~enc:orcid
67
-
|> mem_opt "url" (some string) ~enc:url
68
-
|> mem_opt "atom" (some (list string)) ~enc:atom
69
-
|> finish
70
-
71
-
(** {1 Parsing} *)
72
-
73
-
let of_frontmatter ~handle (fm : Frontmatter.t) : (t, string) result =
74
-
match Frontmatter.decode jsont fm with
75
-
| Ok c -> Ok { c with handle }
76
-
| Error e -> Error e
77
-
78
-
(** {1 Lookup Functions} *)
79
-
80
-
let compare a b = String.compare a.handle b.handle
81
-
82
-
let find_by_handle ts h = List.find_opt (fun { handle; _ } -> handle = h) ts
83
-
84
-
let best_url c =
85
-
match c.url with
86
-
| Some _ as url -> url
87
-
| None ->
88
-
match c.github with
89
-
| Some g -> Some ("https://github.com/" ^ g)
90
-
| None -> Option.map (fun e -> "mailto:" ^ e) c.email
91
-
92
-
(** Given a name, turn it lowercase and return the concatenation of the
93
-
initials of all the words in the name and the full last name. *)
94
-
let handle_of_name name =
95
-
let name = String.lowercase_ascii name in
96
-
let words = String.split_on_char ' ' name in
97
-
let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in
98
-
initials ^ List.hd (List.rev words)
99
-
100
-
(** Fuzzy lookup for an author by name. *)
101
-
let lookup_by_name ts a =
102
-
let a = String.lowercase_ascii a in
103
-
let rec aux acc = function
104
-
| [] -> acc
105
-
| t :: ts ->
106
-
if List.exists (fun n -> String.lowercase_ascii n = a) t.names
107
-
then aux (t :: acc) ts
108
-
else aux acc ts
109
-
in
110
-
match aux [] ts with
111
-
| [ a ] -> a
112
-
| [] -> raise (Failure ("Contact not found: " ^ a))
113
-
| _ -> raise (Failure ("Ambiguous contact: " ^ a))
114
-
115
-
(** {1 Pretty Printing} *)
116
-
117
-
let pp ppf c =
118
-
let open Fmt in
119
-
pf ppf "@[<v>";
120
-
pf ppf "%a: %a@," (styled `Bold string) "Type" (styled `Cyan string) "Contact";
121
-
pf ppf "%a: @%a@," (styled `Bold string) "Handle" string (handle c);
122
-
pf ppf "%a: %a@," (styled `Bold string) "Name" string (name c);
123
-
let ns = names c in
124
-
if List.length ns > 1 then
125
-
pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Aliases" (list ~sep:comma string) (List.tl ns);
126
-
(match email c with
127
-
| Some e -> pf ppf "%a: %a@," (styled `Bold string) "Email" string e
128
-
| None -> ());
129
-
(match github c with
130
-
| Some g -> pf ppf "%a: https://github.com/%a@," (styled `Bold string) "GitHub" string g
131
-
| None -> ());
132
-
(match twitter c with
133
-
| Some t -> pf ppf "%a: https://twitter.com/%a@," (styled `Bold string) "Twitter" string t
134
-
| None -> ());
135
-
(match bluesky c with
136
-
| Some b -> pf ppf "%a: %a@," (styled `Bold string) "Bluesky" string b
137
-
| None -> ());
138
-
(match mastodon c with
139
-
| Some m -> pf ppf "%a: %a@," (styled `Bold string) "Mastodon" string m
140
-
| None -> ());
141
-
(match orcid c with
142
-
| Some o -> pf ppf "%a: https://orcid.org/%a@," (styled `Bold string) "ORCID" string o
143
-
| None -> ());
144
-
(match url c with
145
-
| Some u -> pf ppf "%a: %a@," (styled `Bold string) "URL" string u
146
-
| None -> ());
147
-
(match icon c with
148
-
| Some i -> pf ppf "%a: %a@," (styled `Bold string) "Icon" string i
149
-
| None -> ());
150
-
(match atom c with
151
-
| Some atoms when atoms <> [] ->
152
-
pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Atom Feeds" (list ~sep:comma string) atoms
153
-
| _ -> ());
154
-
pf ppf "@]"
+9
-4
ocaml-bushel/lib/bushel_entry.ml
+9
-4
ocaml-bushel/lib/bushel_entry.ml
···
23
23
projects : Bushel_project.ts;
24
24
ideas : Bushel_idea.ts;
25
25
videos : Bushel_video.ts;
26
-
contacts : Bushel_contact.ts;
26
+
contacts : Sortal_schema.Contact.t list;
27
27
data_dir : string;
28
28
}
29
29
···
153
153
(** {1 Contact Lookups} *)
154
154
155
155
let lookup_by_name { contacts; _ } n =
156
-
match Bushel_contact.lookup_by_name contacts n with
157
-
| v -> Some v
158
-
| exception _ -> None
156
+
let name_lower = String.lowercase_ascii n in
157
+
let matches = List.filter (fun c ->
158
+
List.exists (fun name -> String.lowercase_ascii name = name_lower)
159
+
(Sortal_schema.Contact.names c)
160
+
) contacts in
161
+
match matches with
162
+
| [contact] -> Some contact
163
+
| _ -> None
159
164
160
165
(** {1 Tag Functions} *)
161
166
+3
-3
ocaml-bushel/lib/bushel_entry.mli
+3
-3
ocaml-bushel/lib/bushel_entry.mli
···
28
28
projects:Bushel_project.t list ->
29
29
ideas:Bushel_idea.t list ->
30
30
videos:Bushel_video.t list ->
31
-
contacts:Bushel_contact.t list ->
31
+
contacts:Sortal_schema.Contact.t list ->
32
32
data_dir:string ->
33
33
t
34
34
(** Create an entry collection from lists of each entry type. *)
35
35
36
36
(** {1 Accessors} *)
37
37
38
-
val contacts : t -> Bushel_contact.ts
38
+
val contacts : t -> Sortal_schema.Contact.t list
39
39
val videos : t -> Bushel_video.ts
40
40
val ideas : t -> Bushel_idea.ts
41
41
val papers : t -> Bushel_paper.ts
···
111
111
112
112
(** {1 Contact Lookups} *)
113
113
114
-
val lookup_by_name : t -> string -> Bushel_contact.t option
114
+
val lookup_by_name : t -> string -> Sortal_schema.Contact.t option
115
115
(** [lookup_by_name entries name] finds a contact by name. *)
116
116
117
117
(** {1 Tag Functions} *)
+2
-2
ocaml-bushel/lib/bushel_link_graph.ml
+2
-2
ocaml-bushel/lib/bushel_link_graph.ml
···
144
144
) (Bushel_entry.all_entries entries) in
145
145
146
146
let contact_nodes = List.map (fun contact ->
147
-
let handle = Bushel_contact.handle contact in
148
-
let name = Bushel_contact.name contact in
147
+
let handle = Sortal_schema.Contact.handle contact in
148
+
let name = Sortal_schema.Contact.name contact in
149
149
`O [
150
150
("id", `String handle);
151
151
("title", `String name);
+5
-5
ocaml-bushel/lib/bushel_md.ml
+5
-5
ocaml-bushel/lib/bushel_md.ml
···
137
137
| Some () ->
138
138
let slug = Label.key l in
139
139
let s = strip_handle slug in
140
-
(match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) s with
140
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
141
141
| Some c ->
142
-
let name = Bushel_contact.name c in
143
-
(match Bushel_contact.best_url c with
142
+
let name = Sortal_schema.Contact.name c in
143
+
(match Sortal_schema.Contact.best_url c with
144
144
| Some dest ->
145
145
let txt = Inline.Text (name, meta) in
146
146
let ld = Link_definition.make ~dest:(dest, meta) () in
···
370
370
| Some (url, _title) ->
371
371
let s = strip_handle url in
372
372
if is_contact_slug url then
373
-
(match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) s with
373
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
374
374
| None -> Hashtbl.replace broken_contacts url ()
375
375
| Some _ -> ())
376
376
else if is_bushel_slug url then
···
386
386
| Some () ->
387
387
let slug = Label.key l in
388
388
let handle = strip_handle slug in
389
-
(match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) handle with
389
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (Bushel_entry.contacts entries) with
390
390
| None -> Hashtbl.replace broken_contacts slug ()
391
391
| Some _ -> ());
392
392
Mapper.default
+2
-1
ocaml-bushel/lib/dune
+2
-1
ocaml-bushel/lib/dune
+7
-12
ocaml-bushel/lib_eio/bushel_loader.ml
+7
-12
ocaml-bushel/lib_eio/bushel_loader.ml
···
38
38
None
39
39
) files
40
40
41
-
(** Load contacts from data/contacts/ *)
42
-
let load_contacts fs base =
43
-
map_category fs base "contacts" (fun fm ->
44
-
let handle =
45
-
match Frontmatter.fname fm with
46
-
| Some fname -> Filename.basename fname |> Filename.chop_extension
47
-
| None -> ""
48
-
in
49
-
Bushel.Contact.of_frontmatter ~handle fm
50
-
)
41
+
(** Load contacts from Sortal XDG store *)
42
+
let load_contacts fs _base =
43
+
let store = Sortal.Store.create fs "sortal" in
44
+
Sortal.Store.list store
51
45
52
46
(** Load projects from data/projects/ *)
53
47
let load_projects fs base =
···
165
159
| None -> ())
166
160
else if Bushel.Md.is_contact_slug link then
167
161
let handle = Bushel.Md.strip_handle link in
168
-
(match Bushel.Contact.find_by_handle (Bushel.Entry.contacts entries) handle with
162
+
let contacts = Bushel.Entry.contacts entries in
163
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) contacts with
169
164
| Some c ->
170
-
add_internal_link source_slug (Bushel.Contact.handle c) `Contact
165
+
add_internal_link source_slug (Sortal_schema.Contact.handle c) `Contact
171
166
| None -> ())
172
167
else if Bushel.Md.is_tag_slug link || Bushel.Md.is_type_filter_slug link then
173
168
() (* Skip tag links *)
+2
-1
ocaml-bushel/lib_eio/dune
+2
-1
ocaml-bushel/lib_eio/dune
+3
-3
ocaml-bushel/lib_sync/bushel_immich.ml
+3
-3
ocaml-bushel/lib_sync/bushel_immich.ml
···
73
73
(** {1 Contact Face Fetching} *)
74
74
75
75
let fetch_face_for_contact ~proc_mgr ~endpoint ~api_key ~output_dir contact =
76
-
let names = Bushel.Contact.names contact in
77
-
let handle = Bushel.Contact.handle contact in
76
+
let names = Sortal_schema.Contact.names contact in
77
+
let handle = Sortal_schema.Contact.handle contact in
78
78
let output_path = Filename.concat output_dir (handle ^ ".jpg") in
79
79
80
80
(* Skip if already exists *)
···
113
113
Unix.mkdir output_dir 0o755;
114
114
115
115
let results = List.map (fun contact ->
116
-
let handle = Bushel.Contact.handle contact in
116
+
let handle = Sortal_schema.Contact.handle contact in
117
117
let result = fetch_face_for_contact ~proc_mgr ~endpoint ~api_key ~output_dir contact in
118
118
(handle, result)
119
119
) contacts in
+2
-1
ocaml-bushel/lib_sync/dune
+2
-1
ocaml-bushel/lib_sync/dune
+23
-13
ocaml-bushel/lib_typesense/bushel_typesense.ml
+23
-13
ocaml-bushel/lib_typesense/bushel_typesense.ml
···
265
265
(match Bushel.Video.paper v with Some p -> [("paper", `A [`String p])] | None -> []) @
266
266
(match Bushel.Video.project v with Some p -> [("project", `A [`String p])] | None -> []))
267
267
268
-
let contact_to_document (c : Bushel.Contact.t) =
268
+
let contact_to_document (c : Sortal_schema.Contact.t) =
269
+
(* Extract atom feed URLs from Sortal feeds *)
270
+
let atom_urls = match Sortal_schema.Contact.feeds c with
271
+
| Some feeds ->
272
+
List.filter_map (fun f ->
273
+
if Sortal_schema.Feed.feed_type f = Sortal_schema.Feed.Atom
274
+
then Some (Sortal_schema.Feed.url f)
275
+
else None
276
+
) feeds
277
+
| None -> []
278
+
in
269
279
`O ([
270
-
("id", `String (Bushel.Contact.handle c));
271
-
("handle", `String (Bushel.Contact.handle c));
272
-
("name", `String (Bushel.Contact.name c));
273
-
("names", `A (List.map (fun n -> `String n) (Bushel.Contact.names c)));
280
+
("id", `String (Sortal_schema.Contact.handle c));
281
+
("handle", `String (Sortal_schema.Contact.handle c));
282
+
("name", `String (Sortal_schema.Contact.name c));
283
+
("names", `A (List.map (fun n -> `String n) (Sortal_schema.Contact.names c)));
274
284
] @
275
-
(match Bushel.Contact.email c with Some e -> [("email", `A [`String e])] | None -> []) @
276
-
(match Bushel.Contact.github c with Some g -> [("github", `A [`String g])] | None -> []) @
277
-
(match Bushel.Contact.twitter c with Some t -> [("twitter", `A [`String t])] | None -> []) @
278
-
(match Bushel.Contact.bluesky c with Some b -> [("bluesky", `A [`String b])] | None -> []) @
279
-
(match Bushel.Contact.mastodon c with Some m -> [("mastodon", `A [`String m])] | None -> []) @
280
-
(match Bushel.Contact.orcid c with Some o -> [("orcid", `A [`String o])] | None -> []) @
281
-
(match Bushel.Contact.url c with Some u -> [("url", `A [`String u])] | None -> []) @
282
-
(match Bushel.Contact.atom c with Some a -> [("atom", `A (List.map (fun x -> `String x) a))] | None -> []))
285
+
(match Sortal_schema.Contact.current_email c with Some e -> [("email", `A [`String e])] | None -> []) @
286
+
(match Sortal_schema.Contact.github_handle c with Some g -> [("github", `A [`String g])] | None -> []) @
287
+
(match Sortal_schema.Contact.twitter_handle c with Some t -> [("twitter", `A [`String t])] | None -> []) @
288
+
(match Sortal_schema.Contact.bluesky_handle c with Some b -> [("bluesky", `A [`String b])] | None -> []) @
289
+
(match Sortal_schema.Contact.mastodon_handle c with Some m -> [("mastodon", `A [`String m])] | None -> []) @
290
+
(match Sortal_schema.Contact.orcid c with Some o -> [("orcid", `A [`String o])] | None -> []) @
291
+
(match Sortal_schema.Contact.current_url c with Some u -> [("url", `A [`String u])] | None -> []) @
292
+
(if atom_urls = [] then [] else [("atom", `A (List.map (fun x -> `String x) atom_urls))]))
+1
-1
ocaml-bushel/lib_typesense/dune
+1
-1
ocaml-bushel/lib_typesense/dune
+16
-9
sortal/lib/core/sortal_cmd.ml
+16
-9
sortal/lib/core/sortal_cmd.ml
···
124
124
Logs.info (fun m -> m "@%s: already PNG (%s)" handle (Filename.basename path));
125
125
incr skipped
126
126
end else begin
127
-
Logs.app (fun m -> m "@%s: converting %s to PNG..." handle (Filename.basename path));
128
-
match convert_to_png path with
129
-
| Ok new_path ->
130
-
Logs.app (fun m -> m " Converted: %s -> %s"
131
-
(Filename.basename path) (Filename.basename new_path));
132
-
incr converted
133
-
| Error msg ->
134
-
Logs.err (fun m -> m " Failed to convert %s: %s" path msg);
135
-
incr errors
127
+
(* Check if PNG version already exists *)
128
+
let png_path = Filename.remove_extension path ^ ".png" in
129
+
if Sys.file_exists png_path then begin
130
+
Logs.info (fun m -> m "@%s: PNG already exists (%s)" handle (Filename.basename png_path));
131
+
incr skipped
132
+
end else begin
133
+
Logs.app (fun m -> m "@%s: converting %s to PNG..." handle (Filename.basename path));
134
+
match convert_to_png path with
135
+
| Ok new_path ->
136
+
Logs.app (fun m -> m " Converted: %s -> %s"
137
+
(Filename.basename path) (Filename.basename new_path));
138
+
incr converted
139
+
| Error msg ->
140
+
Logs.err (fun m -> m " Failed to convert %s: %s" path msg);
141
+
incr errors
142
+
end
136
143
end
137
144
) contacts;
138
145
Logs.app (fun m -> m "Sync complete:");
+15
sortal/lib/core/sortal_store.ml
+15
sortal/lib/core/sortal_store.ml
···
329
329
) all in
330
330
List.sort Contact.compare matches
331
331
332
+
let find_by_handle t handle =
333
+
lookup t handle
334
+
335
+
let lookup_by_name t name =
336
+
let name_lower = String.lowercase_ascii name in
337
+
let all_contacts = list t in
338
+
let matches = List.filter (fun c ->
339
+
List.exists (fun n -> String.lowercase_ascii n = name_lower)
340
+
(Contact.names c)
341
+
) all_contacts in
342
+
match matches with
343
+
| [contact] -> contact
344
+
| [] -> failwith ("Contact not found: " ^ name)
345
+
| _ -> failwith ("Ambiguous contact: " ^ name)
346
+
332
347
let find_by_email_at t ~email ~date =
333
348
let all = list t in
334
349
List.find_opt (fun c ->
+18
sortal/lib/core/sortal_store.mli
+18
sortal/lib/core/sortal_store.mli
···
173
173
174
174
(** {1 Searching} *)
175
175
176
+
(** [find_by_handle t handle] finds a contact by exact handle match.
177
+
178
+
This is an alias for {!lookup} for API compatibility.
179
+
180
+
@return [Some contact] if found, [None] if not found *)
181
+
val find_by_handle : t -> string -> Contact.t option
182
+
176
183
(** [find_by_name t name] searches for contacts by name.
177
184
178
185
Performs a case-insensitive search through all contacts,
···
183
190
@raise Not_found if no contacts match the name
184
191
@raise Invalid_argument if multiple contacts match the name *)
185
192
val find_by_name : t -> string -> Contact.t
193
+
194
+
(** [lookup_by_name t name] searches for contacts by name, raising on failure.
195
+
196
+
Like {!find_by_name} but raises [Failure] instead of [Not_found]
197
+
or [Invalid_argument]. This matches the semantics of Bushel's
198
+
original contact lookup.
199
+
200
+
@param name The name to search for (case-insensitive)
201
+
@return The matching contact if exactly one match is found
202
+
@raise Failure if no contacts match or multiple contacts match *)
203
+
val lookup_by_name : t -> string -> Contact.t
186
204
187
205
(** [find_by_name_opt t name] searches for contacts by name, returning an option.
188
206
+80
-6
sortal/lib/schema/sortal_schema_contact_v1.ml
+80
-6
sortal/lib/schema/sortal_schema_contact_v1.ml
···
7
7
8
8
type contact_kind = Person | Organization | Group | Role
9
9
10
+
type activitypub_variant =
11
+
| Mastodon
12
+
| Pixelfed
13
+
| PeerTube
14
+
| Other_activitypub of string
15
+
10
16
type service_kind =
11
-
| ActivityPub
17
+
| ActivityPub of activitypub_variant
18
+
| Bluesky
12
19
| Github
13
20
| Git
14
-
| Social
21
+
| Twitter
15
22
| Photo
16
23
| Custom of string
17
24
···
122
129
let orcid t = t.orcid
123
130
let feeds t = t.feeds
124
131
132
+
(* Service convenience accessors *)
133
+
let github t =
134
+
List.find_opt (fun (s : service) ->
135
+
match s.kind with Some Github -> true | _ -> false
136
+
) t.services
137
+
138
+
let github_handle t =
139
+
match github t with
140
+
| Some s -> s.handle
141
+
| None -> None
142
+
143
+
let twitter t =
144
+
List.find_opt (fun (s : service) ->
145
+
match s.kind with Some Twitter -> true | _ -> false
146
+
) t.services
147
+
148
+
let twitter_handle t =
149
+
match twitter t with
150
+
| Some s -> s.handle
151
+
| None -> None
152
+
153
+
let mastodon t =
154
+
List.find_opt (fun (s : service) ->
155
+
match s.kind with Some (ActivityPub Mastodon) -> true | _ -> false
156
+
) t.services
157
+
158
+
let mastodon_handle t =
159
+
match mastodon t with
160
+
| Some s -> s.handle
161
+
| None -> None
162
+
163
+
let bluesky t =
164
+
List.find_opt (fun (s : service) ->
165
+
match s.kind with Some Bluesky -> true | _ -> false
166
+
) t.services
167
+
168
+
let bluesky_handle t =
169
+
match bluesky t with
170
+
| Some s -> s.handle
171
+
| None -> None
172
+
125
173
(* Temporal queries *)
126
174
let emails_at t ~date =
127
175
Sortal_schema_temporal.at_date ~get:(fun (e : email) -> e.range) ~date t.emails
···
210
258
| "role" -> Some Role
211
259
| _ -> None
212
260
261
+
let activitypub_variant_to_string = function
262
+
| Mastodon -> "mastodon"
263
+
| Pixelfed -> "pixelfed"
264
+
| PeerTube -> "peertube"
265
+
| Other_activitypub s -> s
266
+
267
+
let activitypub_variant_of_string s =
268
+
match String.lowercase_ascii s with
269
+
| "mastodon" -> Mastodon
270
+
| "pixelfed" -> Pixelfed
271
+
| "peertube" -> PeerTube
272
+
| _ -> Other_activitypub s
273
+
213
274
let service_kind_to_string = function
214
-
| ActivityPub -> "activitypub"
275
+
| ActivityPub v -> "activitypub:" ^ activitypub_variant_to_string v
276
+
| Bluesky -> "bluesky"
215
277
| Github -> "github"
216
278
| Git -> "git"
217
-
| Social -> "social"
279
+
| Twitter -> "twitter"
218
280
| Photo -> "photo"
219
281
| Custom s -> s
220
282
221
283
let service_kind_of_string s =
222
284
match String.lowercase_ascii s with
223
-
| "activitypub" -> Some ActivityPub
285
+
| "bluesky" -> Some Bluesky
224
286
| "github" -> Some Github
225
287
| "git" -> Some Git
226
-
| "social" -> Some Social
288
+
| "twitter" -> Some Twitter
227
289
| "photo" -> Some Photo
228
290
| "" | "custom" -> None
291
+
| s when String.length s > 11 && String.sub s 0 11 = "activitypub" ->
292
+
(* Handle activitypub:variant format *)
293
+
let rest = String.sub s 11 (String.length s - 11) in
294
+
let variant = if rest = "" then Mastodon
295
+
else if String.length rest > 1 && rest.[0] = ':' then
296
+
activitypub_variant_of_string (String.sub rest 1 (String.length rest - 1))
297
+
else Mastodon
298
+
in
299
+
Some (ActivityPub variant)
300
+
| "mastodon" -> Some (ActivityPub Mastodon)
301
+
| "pixelfed" -> Some (ActivityPub Pixelfed)
302
+
| "peertube" -> Some (ActivityPub PeerTube)
229
303
| _ -> Some (Custom s)
230
304
231
305
let email_type_to_string = function
+41
-2
sortal/lib/schema/sortal_schema_contact_v1.mli
+41
-2
sortal/lib/schema/sortal_schema_contact_v1.mli
···
29
29
| Group (** Research group, project team *)
30
30
| Role (** Generic role email like info@, admin@ *)
31
31
32
+
(** ActivityPub service variants. *)
33
+
type activitypub_variant =
34
+
| Mastodon (** Mastodon instance *)
35
+
| Pixelfed (** Pixelfed instance *)
36
+
| PeerTube (** PeerTube instance *)
37
+
| Other_activitypub of string (** Other ActivityPub-compatible service *)
38
+
32
39
(** Service kind - categorization of online presence. *)
33
40
type service_kind =
34
-
| ActivityPub (** Mastodon, Pixelfed, PeerTube, etc *)
41
+
| ActivityPub of activitypub_variant (** ActivityPub-compatible services *)
42
+
| Bluesky (** Bluesky / AT Protocol *)
35
43
| Github (** GitHub *)
36
44
| Git (** GitLab, Gitea, Codeberg, etc *)
37
-
| Social (** Twitter/X, LinkedIn, etc *)
45
+
| Twitter (** Twitter/X *)
38
46
| Photo (** Immich, Flickr, Instagram, etc *)
39
47
| Custom of string (** Other service types *)
40
48
···
204
212
val orcid : t -> string option
205
213
val feeds : t -> Sortal_schema_feed.t list option
206
214
215
+
(** {1 Service Convenience Accessors}
216
+
217
+
These accessors provide easy access to common service types. *)
218
+
219
+
(** [github t] returns the GitHub service entry if present. *)
220
+
val github : t -> service option
221
+
222
+
(** [github_handle t] returns the GitHub username if present. *)
223
+
val github_handle : t -> string option
224
+
225
+
(** [twitter t] returns the Twitter/X service entry if present. *)
226
+
val twitter : t -> service option
227
+
228
+
(** [twitter_handle t] returns the Twitter/X username if present. *)
229
+
val twitter_handle : t -> string option
230
+
231
+
(** [mastodon t] returns the Mastodon service entry if present. *)
232
+
val mastodon : t -> service option
233
+
234
+
(** [mastodon_handle t] returns the Mastodon handle if present. *)
235
+
val mastodon_handle : t -> string option
236
+
237
+
(** [bluesky t] returns the Bluesky service entry if present. *)
238
+
val bluesky : t -> service option
239
+
240
+
(** [bluesky_handle t] returns the Bluesky handle if present. *)
241
+
val bluesky_handle : t -> string option
242
+
207
243
(** {1 Temporal Queries} *)
208
244
209
245
(** [email_at t ~date] returns the primary email valid at [date]. *)
···
269
305
270
306
val contact_kind_to_string : contact_kind -> string
271
307
val contact_kind_of_string : string -> contact_kind option
308
+
309
+
val activitypub_variant_to_string : activitypub_variant -> string
310
+
val activitypub_variant_of_string : string -> activitypub_variant
272
311
273
312
val service_kind_to_string : service_kind -> string
274
313
val service_kind_of_string : string -> service_kind option