OCaml library for JSONfeed parsing and creation
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module Unknown = struct
7 type t = (string * Jsont.json) list
8
9 let empty = []
10 let is_empty = function [] -> true | _ -> false
11end
12
13type t = {
14 name : string option;
15 url : string option;
16 avatar : string option;
17 unknown : Unknown.t;
18}
19
20let create ?name ?url ?avatar ?(unknown = Unknown.empty) () =
21 if name = None && url = None && avatar = None then
22 invalid_arg
23 "Author.create: at least one field (name, url, or avatar) must be \
24 provided";
25 { name; url; avatar; unknown }
26
27let name t = t.name
28let url t = t.url
29let avatar t = t.avatar
30let unknown t = t.unknown
31let is_valid t = t.name <> None || t.url <> None || t.avatar <> None
32let equal a b = a.name = b.name && a.url = b.url && a.avatar = b.avatar
33
34let pp ppf t =
35 match (t.name, t.url) with
36 | Some name, Some url -> Format.fprintf ppf "%s <%s>" name url
37 | Some name, None -> Format.fprintf ppf "%s" name
38 | None, Some url -> Format.fprintf ppf "<%s>" url
39 | None, None -> (
40 match t.avatar with
41 | Some avatar -> Format.fprintf ppf "(avatar: %s)" avatar
42 | None -> Format.fprintf ppf "(empty author)")
43
44let jsont =
45 let kind = "Author" in
46 let doc = "An author object with at least one field set" in
47 (* Custom mems map for Unknown.t that strips metadata from names *)
48 let unknown_mems :
49 (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
50 let open Jsont.Object.Mems in
51 let dec_empty () = [] in
52 let dec_add _meta (name : string) value acc =
53 ((name, Jsont.Meta.none), value) :: acc
54 in
55 let dec_finish _meta mems =
56 List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
57 in
58 let enc =
59 {
60 enc =
61 (fun (type acc)
62 (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
63 unknown
64 (acc : acc)
65 ->
66 List.fold_left
67 (fun acc (name, value) -> f Jsont.Meta.none name value acc)
68 acc unknown);
69 }
70 in
71 map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
72 in
73 (* Constructor that matches the jsont object map pattern *)
74 let create_obj name url avatar unknown =
75 create ?name ?url ?avatar ~unknown ()
76 in
77 Jsont.Object.map ~kind ~doc create_obj
78 |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
79 |> Jsont.Object.opt_mem "url" Jsont.string ~enc:url
80 |> Jsont.Object.opt_mem "avatar" Jsont.string ~enc:avatar
81 |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
82 |> Jsont.Object.finish