anil.recoil.org
OCaml codecs for the Citation File Format (CFF)
1(*---------------------------------------------------------------------------
2 Copyright (c) 2026 The ocaml-cff programmers. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Person, Entity, and Author types for CFF. *)
7
8(** A person (individual author/contributor). *)
9module Person = struct
10 type t =
11 { family_names : string option
12 ; given_names : string option
13 ; name_particle : string option
14 ; name_suffix : string option
15 ; alias : string option
16 ; affiliation : string option
17 ; address : Cff_address.Address.t
18 ; contact : Cff_address.Contact.t
19 }
20
21 let make
22 ?family_names
23 ?given_names
24 ?name_particle
25 ?name_suffix
26 ?alias
27 ?affiliation
28 ?(address = Cff_address.Address.empty)
29 ?(contact = Cff_address.Contact.empty)
30 ()
31 =
32 { family_names
33 ; given_names
34 ; name_particle
35 ; name_suffix
36 ; alias
37 ; affiliation
38 ; address
39 ; contact
40 }
41 ;;
42
43 let family_names t = t.family_names
44 let given_names t = t.given_names
45 let name_particle t = t.name_particle
46 let name_suffix t = t.name_suffix
47 let alias t = t.alias
48 let affiliation t = t.affiliation
49 let address t = t.address
50 let contact t = t.contact
51
52 let full_name t =
53 let parts =
54 List.filter_map Fun.id [ t.given_names; t.name_particle; t.family_names ]
55 in
56 let base = String.concat " " parts in
57 match t.name_suffix with
58 | Some suffix -> base ^ ", " ^ suffix
59 | None -> base
60 ;;
61
62 let email t = Cff_address.Contact.email t.contact
63 let orcid t = Cff_address.Contact.orcid t.contact
64 let website t = Cff_address.Contact.website t.contact
65
66 let pp ppf t =
67 Format.fprintf ppf "%s" (full_name t);
68 Option.iter (Format.fprintf ppf " (%s)") t.affiliation
69 ;;
70
71 let jsont =
72 Jsont.Object.map
73 ~kind:"Person"
74 (fun
75 family_names
76 given_names
77 name_particle
78 name_suffix
79 alias
80 affiliation
81 address
82 city
83 region
84 post_code
85 country
86 email
87 tel
88 fax
89 website
90 orcid
91 ->
92 let address =
93 Cff_address.Address.of_options ~address ~city ~region ~post_code ~country
94 in
95 let contact = Cff_address.Contact.of_options ~email ~tel ~fax ~website ~orcid in
96 { family_names
97 ; given_names
98 ; name_particle
99 ; name_suffix
100 ; alias
101 ; affiliation
102 ; address
103 ; contact
104 })
105 |> Jsont.Object.opt_mem "family-names" Jsont.string ~enc:(fun p -> p.family_names)
106 |> Jsont.Object.opt_mem "given-names" Jsont.string ~enc:(fun p -> p.given_names)
107 |> Jsont.Object.opt_mem "name-particle" Jsont.string ~enc:(fun p -> p.name_particle)
108 |> Jsont.Object.opt_mem "name-suffix" Jsont.string ~enc:(fun p -> p.name_suffix)
109 |> Jsont.Object.opt_mem "alias" Jsont.string ~enc:(fun p -> p.alias)
110 |> Jsont.Object.opt_mem "affiliation" Jsont.string ~enc:(fun p -> p.affiliation)
111 |> Cff_address.Address.jsont_fields ~get:(fun p -> p.address)
112 |> Cff_address.Contact.jsont_fields ~get:(fun p -> p.contact)
113 |> Jsont.Object.skip_unknown
114 |> Jsont.Object.finish
115 ;;
116end
117
118(** An entity (organization, team, conference, etc.). *)
119module Entity = struct
120 type t =
121 { name : string
122 ; alias : string option
123 ; address : Cff_address.Address.t
124 ; contact : Cff_address.Contact.t
125 ; date_start : Cff_date.t option
126 ; date_end : Cff_date.t option
127 ; location : string option
128 }
129
130 let make
131 ~name
132 ?alias
133 ?(address = Cff_address.Address.empty)
134 ?(contact = Cff_address.Contact.empty)
135 ?date_start
136 ?date_end
137 ?location
138 ()
139 =
140 { name; alias; address; contact; date_start; date_end; location }
141 ;;
142
143 let name t = t.name
144 let alias t = t.alias
145 let address t = t.address
146 let contact t = t.contact
147 let date_start t = t.date_start
148 let date_end t = t.date_end
149 let location t = t.location
150 let email t = Cff_address.Contact.email t.contact
151 let orcid t = Cff_address.Contact.orcid t.contact
152 let website t = Cff_address.Contact.website t.contact
153
154 let pp ppf t =
155 Format.pp_print_string ppf t.name;
156 Option.iter (Format.fprintf ppf " (%s)") t.alias
157 ;;
158
159 let jsont =
160 Jsont.Object.map
161 ~kind:"Entity"
162 (fun
163 name
164 alias
165 address
166 city
167 region
168 post_code
169 country
170 email
171 tel
172 fax
173 website
174 orcid
175 date_start
176 date_end
177 location
178 ->
179 let address =
180 Cff_address.Address.of_options ~address ~city ~region ~post_code ~country
181 in
182 let contact = Cff_address.Contact.of_options ~email ~tel ~fax ~website ~orcid in
183 { name; alias; address; contact; date_start; date_end; location })
184 |> Jsont.Object.mem "name" Jsont.string ~enc:(fun e -> e.name)
185 |> Jsont.Object.opt_mem "alias" Jsont.string ~enc:(fun e -> e.alias)
186 |> Cff_address.Address.jsont_fields ~get:(fun e -> e.address)
187 |> Cff_address.Contact.jsont_fields ~get:(fun e -> e.contact)
188 |> Jsont.Object.opt_mem "date-start" Cff_date.jsont ~enc:(fun e -> e.date_start)
189 |> Jsont.Object.opt_mem "date-end" Cff_date.jsont ~enc:(fun e -> e.date_end)
190 |> Jsont.Object.opt_mem "location" Jsont.string ~enc:(fun e -> e.location)
191 |> Jsont.Object.skip_unknown
192 |> Jsont.Object.finish
193 ;;
194end
195
196(** An author can be either a Person or an Entity. *)
197type t =
198 [ `Person of Person.t
199 | `Entity of Entity.t
200 ]
201
202let person
203 ?family_names
204 ?given_names
205 ?name_particle
206 ?name_suffix
207 ?alias
208 ?affiliation
209 ?address
210 ?contact
211 ()
212 =
213 `Person
214 (Person.make
215 ?family_names
216 ?given_names
217 ?name_particle
218 ?name_suffix
219 ?alias
220 ?affiliation
221 ?address
222 ?contact
223 ())
224;;
225
226let entity ~name ?alias ?address ?contact ?date_start ?date_end ?location () =
227 `Entity (Entity.make ~name ?alias ?address ?contact ?date_start ?date_end ?location ())
228;;
229
230let name = function
231 | `Person p -> Person.full_name p
232 | `Entity e -> Entity.name e
233;;
234
235let orcid = function
236 | `Person p -> Person.orcid p
237 | `Entity e -> Entity.orcid e
238;;
239
240let email = function
241 | `Person p -> Person.email p
242 | `Entity e -> Entity.email e
243;;
244
245let pp ppf = function
246 | `Person p -> Person.pp ppf p
247 | `Entity e -> Entity.pp ppf e
248;;
249
250(* Jsont codec that discriminates based on "name" field presence.
251 If "name" is present -> Entity, otherwise -> Person *)
252let jsont =
253 (* Check if json object has "name" member *)
254 let has_name_member = function
255 | Jsont.Object (members, _) -> Option.is_some (Jsont.Json.find_mem "name" members)
256 | _ -> false
257 in
258 let dec_json j =
259 if has_name_member j
260 then (
261 match Jsont.Json.decode' Entity.jsont j with
262 | Ok e -> `Entity e
263 | Error err ->
264 Jsont.Error.msgf Jsont.Meta.none "Invalid entity: %s" (Jsont.Error.to_string err))
265 else (
266 match Jsont.Json.decode' Person.jsont j with
267 | Ok p -> `Person p
268 | Error err ->
269 Jsont.Error.msgf Jsont.Meta.none "Invalid person: %s" (Jsont.Error.to_string err))
270 in
271 let enc_author = function
272 | `Person p ->
273 (match Jsont.Json.encode' Person.jsont p with
274 | Ok j -> j
275 | Error _ -> assert false)
276 | `Entity e ->
277 (match Jsont.Json.encode' Entity.jsont e with
278 | Ok j -> j
279 | Error _ -> assert false)
280 in
281 Jsont.json |> Jsont.map ~dec:dec_json ~enc:enc_author
282;;