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 Rfc3339 = Rfc3339
7module Cito = Cito
8module Author = Author
9module Attachment = Attachment
10module Hub = Hub
11module Reference = Reference
12module Item = Item
13
14module Unknown = struct
15 type t = (string * Jsont.json) list
16
17 let empty = []
18 let is_empty = function [] -> true | _ -> false
19end
20
21type t = {
22 version : string;
23 title : string;
24 home_page_url : string option;
25 feed_url : string option;
26 description : string option;
27 user_comment : string option;
28 next_url : string option;
29 icon : string option;
30 favicon : string option;
31 authors : Author.t list option;
32 language : string option;
33 expired : bool option;
34 hubs : Hub.t list option;
35 items : Item.t list;
36 unknown : Unknown.t;
37}
38
39let make ~title ?home_page_url ?feed_url ?description ?user_comment
40 ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items
41 ?(unknown = Unknown.empty) () =
42 {
43 version = "https://jsonfeed.org/version/1.1";
44 title;
45 home_page_url;
46 feed_url;
47 description;
48 user_comment;
49 next_url;
50 icon;
51 favicon;
52 authors;
53 language;
54 expired;
55 hubs;
56 items;
57 unknown;
58 }
59
60let create ~title ?home_page_url ?feed_url ?description ?user_comment
61 ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () =
62 make ~title ?home_page_url ?feed_url ?description ?user_comment
63 ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items ()
64
65let version t = t.version
66let title t = t.title
67let home_page_url t = t.home_page_url
68let feed_url t = t.feed_url
69let description t = t.description
70let user_comment t = t.user_comment
71let next_url t = t.next_url
72let icon t = t.icon
73let favicon t = t.favicon
74let authors t = t.authors
75let language t = t.language
76let expired t = t.expired
77let hubs t = t.hubs
78let items t = t.items
79let unknown t = t.unknown
80
81let equal a b =
82 a.title = b.title &&
83 a.items = b.items
84
85let pp ppf t =
86 Format.fprintf ppf "Feed: %s (%d items)" t.title (List.length t.items)
87
88let pp_summary ppf t =
89 Format.fprintf ppf "%s (%d items)" t.title (List.length t.items)
90
91(* Jsont type *)
92
93let jsont =
94 let kind = "JSON Feed" in
95 let doc = "A JSON Feed document" in
96 let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
97 let open Jsont.Object.Mems in
98 let dec_empty () = [] in
99 let dec_add _meta (name : string) value acc =
100 ((name, Jsont.Meta.none), value) :: acc
101 in
102 let dec_finish _meta mems =
103 List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
104 let enc = {
105 enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
106 List.fold_left (fun acc (name, value) ->
107
108 f Jsont.Meta.none name value acc
109 ) acc unknown
110 } in
111 map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
112 in
113
114 (* Helper constructor that sets version automatically *)
115 let make_from_json _version title home_page_url feed_url description user_comment
116 next_url icon favicon authors language expired hubs items unknown =
117 {
118 version = "https://jsonfeed.org/version/1.1";
119 title;
120 home_page_url;
121 feed_url;
122 description;
123 user_comment;
124 next_url;
125 icon;
126 favicon;
127 authors;
128 language;
129 expired;
130 hubs;
131 items;
132 unknown;
133 }
134 in
135
136 Jsont.Object.map ~kind ~doc make_from_json
137 |> Jsont.Object.mem "version" Jsont.string ~enc:version
138 |> Jsont.Object.mem "title" Jsont.string ~enc:title
139 |> Jsont.Object.opt_mem "home_page_url" Jsont.string ~enc:home_page_url
140 |> Jsont.Object.opt_mem "feed_url" Jsont.string ~enc:feed_url
141 |> Jsont.Object.opt_mem "description" Jsont.string ~enc:description
142 |> Jsont.Object.opt_mem "user_comment" Jsont.string ~enc:user_comment
143 |> Jsont.Object.opt_mem "next_url" Jsont.string ~enc:next_url
144 |> Jsont.Object.opt_mem "icon" Jsont.string ~enc:icon
145 |> Jsont.Object.opt_mem "favicon" Jsont.string ~enc:favicon
146 |> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:authors
147 |> Jsont.Object.opt_mem "language" Jsont.string ~enc:language
148 |> Jsont.Object.opt_mem "expired" Jsont.bool ~enc:expired
149 |> Jsont.Object.opt_mem "hubs" (Jsont.list Hub.jsont) ~enc:hubs
150 |> Jsont.Object.mem "items" (Jsont.list Item.jsont) ~enc:items
151 |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
152 |> Jsont.Object.finish
153
154(* Encoding and Decoding *)
155
156let decode ?layout ?locs ?file r =
157 Jsont_bytesrw.decode' ?layout ?locs ?file jsont r
158
159let decode_string ?layout ?locs ?file s =
160 Jsont_bytesrw.decode_string' ?layout ?locs ?file jsont s
161
162let encode ?format ?number_format feed ~eod w =
163 Jsont_bytesrw.encode' ?format ?number_format jsont feed ~eod w
164
165let encode_string ?format ?number_format feed =
166 Jsont_bytesrw.encode_string' ?format ?number_format jsont feed
167
168let of_string s =
169 decode_string s
170
171let to_string ?(minify=false) feed =
172 let format = if minify then Jsont.Minify else Jsont.Indent in
173 encode_string ~format feed
174
175(* Validation *)
176
177let validate feed =
178 let errors = ref [] in
179 let add_error msg = errors := msg :: !errors in
180
181 (* Check required fields *)
182 if feed.title = "" then
183 add_error "title is required and cannot be empty";
184
185 (* Check items have unique IDs *)
186 let ids = List.map Item.id feed.items in
187 let unique_ids = List.sort_uniq String.compare ids in
188 if List.length ids <> List.length unique_ids then
189 add_error "items must have unique IDs";
190
191 (* Validate authors *)
192 (match feed.authors with
193 | Some authors ->
194 List.iteri (fun i author ->
195 if not (Author.is_valid author) then
196 add_error (Printf.sprintf "feed author %d is invalid (needs at least one field)" i)
197 ) authors
198 | None -> ());
199
200 (* Validate items *)
201 List.iteri (fun i item ->
202 if Item.id item = "" then
203 add_error (Printf.sprintf "item %d has empty ID" i);
204
205 (* Validate item authors *)
206 (match Item.authors item with
207 | Some authors ->
208 List.iteri (fun j author ->
209 if not (Author.is_valid author) then
210 add_error (Printf.sprintf "item %d author %d is invalid" i j)
211 ) authors
212 | None -> ())
213 ) feed.items;
214
215 match !errors with
216 | [] -> Ok ()
217 | errs -> Error (List.rev errs)