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