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 make ?name ?url ?avatar ?(unknown = Unknown.empty) () =
21 { name; url; avatar; unknown }
22
23let create ?name ?url ?avatar () =
24 if name = None && url = None && avatar = None then
25 invalid_arg "Author.create: at least one field (name, url, or avatar) must be provided";
26 make ?name ?url ?avatar ()
27
28let name t = t.name
29let url t = t.url
30let avatar t = t.avatar
31let unknown t = t.unknown
32
33let is_valid t =
34 t.name <> None || t.url <> None || t.avatar <> None
35
36let equal a b =
37 a.name = b.name &&
38 a.url = b.url &&
39 a.avatar = b.avatar
40
41let pp ppf t =
42 match t.name, t.url with
43 | Some name, Some url -> Format.fprintf ppf "%s <%s>" name url
44 | Some name, None -> Format.fprintf ppf "%s" name
45 | None, Some url -> Format.fprintf ppf "<%s>" url
46 | None, None ->
47 match t.avatar with
48 | Some avatar -> Format.fprintf ppf "(avatar: %s)" avatar
49 | None -> Format.fprintf ppf "(empty author)"
50
51let jsont =
52 let kind = "Author" in
53 let doc = "An author object with at least one field set" in
54 (* Custom mems map for Unknown.t that strips metadata from names *)
55 let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
56 let open Jsont.Object.Mems in
57 let dec_empty () = [] in
58 let dec_add _meta (name : string) value acc =
59 ((name, Jsont.Meta.none), value) :: acc
60 in
61 let dec_finish _meta mems =
62 List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
63 in
64 let enc = {
65 enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
66 List.fold_left (fun acc (name, value) ->
67 f Jsont.Meta.none name value acc
68 ) acc unknown
69 } in
70 map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
71 in
72 (* Constructor that matches the jsont object map pattern *)
73 let make_obj name url avatar unknown = make ?name ?url ?avatar ~unknown () in
74 Jsont.Object.map ~kind ~doc make_obj
75 |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
76 |> Jsont.Object.opt_mem "url" Jsont.string ~enc:url
77 |> Jsont.Object.opt_mem "avatar" Jsont.string ~enc:avatar
78 |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
79 |> Jsont.Object.finish