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 content = [ `Html of string | `Text of string | `Both of string * string ]
14
15type t = {
16 id : string;
17 content : content;
18 url : string option;
19 external_url : string option;
20 title : string option;
21 summary : string option;
22 image : string option;
23 banner_image : string option;
24 date_published : Ptime.t option;
25 date_modified : Ptime.t option;
26 authors : Author.t list option;
27 tags : string list option;
28 language : string option;
29 attachments : Attachment.t list option;
30 references : Reference.t list option;
31 unknown : Unknown.t;
32}
33
34let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
35 ?date_published ?date_modified ?authors ?tags ?language ?attachments
36 ?references ?(unknown = Unknown.empty) () =
37 {
38 id;
39 content;
40 url;
41 external_url;
42 title;
43 summary;
44 image;
45 banner_image;
46 date_published;
47 date_modified;
48 authors;
49 tags;
50 language;
51 attachments;
52 references;
53 unknown;
54 }
55
56let id t = t.id
57let content t = t.content
58let url t = t.url
59let external_url t = t.external_url
60let title t = t.title
61let summary t = t.summary
62let image t = t.image
63let banner_image t = t.banner_image
64let date_published t = t.date_published
65let date_modified t = t.date_modified
66let authors t = t.authors
67let tags t = t.tags
68let language t = t.language
69let attachments t = t.attachments
70let references t = t.references
71let unknown t = t.unknown
72
73let content_html t =
74 match t.content with
75 | `Html html -> Some html
76 | `Text _ -> None
77 | `Both (html, _) -> Some html
78
79let content_text t =
80 match t.content with
81 | `Html _ -> None
82 | `Text text -> Some text
83 | `Both (_, text) -> Some text
84
85let equal a b = a.id = b.id
86
87let compare a b =
88 match (a.date_published, b.date_published) with
89 | None, None -> 0
90 | None, Some _ -> -1
91 | Some _, None -> 1
92 | Some da, Some db -> Ptime.compare da db
93
94let pp ppf t =
95 match (t.date_published, t.title) with
96 | Some date, Some title ->
97 let (y, m, d), _ = Ptime.to_date_time date in
98 Format.fprintf ppf "[%04d-%02d-%02d] %s (%s)" y m d title t.id
99 | Some date, None ->
100 let (y, m, d), _ = Ptime.to_date_time date in
101 Format.fprintf ppf "[%04d-%02d-%02d] %s" y m d t.id
102 | None, Some title -> Format.fprintf ppf "%s (%s)" title t.id
103 | None, None -> Format.fprintf ppf "%s" t.id
104
105let pp_summary ppf t =
106 match t.title with
107 | Some title -> Format.fprintf ppf "%s" title
108 | None -> Format.fprintf ppf "%s" t.id
109
110(* Jsont type *)
111
112let jsont =
113 let kind = "Item" in
114 let doc = "A JSON Feed item" in
115
116 (* Helper to construct item from JSON fields *)
117 let make_from_json id content_html content_text url external_url title summary
118 image banner_image date_published date_modified authors tags language
119 attachments references _extensions unknown =
120 (* Determine content from content_html and content_text *)
121 let content =
122 match (content_html, content_text) with
123 | Some html, Some text -> `Both (html, text)
124 | Some html, None -> `Html html
125 | None, Some text -> `Text text
126 | None, None ->
127 Jsont.Error.msg Jsont.Meta.none
128 "Item must have at least one of content_html or content_text"
129 in
130 {
131 id;
132 content;
133 url;
134 external_url;
135 title;
136 summary;
137 image;
138 banner_image;
139 date_published;
140 date_modified;
141 authors;
142 tags;
143 language;
144 attachments;
145 references;
146 unknown;
147 }
148 in
149
150 (* Encoders to extract fields from item *)
151 let enc_id t = t.id in
152 let enc_content_html t = content_html t in
153 let enc_content_text t = content_text t in
154 let enc_url t = t.url in
155 let enc_external_url t = t.external_url in
156 let enc_title t = t.title in
157 let enc_summary t = t.summary in
158 let enc_image t = t.image in
159 let enc_banner_image t = t.banner_image in
160 let enc_date_published t = t.date_published in
161 let enc_date_modified t = t.date_modified in
162 let enc_authors t = t.authors in
163 let enc_tags t = t.tags in
164 let enc_language t = t.language in
165 let enc_attachments t = t.attachments in
166 let enc_references t = t.references in
167 let enc_unknown t = t.unknown in
168
169 let unknown_mems :
170 (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
171 let open Jsont.Object.Mems in
172 let dec_empty () = [] in
173 let dec_add _meta (name : string) value acc =
174 ((name, Jsont.Meta.none), value) :: acc
175 in
176 let dec_finish _meta mems =
177 List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
178 in
179 let enc =
180 {
181 enc =
182 (fun (type acc)
183 (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
184 unknown
185 (acc : acc)
186 ->
187 List.fold_left
188 (fun acc (name, value) -> f Jsont.Meta.none name value acc)
189 acc unknown);
190 }
191 in
192 map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
193 in
194
195 Jsont.Object.map ~kind ~doc make_from_json
196 |> Jsont.Object.mem "id" Jsont.string ~enc:enc_id
197 |> Jsont.Object.opt_mem "content_html" Jsont.string ~enc:enc_content_html
198 |> Jsont.Object.opt_mem "content_text" Jsont.string ~enc:enc_content_text
199 |> Jsont.Object.opt_mem "url" Jsont.string ~enc:enc_url
200 |> Jsont.Object.opt_mem "external_url" Jsont.string ~enc:enc_external_url
201 |> Jsont.Object.opt_mem "title" Jsont.string ~enc:enc_title
202 |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:enc_summary
203 |> Jsont.Object.opt_mem "image" Jsont.string ~enc:enc_image
204 |> Jsont.Object.opt_mem "banner_image" Jsont.string ~enc:enc_banner_image
205 |> Jsont.Object.opt_mem "date_published" Rfc3339.jsont ~enc:enc_date_published
206 |> Jsont.Object.opt_mem "date_modified" Rfc3339.jsont ~enc:enc_date_modified
207 |> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:enc_authors
208 |> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:enc_tags
209 |> Jsont.Object.opt_mem "language" Jsont.string ~enc:enc_language
210 |> Jsont.Object.opt_mem "attachments"
211 (Jsont.list Attachment.jsont)
212 ~enc:enc_attachments
213 |> Jsont.Object.opt_mem "_references"
214 (Jsont.list Reference.jsont)
215 ~enc:enc_references
216 |> Jsont.Object.opt_mem "_extensions" Jsont.json_object ~enc:(fun _t -> None)
217 |> Jsont.Object.keep_unknown unknown_mems ~enc:enc_unknown
218 |> Jsont.Object.finish