+3

.gitignore

··· 1 1 _build 2 2 blog-feed.json 3 3 + *.bak* 4 4 + *.old 5 5 + .*.swp

+22 -14

example/feed_example.ml

··· 10 10 11 11 (* Helper to write feed to output channel *) 12 12 let to_file filename feed = 13 13 - let s = Jsonfeed.to_string feed in 14 14 - Out_channel.with_open_gen 15 15 - [Open_wronly; Open_creat; Open_trunc; Open_text] 16 16 - 0o644 17 17 - filename 18 18 - (fun oc -> Out_channel.output_string oc s) 13 13 + match Jsonfeed.to_string feed with 14 14 + | Ok s -> 15 15 + Out_channel.with_open_gen 16 16 + [Open_wronly; Open_creat; Open_trunc; Open_text] 17 17 + 0o644 18 18 + filename 19 19 + (fun oc -> Out_channel.output_string oc s) 20 20 + | Error e -> 21 21 + Printf.eprintf "Error encoding feed: %s\n" (Jsont.Error.to_string e); 22 22 + exit 1 19 23 20 24 let create_blog_feed () = 21 25 (* Create some authors *) ··· 39 43 "<p>OCaml is a powerful functional programming language.</p>", 40 44 "OCaml is a powerful functional programming language." 41 45 )) 42 42 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get) 43 43 - ~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:30:00Z" |> Option.get) 46 46 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get) 47 47 + ~date_modified:(Jsonfeed.Rfc3339.parse "2024-11-01T15:30:00Z" |> Option.get) 44 48 ~authors:[jane] 45 49 ~tags:["ocaml"; "programming"; "functional"] 46 50 ~summary:"A beginner's guide to OCaml programming" ··· 51 55 ~url:"https://example.com/posts/2" 52 56 ~title:"JSON Feed for Syndication" 53 57 ~content:(`Html "<p>JSON Feed is a modern alternative to RSS and Atom.</p>") 54 54 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-02T09:00:00Z" |> Option.get) 58 58 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-02T09:00:00Z" |> Option.get) 55 59 ~authors:[jane; john] 56 60 ~tags:["json"; "syndication"; "web"] 57 61 ~image:"https://example.com/images/jsonfeed.png" ··· 61 65 let item3 = Item.create 62 66 ~id:"https://example.com/micro/42" 63 67 ~content:(`Text "Just shipped a new feature! 🚀") 64 64 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-03T08:15:00Z" |> Option.get) 68 68 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-03T08:15:00Z" |> Option.get) 65 69 ~tags:["microblog"] 66 70 () in 67 71 ··· 102 106 ~url:"https://podcast.example.com/episodes/1" 103 107 ~title:"Episode 1: Introduction" 104 108 ~content:(`Html "<p>Welcome to our first episode!</p>") 105 105 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get) 109 109 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get) 106 110 ~attachments:[attachment] 107 111 ~authors:[host] 108 112 ~image:"https://podcast.example.com/episodes/ep1-cover.jpg" ··· 134 138 Format.printf "Created blog feed: %a\n\n" Jsonfeed.pp blog_feed; 135 139 136 140 (* Serialize to string *) 137 137 - let json_string = Jsonfeed.to_string blog_feed in 138 138 - Format.printf "JSON (first 200 chars): %s...\n\n" 139 139 - (String.sub json_string 0 (min 200 (String.length json_string))); 141 141 + (match Jsonfeed.to_string blog_feed with 142 142 + | Ok json_string -> 143 143 + Format.printf "JSON (first 200 chars): %s...\n\n" 144 144 + (String.sub json_string 0 (min 200 (String.length json_string))) 145 145 + | Error e -> 146 146 + Printf.eprintf "Error serializing to string: %s\n" (Jsont.Error.to_string e); 147 147 + exit 1); 140 148 141 149 (* Serialize to file *) 142 150 to_file "blog-feed.json" blog_feed;

+16 -12

example/feed_parser.ml

··· 77 77 (match Item.date_published item with 78 78 | Some date -> 79 79 Format.printf " Published: %s\n" 80 80 - (Jsonfeed.format_rfc3339 date) 80 80 + (Jsonfeed.Rfc3339.format date) 81 81 | None -> ()); 82 82 83 83 (match Item.date_modified item with 84 84 | Some date -> 85 85 Format.printf " Modified: %s\n" 86 86 - (Jsonfeed.format_rfc3339 date) 86 86 + (Jsonfeed.Rfc3339.format date) 87 87 | None -> ()); 88 88 89 89 (* Print tags *) ··· 175 175 176 176 (* Demonstrate round-trip parsing *) 177 177 Format.printf "\n=== Round-trip Test ===\n\n"; 178 178 - let json = Jsonfeed.to_string feed in 179 179 - (match Jsonfeed.of_string json with 180 180 - | Ok feed2 -> 181 181 - if Jsonfeed.equal feed feed2 then 182 182 - Format.printf "✓ Round-trip successful: feeds are equal\n" 183 183 - else 184 184 - Format.printf "✗ Round-trip failed: feeds differ\n" 185 185 - | Error err -> 186 186 - Format.eprintf "✗ Round-trip failed: %s\n" err) 178 178 + (match Jsonfeed.to_string feed with 179 179 + | Error e -> 180 180 + Printf.eprintf "Error serializing feed: %s\n" (Jsont.Error.to_string e); 181 181 + exit 1 182 182 + | Ok json -> 183 183 + match Jsonfeed.of_string json with 184 184 + | Ok feed2 -> 185 185 + if Jsonfeed.equal feed feed2 then 186 186 + Format.printf "✓ Round-trip successful: feeds are equal\n" 187 187 + else 188 188 + Format.printf "✗ Round-trip failed: feeds differ\n" 189 189 + | Error err -> 190 190 + Format.eprintf "✗ Round-trip failed: %s\n" (Jsont.Error.to_string err)) 187 191 | Error err -> 188 188 - Format.eprintf "Error parsing feed: %s\n" err 192 192 + Format.eprintf "Error parsing feed: %s\n" (Jsont.Error.to_string err) 189 193 with 190 194 | Sys_error msg -> 191 195 Format.eprintf "Error reading file: %s\n" msg)

+10 -10

example/feed_validator.ml

··· 48 48 ~summary:"A test item" 49 49 ~image:"https://example.com/image.jpg" 50 50 ~banner_image:"https://example.com/banner.jpg" 51 51 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get) 52 52 - ~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:00:00Z" |> Option.get) 51 51 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get) 52 52 + ~date_modified:(Jsonfeed.Rfc3339.parse "2024-11-01T15:00:00Z" |> Option.get) 53 53 ~authors:[author] 54 54 ~tags:["test"; "example"] 55 55 ~language:"en" ··· 90 90 ~id:(Printf.sprintf "https://example.com/items/%d" i) 91 91 ~content:(`Text (Printf.sprintf "Item %d content" i)) 92 92 ~title:(Printf.sprintf "Item %d" i) 93 93 - ~date_published:(Jsonfeed.parse_rfc3339 93 93 + ~date_published:(Jsonfeed.Rfc3339.parse 94 94 (Printf.sprintf "2024-11-%02dT10:00:00Z" (i + 1)) |> Option.get) 95 95 () 96 96 ) in ··· 138 138 ~url:"https://podcast.example.com/episodes/1" 139 139 ~title:"Episode 1: Introduction" 140 140 ~content:(`Html "<p>Welcome to the first episode!</p>") 141 141 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get) 141 141 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get) 142 142 ~authors:[host] 143 143 ~attachments:[episode1; episode1_aac] 144 144 ~image:"https://podcast.example.com/ep1-cover.jpg" ··· 171 171 Item.create 172 172 ~id:"https://micro.example.com/1" 173 173 ~content:(`Text "Just posted a new photo!") 174 174 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T08:00:00Z" |> Option.get) 174 174 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T08:00:00Z" |> Option.get) 175 175 (); 176 176 Item.create 177 177 ~id:"https://micro.example.com/2" 178 178 ~content:(`Text "Having a great day! ☀️") 179 179 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:30:00Z" |> Option.get) 179 179 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:30:00Z" |> Option.get) 180 180 (); 181 181 Item.create 182 182 ~id:"https://micro.example.com/3" 183 183 ~content:(`Html "<p>Check out this <a href=\"#\">link</a></p>") 184 184 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T16:45:00Z" |> Option.get) 184 184 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T16:45:00Z" |> Option.get) 185 185 () 186 186 ] in 187 187 ··· 257 257 (match Jsonfeed.of_string invalid_json1 with 258 258 | Ok _ -> Format.printf "✗ Should have failed (missing version)\n" 259 259 | Error err -> 260 260 - Format.printf "✓ Correctly rejected invalid feed: %s\n" err); 260 260 + Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err)); 261 261 262 262 (* Missing required title field *) 263 263 let invalid_json2 = {|{ ··· 268 268 (match Jsonfeed.of_string invalid_json2 with 269 269 | Ok _ -> Format.printf "✗ Should have failed (missing title)\n" 270 270 | Error err -> 271 271 - Format.printf "✓ Correctly rejected invalid feed: %s\n" err); 271 271 + Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err)); 272 272 273 273 (* Item without id *) 274 274 let invalid_json3 = {|{ ··· 282 282 (match Jsonfeed.of_string invalid_json3 with 283 283 | Ok _ -> Format.printf "✗ Should have failed (item without id)\n" 284 284 | Error err -> 285 285 - Format.printf "✓ Correctly rejected invalid feed: %s\n" err); 285 285 + Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err)); 286 286 287 287 Format.printf "\n" 288 288

+49 -2

lib/attachment.ml

··· 1 1 - (** Attachments for JSON Feed items. *) 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + module Unknown = struct 7 7 + type t = (string * Jsont.json) list 8 8 + 9 9 + let empty = [] 10 10 + let is_empty = function [] -> true | _ -> false 11 11 + end 2 12 3 13 type t = { 4 14 url : string; ··· 6 16 title : string option; 7 17 size_in_bytes : int64 option; 8 18 duration_in_seconds : int option; 19 19 + unknown : Unknown.t; 9 20 } 10 21 22 22 + let make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ?(unknown = Unknown.empty) () = 23 23 + { url; mime_type; title; size_in_bytes; duration_in_seconds; unknown } 24 24 + 11 25 let create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds () = 12 12 - { url; mime_type; title; size_in_bytes; duration_in_seconds } 26 26 + make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds () 13 27 14 28 let url t = t.url 15 29 let mime_type t = t.mime_type 16 30 let title t = t.title 17 31 let size_in_bytes t = t.size_in_bytes 18 32 let duration_in_seconds t = t.duration_in_seconds 33 33 + let unknown t = t.unknown 19 34 20 35 let equal a b = 21 36 a.url = b.url && ··· 49 64 | None -> ()); 50 65 51 66 Format.fprintf ppf ")" 67 67 + 68 68 + let jsont = 69 69 + let kind = "Attachment" in 70 70 + let doc = "An attachment object" in 71 71 + let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 72 72 + let open Jsont.Object.Mems in 73 73 + let dec_empty () = [] in 74 74 + let dec_add _meta (name : string) value acc = 75 75 + ((name, Jsont.Meta.none), value) :: acc 76 76 + in 77 77 + let dec_finish _meta mems = 78 78 + List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in 79 79 + let enc = { 80 80 + enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) -> 81 81 + List.fold_left (fun acc (name, value) -> 82 82 + 83 83 + f Jsont.Meta.none name value acc 84 84 + ) acc unknown 85 85 + } in 86 86 + map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc 87 87 + in 88 88 + let make_obj url mime_type title size_in_bytes duration_in_seconds unknown = 89 89 + make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ~unknown () 90 90 + in 91 91 + Jsont.Object.map ~kind ~doc make_obj 92 92 + |> Jsont.Object.mem "url" Jsont.string ~enc:url 93 93 + |> Jsont.Object.mem "mime_type" Jsont.string ~enc:mime_type 94 94 + |> Jsont.Object.opt_mem "title" Jsont.string ~enc:title 95 95 + |> Jsont.Object.opt_mem "size_in_bytes" Jsont.int64 ~enc:size_in_bytes 96 96 + |> Jsont.Object.opt_mem "duration_in_seconds" Jsont.int ~enc:duration_in_seconds 97 97 + |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown 98 98 + |> Jsont.Object.finish

+51 -16

lib/attachment.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 1 6 (** Attachments for JSON Feed items. 2 7 3 8 An attachment represents an external resource related to a feed item, ··· 11 16 type t 12 17 13 18 19 19 + (** {1 Unknown Fields} *) 20 20 + 21 21 + module Unknown : sig 22 22 + type t = (string * Jsont.json) list 23 23 + (** Unknown/unrecognized JSON object members. 24 24 + Useful for preserving fields from custom extensions or future spec versions. *) 25 25 + 26 26 + val empty : t 27 27 + (** [empty] is the empty list of unknown fields. *) 28 28 + 29 29 + val is_empty : t -> bool 30 30 + (** [is_empty u] returns [true] if there are no unknown fields. *) 31 31 + end 32 32 + 33 33 + 34 34 + (** {1 Jsont Type} *) 35 35 + 36 36 + val jsont : t Jsont.t 37 37 + (** Declarative JSON type for attachments. 38 38 + 39 39 + Maps JSON objects with "url" (required), "mime_type" (required), 40 40 + and optional "title", "size_in_bytes", "duration_in_seconds" fields. *) 41 41 + 42 42 + 14 43 (** {1 Construction} *) 15 44 45 45 + val create : 46 46 + url:string -> 47 47 + mime_type:string -> 48 48 + ?title:string -> 49 49 + ?size_in_bytes:int64 -> 50 50 + ?duration_in_seconds:int -> 51 51 + unit -> 52 52 + t 16 53 (** [create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()] 17 54 creates an attachment object. 18 55 ··· 37 74 ~title:"Episode 42" 38 75 ~size_in_bytes:15_728_640L 39 76 ~duration_in_seconds:1800 () 40 40 - 41 41 - (* Alternate format (same title indicates same content) *) 42 42 - let att2 = Attachment.create 43 43 - ~url:"https://example.com/episode.aac" 44 44 - ~mime_type:"audio/aac" 45 45 - ~title:"Episode 42" 46 46 - ~size_in_bytes:12_582_912L 47 47 - ~duration_in_seconds:1800 () 48 77 ]} *) 49 49 - val create : 78 78 + 79 79 + val make : 50 80 url:string -> 51 81 mime_type:string -> 52 82 ?title:string -> 53 83 ?size_in_bytes:int64 -> 54 84 ?duration_in_seconds:int -> 85 85 + ?unknown:Unknown.t -> 55 86 unit -> 56 87 t 88 88 + (** [make] is like {!create} but allows setting unknown fields. *) 57 89 58 90 59 91 (** {1 Accessors} *) 60 92 93 93 + val url : t -> string 61 94 (** [url t] returns the attachment's URL. *) 62 62 - val url : t -> string 63 95 64 64 - (** [mime_type t] returns the attachment's MIME type. *) 65 96 val mime_type : t -> string 97 97 + (** [mime_type t] returns the attachment's MIME type. *) 66 98 67 67 - (** [title t] returns the attachment's title, if set. *) 68 99 val title : t -> string option 100 100 + (** [title t] returns the attachment's title, if set. *) 69 101 70 70 - (** [size_in_bytes t] returns the attachment's size in bytes, if set. *) 71 102 val size_in_bytes : t -> int64 option 103 103 + (** [size_in_bytes t] returns the attachment's size in bytes, if set. *) 72 104 73 73 - (** [duration_in_seconds t] returns the attachment's duration, if set. *) 74 105 val duration_in_seconds : t -> int option 106 106 + (** [duration_in_seconds t] returns the attachment's duration, if set. *) 107 107 + 108 108 + val unknown : t -> Unknown.t 109 109 + (** [unknown t] returns unrecognized fields from the JSON. *) 75 110 76 111 77 112 (** {1 Comparison} *) 78 113 79 79 - (** [equal a b] tests equality between two attachments. *) 80 114 val equal : t -> t -> bool 115 115 + (** [equal a b] tests equality between two attachments. *) 81 116 82 117 83 118 (** {1 Pretty Printing} *) 84 119 120 120 + val pp : Format.formatter -> t -> unit 85 121 (** [pp ppf t] pretty prints an attachment to the formatter. 86 122 87 123 The output is human-readable and suitable for debugging. 88 124 89 125 {b Example output:} 90 126 {v episode.mp3 (audio/mpeg, 15.0 MB, 30m0s) v} *) 91 91 - val pp : Format.formatter -> t -> unit

+50 -3

lib/author.ml

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

+46 -8

lib/author.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 1 6 (** Author information for JSON Feed items and feeds. 2 7 3 8 An author object provides information about the creator of a feed or item. ··· 11 16 type t 12 17 13 18 19 19 + (** {1 Unknown Fields} *) 20 20 + 21 21 + module Unknown : sig 22 22 + type t = (string * Jsont.json) list 23 23 + (** Unknown/unrecognized JSON object members. 24 24 + Useful for preserving fields from custom extensions or future spec versions. *) 25 25 + 26 26 + val empty : t 27 27 + (** [empty] is the empty list of unknown fields. *) 28 28 + 29 29 + val is_empty : t -> bool 30 30 + (** [is_empty u] returns [true] if there are no unknown fields. *) 31 31 + end 32 32 + 33 33 + 34 34 + (** {1 Jsont Type} *) 35 35 + 36 36 + val jsont : t Jsont.t 37 37 + (** Declarative JSON type for authors. 38 38 + 39 39 + Maps JSON objects with optional "name", "url", and "avatar" fields. 40 40 + At least one field must be present during decoding. *) 41 41 + 42 42 + 14 43 (** {1 Construction} *) 15 44 16 16 - (** [create ?name ?url ?avatar ()] creates an author object. 45 45 + val create : ?name:string -> ?url:string -> ?avatar:string -> unit -> t 46 46 + (** [create ?name ?url ?avatar ()] creates an author. 17 47 18 48 At least one of the optional parameters must be provided, otherwise 19 49 the function will raise [Invalid_argument]. ··· 31 61 ~url:"https://janedoe.com" 32 62 ~avatar:"https://janedoe.com/avatar.png" () 33 63 ]} *) 34 34 - val create : ?name:string -> ?url:string -> ?avatar:string -> unit -> t 64 64 + 65 65 + val make : 66 66 + ?name:string -> ?url:string -> ?avatar:string -> 67 67 + ?unknown:Unknown.t -> unit -> t 68 68 + (** [make] is like {!create} but allows setting unknown fields. 69 69 + Useful when round-tripping JSON with custom extensions. *) 35 70 36 71 37 72 (** {1 Accessors} *) 38 73 74 74 + val name : t -> string option 39 75 (** [name t] returns the author's name, if set. *) 40 40 - val name : t -> string option 41 76 42 42 - (** [url t] returns the author's URL, if set. *) 43 77 val url : t -> string option 78 78 + (** [url t] returns the author's URL, if set. *) 44 79 80 80 + val avatar : t -> string option 45 81 (** [avatar t] returns the author's avatar URL, if set. *) 46 46 - val avatar : t -> string option 82 82 + 83 83 + val unknown : t -> Unknown.t 84 84 + (** [unknown t] returns unrecognized fields from the JSON. *) 47 85 48 86 49 87 (** {1 Predicates} *) 50 88 89 89 + val is_valid : t -> bool 51 90 (** [is_valid t] checks if the author has at least one field set. 52 91 53 92 This should always return [true] for authors created via {!create}, 54 93 but may be useful when parsing from external sources. *) 55 55 - val is_valid : t -> bool 56 94 57 95 58 96 (** {1 Comparison} *) 59 97 60 60 - (** [equal a b] tests equality between two authors. *) 61 98 val equal : t -> t -> bool 99 99 + (** [equal a b] tests equality between two authors. *) 62 100 63 101 64 102 (** {1 Pretty Printing} *) 65 103 104 104 + val pp : Format.formatter -> t -> unit 66 105 (** [pp ppf t] pretty prints an author to the formatter. 67 106 68 107 The output is human-readable and suitable for debugging. 69 108 70 109 {b Example output:} 71 110 {v Jane Doe <https://janedoe.com> v} *) 72 72 - val pp : Format.formatter -> t -> unit

+7

lib/cito.ml

··· 159 159 | _ -> a = b 160 160 161 161 let pp ppf t = Format.fprintf ppf "%s" (to_string t) 162 162 + 163 163 + let jsont = 164 164 + let kind = "CiTO intent" in 165 165 + let doc = "A Citation Typing Ontology intent annotation" in 166 166 + let dec = of_string in 167 167 + let enc = to_string in 168 168 + Jsont.map ~kind ~doc ~dec ~enc Jsont.string

+9

lib/cito.mli

··· 142 142 val equal : t -> t -> bool 143 143 144 144 145 145 + (** {1 Jsont Type} *) 146 146 + 147 147 + val jsont : t Jsont.t 148 148 + (** Declarative JSON type for CiTO annotations. 149 149 + 150 150 + Maps CiTO intent strings to the corresponding variants. 151 151 + Unknown intents are mapped to [`Other s]. *) 152 152 + 153 153 + 145 154 (** {1 Pretty Printing} *) 146 155 147 156 (** [pp ppf t] pretty prints a CiTO annotation to the formatter.

+1 -1

lib/dune

··· 1 1 (library 2 2 (name jsonfeed) 3 3 (public_name jsonfeed) 4 4 - (libraries jsonm ptime fmt)) 4 4 + (libraries jsont jsont.bytesrw bytesrw ptime))

+43 -2

lib/hub.ml

··· 1 1 - (** Hub endpoints for real-time notifications. *) 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + module Unknown = struct 7 7 + type t = (string * Jsont.json) list 8 8 + 9 9 + let empty = [] 10 10 + let is_empty = function [] -> true | _ -> false 11 11 + end 2 12 3 13 type t = { 4 14 type_ : string; 5 15 url : string; 16 16 + unknown : Unknown.t; 6 17 } 7 18 19 19 + let make ~type_ ~url ?(unknown = Unknown.empty) () = 20 20 + { type_; url; unknown } 21 21 + 8 22 let create ~type_ ~url () = 9 9 - { type_; url } 23 23 + make ~type_ ~url () 10 24 11 25 let type_ t = t.type_ 12 26 let url t = t.url 27 27 + let unknown t = t.unknown 13 28 14 29 let equal a b = 15 30 a.type_ = b.type_ && a.url = b.url 16 31 17 32 let pp ppf t = 18 33 Format.fprintf ppf "%s: %s" t.type_ t.url 34 34 + 35 35 + let jsont = 36 36 + let kind = "Hub" in 37 37 + let doc = "A hub endpoint" in 38 38 + let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 39 39 + let open Jsont.Object.Mems in 40 40 + let dec_empty () = [] in 41 41 + let dec_add _meta (name : string) value acc = 42 42 + ((name, Jsont.Meta.none), value) :: acc 43 43 + in 44 44 + let dec_finish _meta mems = 45 45 + List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in 46 46 + let enc = { 47 47 + enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) -> 48 48 + List.fold_left (fun acc (name, value) -> 49 49 + f Jsont.Meta.none name value acc 50 50 + ) acc unknown 51 51 + } in 52 52 + map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc 53 53 + in 54 54 + let make_obj type_ url unknown = make ~type_ ~url ~unknown () in 55 55 + Jsont.Object.map ~kind ~doc make_obj 56 56 + |> Jsont.Object.mem "type" Jsont.string ~enc:type_ 57 57 + |> Jsont.Object.mem "url" Jsont.string ~enc:url 58 58 + |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown 59 59 + |> Jsont.Object.finish

+41 -5

lib/hub.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 1 6 (** Hub endpoints for real-time notifications. 2 7 3 8 Hubs describe endpoints that can be used to subscribe to real-time ··· 11 16 type t 12 17 13 18 19 19 + (** {1 Unknown Fields} *) 20 20 + 21 21 + module Unknown : sig 22 22 + type t = (string * Jsont.json) list 23 23 + (** Unknown/unrecognized JSON object members. 24 24 + Useful for preserving fields from custom extensions or future spec versions. *) 25 25 + 26 26 + val empty : t 27 27 + (** [empty] is the empty list of unknown fields. *) 28 28 + 29 29 + val is_empty : t -> bool 30 30 + (** [is_empty u] returns [true] if there are no unknown fields. *) 31 31 + end 32 32 + 33 33 + 34 34 + (** {1 Jsont Type} *) 35 35 + 36 36 + val jsont : t Jsont.t 37 37 + (** Declarative JSON type for hubs. 38 38 + 39 39 + Maps JSON objects with "type" and "url" fields (both required). *) 40 40 + 41 41 + 14 42 (** {1 Construction} *) 15 43 44 44 + val create : type_:string -> url:string -> unit -> t 16 45 (** [create ~type_ ~url ()] creates a hub object. 17 46 18 47 @param type_ The type of hub protocol (e.g., ["rssCloud"], ["WebSub"]) ··· 24 53 ~type_:"WebSub" 25 54 ~url:"https://pubsubhubbub.appspot.com/" () 26 55 ]} *) 27 27 - val create : type_:string -> url:string -> unit -> t 56 56 + 57 57 + val make : 58 58 + type_:string -> url:string -> 59 59 + ?unknown:Unknown.t -> unit -> t 60 60 + (** [make] is like {!create} but allows setting unknown fields. *) 28 61 29 62 30 63 (** {1 Accessors} *) 31 64 32 32 - (** [type_ t] returns the hub's protocol type. *) 33 65 val type_ : t -> string 66 66 + (** [type_ t] returns the hub's protocol type. *) 34 67 68 68 + val url : t -> string 35 69 (** [url t] returns the hub's endpoint URL. *) 36 36 - val url : t -> string 70 70 + 71 71 + val unknown : t -> Unknown.t 72 72 + (** [unknown t] returns unrecognized fields from the JSON. *) 37 73 38 74 39 75 (** {1 Comparison} *) 40 76 41 41 - (** [equal a b] tests equality between two hubs. *) 42 77 val equal : t -> t -> bool 78 78 + (** [equal a b] tests equality between two hubs. *) 43 79 44 80 45 81 (** {1 Pretty Printing} *) 46 82 83 83 + val pp : Format.formatter -> t -> unit 47 84 (** [pp ppf t] pretty prints a hub to the formatter. 48 85 49 86 The output is human-readable and suitable for debugging. 50 87 51 88 {b Example output:} 52 89 {v WebSub: https://pubsubhubbub.appspot.com/ v} *) 53 53 - val pp : Format.formatter -> t -> unit

+116 -36

lib/item.ml

··· 1 1 - (** Feed items in a JSON Feed. *) 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + module Unknown = struct 7 7 + type t = (string * Jsont.json) list 8 8 + 9 9 + let empty = [] 10 10 + let is_empty = function [] -> true | _ -> false 11 11 + end 2 12 3 3 - type content = 4 4 - [ `Html of string 13 13 + type content = [ 14 14 + | `Html of string 5 15 | `Text of string 6 16 | `Both of string * string 7 7 - ] 17 17 + ] 8 18 9 19 type t = { 10 20 id : string; ··· 22 32 language : string option; 23 33 attachments : Attachment.t list option; 24 34 references : Reference.t list option; 35 35 + unknown : Unknown.t; 25 36 } 26 37 27 27 - let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image 28 28 - ?date_published ?date_modified ?authors ?tags ?language ?attachments ?references () = 38 38 + let make ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image 39 39 + ?date_published ?date_modified ?authors ?tags ?language ?attachments ?references 40 40 + ?(unknown = Unknown.empty) () = 29 41 { 30 30 - id; 31 31 - content; 32 32 - url; 33 33 - external_url; 34 34 - title; 35 35 - summary; 36 36 - image; 37 37 - banner_image; 38 38 - date_published; 39 39 - date_modified; 40 40 - authors; 41 41 - tags; 42 42 - language; 43 43 - attachments; 44 44 - references; 42 42 + id; content; url; external_url; title; summary; image; banner_image; 43 43 + date_published; date_modified; authors; tags; language; attachments; references; 44 44 + unknown; 45 45 } 46 46 + 47 47 + let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image 48 48 + ?date_published ?date_modified ?authors ?tags ?language ?attachments ?references () = 49 49 + make ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image 50 50 + ?date_published ?date_modified ?authors ?tags ?language ?attachments ?references () 46 51 47 52 let id t = t.id 48 53 let content t = t.content ··· 59 64 let language t = t.language 60 65 let attachments t = t.attachments 61 66 let references t = t.references 67 67 + let unknown t = t.unknown 62 68 63 69 let content_html t = 64 70 match t.content with ··· 72 78 | `Text text -> Some text 73 79 | `Both (_, text) -> Some text 74 80 75 75 - let equal a b = 76 76 - (* Items are equal if they have the same ID *) 77 77 - a.id = b.id 81 81 + let equal a b = a.id = b.id 78 82 79 83 let compare a b = 80 80 - (* Compare by publication date, with items without dates considered older *) 81 84 match a.date_published, b.date_published with 82 85 | None, None -> 0 83 83 - | None, Some _ -> -1 (* Items without dates are "older" *) 86 86 + | None, Some _ -> -1 84 87 | Some _, None -> 1 85 88 | Some da, Some db -> Ptime.compare da db 86 89 87 87 - let pp_content ppf = function 88 88 - | `Html html -> 89 89 - Format.fprintf ppf "HTML (%d chars)" (String.length html) 90 90 - | `Text text -> 91 91 - Format.fprintf ppf "Text (%d chars)" (String.length text) 92 92 - | `Both (html, text) -> 93 93 - Format.fprintf ppf "Both (HTML: %d chars, Text: %d chars)" 94 94 - (String.length html) (String.length text) 95 95 - 96 90 let pp ppf t = 97 91 match t.date_published, t.title with 98 92 | Some date, Some title -> 99 99 - (* Use Ptime's date formatting *) 100 93 let (y, m, d), _ = Ptime.to_date_time date in 101 94 Format.fprintf ppf "[%04d-%02d-%02d] %s (%s)" y m d title t.id 102 95 | Some date, None -> ··· 106 99 Format.fprintf ppf "%s (%s)" title t.id 107 100 | None, None -> 108 101 Format.fprintf ppf "%s" t.id 102 102 + 103 103 + let pp_summary ppf t = 104 104 + match t.title with 105 105 + | Some title -> Format.fprintf ppf "%s" title 106 106 + | None -> Format.fprintf ppf "%s" t.id 107 107 + 108 108 + (* Jsont type *) 109 109 + 110 110 + let jsont = 111 111 + let kind = "Item" in 112 112 + let doc = "A JSON Feed item" in 113 113 + 114 114 + (* Helper to construct item from JSON fields *) 115 115 + let make_from_json id content_html content_text url external_url title summary 116 116 + image banner_image date_published date_modified authors tags language 117 117 + attachments references _extensions unknown = 118 118 + (* Determine content from content_html and content_text *) 119 119 + let content = match content_html, content_text with 120 120 + | Some html, Some text -> `Both (html, text) 121 121 + | Some html, None -> `Html html 122 122 + | None, Some text -> `Text text 123 123 + | None, None -> 124 124 + Jsont.Error.msg Jsont.Meta.none 125 125 + "Item must have at least one of content_html or content_text" 126 126 + in 127 127 + { id; content; url; external_url; title; summary; image; banner_image; 128 128 + date_published; date_modified; authors; tags; language; attachments; 129 129 + references; unknown } 130 130 + in 131 131 + 132 132 + (* Encoders to extract fields from item *) 133 133 + let enc_id t = t.id in 134 134 + let enc_content_html t = content_html t in 135 135 + let enc_content_text t = content_text t in 136 136 + let enc_url t = t.url in 137 137 + let enc_external_url t = t.external_url in 138 138 + let enc_title t = t.title in 139 139 + let enc_summary t = t.summary in 140 140 + let enc_image t = t.image in 141 141 + let enc_banner_image t = t.banner_image in 142 142 + let enc_date_published t = t.date_published in 143 143 + let enc_date_modified t = t.date_modified in 144 144 + let enc_authors t = t.authors in 145 145 + let enc_tags t = t.tags in 146 146 + let enc_language t = t.language in 147 147 + let enc_attachments t = t.attachments in 148 148 + let enc_references t = t.references in 149 149 + let enc_unknown t = t.unknown in 150 150 + 151 151 + let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 152 152 + let open Jsont.Object.Mems in 153 153 + let dec_empty () = [] in 154 154 + let dec_add _meta (name : string) value acc = 155 155 + ((name, Jsont.Meta.none), value) :: acc 156 156 + in 157 157 + let dec_finish _meta mems = 158 158 + List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in 159 159 + let enc = { 160 160 + enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) -> 161 161 + List.fold_left (fun acc (name, value) -> 162 162 + 163 163 + f Jsont.Meta.none name value acc 164 164 + ) acc unknown 165 165 + } in 166 166 + map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc 167 167 + in 168 168 + 169 169 + Jsont.Object.map ~kind ~doc make_from_json 170 170 + |> Jsont.Object.mem "id" Jsont.string ~enc:enc_id 171 171 + |> Jsont.Object.opt_mem "content_html" Jsont.string ~enc:enc_content_html 172 172 + |> Jsont.Object.opt_mem "content_text" Jsont.string ~enc:enc_content_text 173 173 + |> Jsont.Object.opt_mem "url" Jsont.string ~enc:enc_url 174 174 + |> Jsont.Object.opt_mem "external_url" Jsont.string ~enc:enc_external_url 175 175 + |> Jsont.Object.opt_mem "title" Jsont.string ~enc:enc_title 176 176 + |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:enc_summary 177 177 + |> Jsont.Object.opt_mem "image" Jsont.string ~enc:enc_image 178 178 + |> Jsont.Object.opt_mem "banner_image" Jsont.string ~enc:enc_banner_image 179 179 + |> Jsont.Object.opt_mem "date_published" Rfc3339.jsont ~enc:enc_date_published 180 180 + |> Jsont.Object.opt_mem "date_modified" Rfc3339.jsont ~enc:enc_date_modified 181 181 + |> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:enc_authors 182 182 + |> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:enc_tags 183 183 + |> Jsont.Object.opt_mem "language" Jsont.string ~enc:enc_language 184 184 + |> Jsont.Object.opt_mem "attachments" (Jsont.list Attachment.jsont) ~enc:enc_attachments 185 185 + |> Jsont.Object.opt_mem "_references" (Jsont.list Reference.jsont) ~enc:enc_references 186 186 + |> Jsont.Object.opt_mem "_extensions" Jsont.json_object ~enc:(fun _t -> None) 187 187 + |> Jsont.Object.keep_unknown unknown_mems ~enc:enc_unknown 188 188 + |> Jsont.Object.finish

+51 -129

lib/item.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 1 6 (** Feed items in a JSON Feed. 2 7 3 8 An item represents a single entry in a feed, such as a blog post, podcast episode, ··· 17 22 - [`Html s]: Item has HTML content only 18 23 - [`Text s]: Item has plain text content only 19 24 - [`Both (html, text)]: Item has both HTML and plain text versions *) 20 20 - type content = 21 21 - [ `Html of string 25 25 + type content = [ 26 26 + | `Html of string 22 27 | `Text of string 23 28 | `Both of string * string 24 24 - ] 29 29 + ] 25 30 26 31 27 27 - (** {1 Construction} *) 32 32 + (** {1 Unknown Fields} *) 28 33 29 29 - (** [create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image 30 30 - ?date_published ?date_modified ?authors ?tags ?language ?attachments ()] 31 31 - creates a feed item. 34 34 + module Unknown : sig 35 35 + type t = (string * Jsont.json) list 36 36 + (** Unknown/unrecognized JSON object members. 37 37 + Useful for preserving fields from custom extensions or future spec versions. *) 32 38 33 33 - @param id Unique identifier for the item (required). Should be a full URL if possible. 34 34 - @param content The item's content in HTML and/or plain text (required) 35 35 - @param url Permalink to the item 36 36 - @param external_url URL of an external resource (useful for linkblogs) 37 37 - @param title Plain text title of the item 38 38 - @param summary Plain text summary/excerpt of the item 39 39 - @param image URL of the main featured image for the item 40 40 - @param banner_image URL of a banner image for the item 41 41 - @param date_published Publication date/time (RFC 3339 format) 42 42 - @param date_modified Last modification date/time (RFC 3339 format) 43 43 - @param authors Item-specific authors (overrides feed-level authors) 44 44 - @param tags Plain text tags/categories for the item 45 45 - @param language Primary language of the item (RFC 5646 format, e.g. ["en-US"]) 46 46 - @param attachments Related resources like audio files or downloads 47 47 - @param references References to cited sources (extension) 39 39 + val empty : t 40 40 + (** [empty] is the empty list of unknown fields. *) 48 41 49 49 - {b Examples:} 50 50 - {[ 51 51 - (* Simple blog post *) 52 52 - let item = Item.create 53 53 - ~id:"https://example.com/posts/42" 54 54 - ~content:(`Html "<p>Hello, world!</p>") 55 55 - ~title:"My First Post" 56 56 - ~url:"https://example.com/posts/42" () 42 42 + val is_empty : t -> bool 43 43 + (** [is_empty u] returns [true] if there are no unknown fields. *) 44 44 + end 57 45 58 58 - (* Microblog entry with plain text *) 59 59 - let item = Item.create 60 60 - ~id:"https://example.com/micro/123" 61 61 - ~content:(`Text "Just posted a new photo!") 62 62 - ~date_published:(Ptime.of_float_s (Unix.time ()) |> Option.get) () 46 46 + 47 47 + (** {1 Jsont Type} *) 48 48 + 49 49 + val jsont : t Jsont.t 50 50 + (** Declarative JSON type for feed items. 51 51 + 52 52 + Maps JSON objects with "id" (required), content fields, and various optional metadata. 53 53 + The content must have at least one of "content_html" or "content_text". *) 63 54 64 64 - (* Article with both HTML and plain text *) 65 65 - let item = Item.create 66 66 - ~id:"https://example.com/article/99" 67 67 - ~content:(`Both ("<p>Rich content</p>", "Plain version")) 68 68 - ~title:"Article Title" 69 69 - ~tags:["ocaml"; "programming"] () 70 55 71 71 - (* Podcast episode with attachment *) 72 72 - let attachment = Attachment.create 73 73 - ~url:"https://example.com/ep1.mp3" 74 74 - ~mime_type:"audio/mpeg" 75 75 - ~duration_in_seconds:1800 () in 76 76 - let item = Item.create 77 77 - ~id:"https://example.com/podcast/1" 78 78 - ~content:(`Html "<p>Episode description</p>") 79 79 - ~title:"Episode 1" 80 80 - ~attachments:[attachment] () 56 56 + (** {1 Construction} *) 81 57 82 82 - (* Article with references *) 83 83 - let reference = Reference.create 84 84 - ~url:"https://doi.org/10.5281/zenodo.16755947" 85 85 - ~doi:"10.5281/zenodo.16755947" 86 86 - ~cito:[`CitesAsRecommendedReading; `UsesMethodIn] () in 87 87 - let item = Item.create 88 88 - ~id:"https://doi.org/10.59350/krw9n-dv417" 89 89 - ~content:(`Html "<p>Research article content</p>") 90 90 - ~title:"One Million IUPAC names #4: a lot is happening" 91 91 - ~url:"https://chem-bla-ics.linkedchemistry.info/2025/08/09/one-million-iupac-names-4.html" 92 92 - ~references:[reference] () 93 93 - ]} *) 94 58 val create : 95 59 id:string -> 96 60 content:content -> ··· 110 74 unit -> 111 75 t 112 76 77 77 + val make : 78 78 + id:string -> 79 79 + content:content -> 80 80 + ?url:string -> 81 81 + ?external_url:string -> 82 82 + ?title:string -> 83 83 + ?summary:string -> 84 84 + ?image:string -> 85 85 + ?banner_image:string -> 86 86 + ?date_published:Ptime.t -> 87 87 + ?date_modified:Ptime.t -> 88 88 + ?authors:Author.t list -> 89 89 + ?tags:string list -> 90 90 + ?language:string -> 91 91 + ?attachments:Attachment.t list -> 92 92 + ?references:Reference.t list -> 93 93 + ?unknown:Unknown.t -> 94 94 + unit -> 95 95 + t 96 96 + 113 97 114 98 (** {1 Accessors} *) 115 99 116 116 - (** [id t] returns the item's unique identifier. *) 117 100 val id : t -> string 118 118 - 119 119 - (** [content t] returns the item's content. *) 120 101 val content : t -> content 121 121 - 122 122 - (** [url t] returns the item's permalink URL, if set. *) 102 102 + val content_html : t -> string option 103 103 + val content_text : t -> string option 123 104 val url : t -> string option 124 124 - 125 125 - (** [external_url t] returns the external resource URL, if set. *) 126 105 val external_url : t -> string option 127 127 - 128 128 - (** [title t] returns the item's title, if set. *) 129 106 val title : t -> string option 130 130 - 131 131 - (** [summary t] returns the item's summary, if set. *) 132 107 val summary : t -> string option 133 133 - 134 134 - (** [image t] returns the item's featured image URL, if set. *) 135 108 val image : t -> string option 136 136 - 137 137 - (** [banner_image t] returns the item's banner image URL, if set. *) 138 109 val banner_image : t -> string option 139 139 - 140 140 - (** [date_published t] returns the item's publication date, if set. *) 141 110 val date_published : t -> Ptime.t option 142 142 - 143 143 - (** [date_modified t] returns the item's last modification date, if set. *) 144 111 val date_modified : t -> Ptime.t option 145 145 - 146 146 - (** [authors t] returns the item's authors, if set. *) 147 112 val authors : t -> Author.t list option 148 148 - 149 149 - (** [tags t] returns the item's tags, if set. *) 150 113 val tags : t -> string list option 151 151 - 152 152 - (** [language t] returns the item's language code, if set. *) 153 114 val language : t -> string option 154 154 - 155 155 - (** [attachments t] returns the item's attachments, if set. *) 156 115 val attachments : t -> Attachment.t list option 157 157 - 158 158 - (** [references t] returns the item's references, if set. *) 159 116 val references : t -> Reference.t list option 160 160 - 161 161 - 162 162 - (** {1 Content Helpers} *) 163 163 - 164 164 - (** [content_html t] extracts HTML content from the item. 165 165 - 166 166 - Returns [Some html] if the item has HTML content (either [Html] or [Both]), 167 167 - [None] otherwise. *) 168 168 - val content_html : t -> string option 169 169 - 170 170 - (** [content_text t] extracts plain text content from the item. 171 171 - 172 172 - Returns [Some text] if the item has plain text content (either [Text] or [Both]), 173 173 - [None] otherwise. *) 174 174 - val content_text : t -> string option 117 117 + val unknown : t -> Unknown.t 175 118 176 119 177 120 (** {1 Comparison} *) 178 121 179 179 - (** [equal a b] tests equality between two items. 180 180 - 181 181 - Items are considered equal if they have the same ID. *) 182 122 val equal : t -> t -> bool 183 183 - 184 184 - (** [compare a b] compares two items by their publication dates. 185 185 - 186 186 - Items without publication dates are considered older than items with dates. 187 187 - Useful for sorting items chronologically. *) 188 123 val compare : t -> t -> int 189 124 190 125 191 126 (** {1 Pretty Printing} *) 192 127 193 193 - (** [pp ppf t] pretty prints an item to the formatter. 194 194 - 195 195 - The output is human-readable and suitable for debugging. 196 196 - 197 197 - {b Example output:} 198 198 - {v [2024-11-03] My First Post (https://example.com/posts/42) v} *) 199 128 val pp : Format.formatter -> t -> unit 200 200 - 201 201 - (** [pp_content ppf content] pretty prints content to the formatter. 202 202 - 203 203 - {b Example output:} 204 204 - {v HTML (123 chars) v} 205 205 - {v Text (56 chars) v} 206 206 - {v Both (HTML: 123 chars, Text: 56 chars) v} *) 207 207 - val pp_content : Format.formatter -> content -> unit 129 129 + val pp_summary : Format.formatter -> t -> unit

+104 -490

lib/jsonfeed.ml

··· 1 1 - (** JSON Feed format parser and serializer. *) 2 2 - 3 3 - exception Invalid_feed of string 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 4 5 6 6 + module Rfc3339 = Rfc3339 7 7 + module Cito = Cito 5 8 module Author = Author 6 9 module Attachment = Attachment 7 10 module Hub = Hub 11 11 + module Reference = Reference 8 12 module Item = Item 9 9 - module Reference = Reference 10 10 - module Cito = Cito 13 13 + 14 14 + module Unknown = struct 15 15 + type t = (string * Jsont.json) list 16 16 + 17 17 + let empty = [] 18 18 + let is_empty = function [] -> true | _ -> false 19 19 + end 11 20 12 21 type t = { 13 22 version : string; ··· 24 33 expired : bool option; 25 34 hubs : Hub.t list option; 26 35 items : Item.t list; 36 36 + unknown : Unknown.t; 27 37 } 28 38 29 29 - let create ~title ?home_page_url ?feed_url ?description ?user_comment 30 30 - ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () = 39 39 + let make ~title ?home_page_url ?feed_url ?description ?user_comment 40 40 + ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items 41 41 + ?(unknown = Unknown.empty) () = 31 42 { 32 43 version = "https://jsonfeed.org/version/1.1"; 33 44 title; ··· 43 54 expired; 44 55 hubs; 45 56 items; 57 57 + unknown; 46 58 } 47 59 60 60 + let create ~title ?home_page_url ?feed_url ?description ?user_comment 61 61 + ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () = 62 62 + make ~title ?home_page_url ?feed_url ?description ?user_comment 63 63 + ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () 64 64 + 48 65 let version t = t.version 49 66 let title t = t.title 50 67 let home_page_url t = t.home_page_url ··· 59 76 let expired t = t.expired 60 77 let hubs t = t.hubs 61 78 let items t = t.items 62 62 - 63 63 - (* RFC3339 date utilities *) 64 64 - 65 65 - let parse_rfc3339 s = 66 66 - match Ptime.of_rfc3339 s with 67 67 - | Ok (t, _, _) -> Some t 68 68 - | Error _ -> None 69 69 - 70 70 - let format_rfc3339 t = 71 71 - Ptime.to_rfc3339 t 72 72 - 73 73 - (* JSON parsing and serialization *) 74 74 - 75 75 - type error = string 76 76 - 77 77 - let error_msgf fmt = Format.kasprintf (fun s -> Error s) fmt 78 78 - 79 79 - (* JSON parsing helpers *) 80 80 - 81 81 - type json_value = 82 82 - | Null 83 83 - | Bool of bool 84 84 - | Float of float 85 85 - | String of string 86 86 - | Array of json_value list 87 87 - | Object of (string * json_value) list 88 88 - 89 89 - let rec decode_value dec = 90 90 - match Jsonm.decode dec with 91 91 - | `Lexeme `Null -> Null 92 92 - | `Lexeme (`Bool b) -> Bool b 93 93 - | `Lexeme (`Float f) -> Float f 94 94 - | `Lexeme (`String s) -> String s 95 95 - | `Lexeme `Os -> decode_object dec [] 96 96 - | `Lexeme `As -> decode_array dec [] 97 97 - | `Lexeme _ -> Null 98 98 - | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err)) 99 99 - | `End | `Await -> Null 100 100 - 101 101 - and decode_object dec acc = 102 102 - match Jsonm.decode dec with 103 103 - | `Lexeme `Oe -> Object (List.rev acc) 104 104 - | `Lexeme (`Name n) -> 105 105 - let v = decode_value dec in 106 106 - decode_object dec ((n, v) :: acc) 107 107 - | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err)) 108 108 - | _ -> Object (List.rev acc) 109 109 - 110 110 - and decode_array dec acc = 111 111 - match Jsonm.decode dec with 112 112 - | `Lexeme `Ae -> Array (List.rev acc) 113 113 - | `Lexeme `Os -> 114 114 - let v = decode_object dec [] in 115 115 - decode_array dec (v :: acc) 116 116 - | `Lexeme `As -> 117 117 - let v = decode_array dec [] in 118 118 - decode_array dec (v :: acc) 119 119 - | `Lexeme `Null -> decode_array dec (Null :: acc) 120 120 - | `Lexeme (`Bool b) -> decode_array dec (Bool b :: acc) 121 121 - | `Lexeme (`Float f) -> decode_array dec (Float f :: acc) 122 122 - | `Lexeme (`String s) -> decode_array dec (String s :: acc) 123 123 - | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err)) 124 124 - | _ -> Array (List.rev acc) 125 125 - 126 126 - (* Helpers to extract values from JSON *) 127 127 - 128 128 - let get_string = function String s -> Some s | _ -> None 129 129 - let get_bool = function Bool b -> Some b | _ -> None 130 130 - let _get_float = function Float f -> Some f | _ -> None 131 131 - let get_int = function Float f -> Some (int_of_float f) | _ -> None 132 132 - let get_int64 = function Float f -> Some (Int64.of_float f) | _ -> None 133 133 - let get_array = function Array arr -> Some arr | _ -> None 134 134 - let _get_object = function Object obj -> Some obj | _ -> None 135 135 - 136 136 - let find_field name obj = List.assoc_opt name obj 137 137 - 138 138 - let require_field name obj = 139 139 - match find_field name obj with 140 140 - | Some v -> v 141 141 - | None -> raise (Invalid_feed (Printf.sprintf "Missing required field: %s" name)) 142 142 - 143 143 - let require_string name obj = 144 144 - match require_field name obj |> get_string with 145 145 - | Some s -> s 146 146 - | None -> raise (Invalid_feed (Printf.sprintf "Field %s must be a string" name)) 147 147 - 148 148 - let optional_string name obj = 149 149 - match find_field name obj with Some v -> get_string v | None -> None 150 150 - 151 151 - let optional_bool name obj = 152 152 - match find_field name obj with Some v -> get_bool v | None -> None 153 153 - 154 154 - let optional_int name obj = 155 155 - match find_field name obj with Some v -> get_int v | None -> None 156 156 - 157 157 - let optional_int64 name obj = 158 158 - match find_field name obj with Some v -> get_int64 v | None -> None 159 159 - 160 160 - let optional_array name obj = 161 161 - match find_field name obj with Some v -> get_array v | None -> None 162 162 - 163 163 - (* Parse Author *) 164 164 - 165 165 - let parse_author_obj obj = 166 166 - let name = optional_string "name" obj in 167 167 - let url = optional_string "url" obj in 168 168 - let avatar = optional_string "avatar" obj in 169 169 - if name = None && url = None && avatar = None then 170 170 - raise (Invalid_feed "Author must have at least one field"); 171 171 - Author.create ?name ?url ?avatar () 172 172 - 173 173 - let parse_author = function 174 174 - | Object obj -> parse_author_obj obj 175 175 - | _ -> raise (Invalid_feed "Author must be an object") 176 176 - 177 177 - (* Parse Attachment *) 178 178 - 179 179 - let parse_attachment_obj obj = 180 180 - let url = require_string "url" obj in 181 181 - let mime_type = require_string "mime_type" obj in 182 182 - let title = optional_string "title" obj in 183 183 - let size_in_bytes = optional_int64 "size_in_bytes" obj in 184 184 - let duration_in_seconds = optional_int "duration_in_seconds" obj in 185 185 - Attachment.create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds () 186 186 - 187 187 - let parse_attachment = function 188 188 - | Object obj -> parse_attachment_obj obj 189 189 - | _ -> raise (Invalid_feed "Attachment must be an object") 190 190 - 191 191 - (* Parse Hub *) 192 192 - 193 193 - let parse_hub_obj obj = 194 194 - let type_ = require_string "type" obj in 195 195 - let url = require_string "url" obj in 196 196 - Hub.create ~type_ ~url () 197 197 - 198 198 - let parse_hub = function 199 199 - | Object obj -> parse_hub_obj obj 200 200 - | _ -> raise (Invalid_feed "Hub must be an object") 201 201 - 202 202 - (* Parse Item *) 203 203 - 204 204 - let parse_item_obj obj = 205 205 - let id = require_string "id" obj in 206 206 - 207 207 - (* Parse content - at least one required *) 208 208 - let content_html = optional_string "content_html" obj in 209 209 - let content_text = optional_string "content_text" obj in 210 210 - let content = match content_html, content_text with 211 211 - | Some html, Some text -> `Both (html, text) 212 212 - | Some html, None -> `Html html 213 213 - | None, Some text -> `Text text 214 214 - | None, None -> 215 215 - raise (Invalid_feed "Item must have content_html or content_text") 216 216 - in 217 217 - 218 218 - let url = optional_string "url" obj in 219 219 - let external_url = optional_string "external_url" obj in 220 220 - let title = optional_string "title" obj in 221 221 - let summary = optional_string "summary" obj in 222 222 - let image = optional_string "image" obj in 223 223 - let banner_image = optional_string "banner_image" obj in 224 224 - 225 225 - let date_published = 226 226 - match optional_string "date_published" obj with 227 227 - | Some s -> parse_rfc3339 s 228 228 - | None -> None 229 229 - in 230 230 - 231 231 - let date_modified = 232 232 - match optional_string "date_modified" obj with 233 233 - | Some s -> parse_rfc3339 s 234 234 - | None -> None 235 235 - in 236 236 - 237 237 - let authors = 238 238 - match optional_array "authors" obj with 239 239 - | Some arr -> 240 240 - let parsed = List.map parse_author arr in 241 241 - if parsed = [] then None else Some parsed 242 242 - | None -> None 243 243 - in 244 244 - 245 245 - let tags = 246 246 - match optional_array "tags" obj with 247 247 - | Some arr -> 248 248 - let parsed = List.filter_map get_string arr in 249 249 - if parsed = [] then None else Some parsed 250 250 - | None -> None 251 251 - in 252 252 - 253 253 - let language = optional_string "language" obj in 254 254 - 255 255 - let attachments = 256 256 - match optional_array "attachments" obj with 257 257 - | Some arr -> 258 258 - let parsed = List.map parse_attachment arr in 259 259 - if parsed = [] then None else Some parsed 260 260 - | None -> None 261 261 - in 262 262 - 263 263 - let parse_reference = function 264 264 - | Object obj -> 265 265 - let url = require_string "url" obj in 266 266 - let doi = optional_string "doi" obj in 267 267 - Reference.create ~url ?doi () 268 268 - | _ -> raise (Invalid_feed "Reference must be an object") 269 269 - in 270 270 - 271 271 - let references = 272 272 - match optional_array "_references" obj with 273 273 - | Some arr -> 274 274 - let parsed = List.map parse_reference arr in 275 275 - if parsed = [] then None else Some parsed 276 276 - | None -> None 277 277 - in 278 278 - 279 279 - Item.create ~id ~content ?url ?external_url ?title ?summary ?image 280 280 - ?banner_image ?date_published ?date_modified ?authors ?tags ?language 281 281 - ?attachments ?references () 282 282 - 283 283 - let parse_item = function 284 284 - | Object obj -> parse_item_obj obj 285 285 - | _ -> raise (Invalid_feed "Item must be an object") 286 286 - 287 287 - (* Parse Feed *) 288 288 - 289 289 - let parse_feed_obj obj = 290 290 - let version = require_string "version" obj in 291 291 - let title = require_string "title" obj in 292 292 - let home_page_url = optional_string "home_page_url" obj in 293 293 - let feed_url = optional_string "feed_url" obj in 294 294 - let description = optional_string "description" obj in 295 295 - let user_comment = optional_string "user_comment" obj in 296 296 - let next_url = optional_string "next_url" obj in 297 297 - let icon = optional_string "icon" obj in 298 298 - let favicon = optional_string "favicon" obj in 299 299 - let language = optional_string "language" obj in 300 300 - let expired = optional_bool "expired" obj in 301 301 - 302 302 - let authors = 303 303 - match optional_array "authors" obj with 304 304 - | Some arr -> 305 305 - let parsed = List.map parse_author arr in 306 306 - if parsed = [] then None else Some parsed 307 307 - | None -> None 308 308 - in 309 309 - 310 310 - let hubs = 311 311 - match optional_array "hubs" obj with 312 312 - | Some arr -> 313 313 - let parsed = List.map parse_hub arr in 314 314 - if parsed = [] then None else Some parsed 315 315 - | None -> None 316 316 - in 317 317 - 318 318 - let items = 319 319 - match optional_array "items" obj with 320 320 - | Some arr -> List.map parse_item arr 321 321 - | None -> [] 322 322 - in 323 323 - 324 324 - { 325 325 - version; 326 326 - title; 327 327 - home_page_url; 328 328 - feed_url; 329 329 - description; 330 330 - user_comment; 331 331 - next_url; 332 332 - icon; 333 333 - favicon; 334 334 - authors; 335 335 - language; 336 336 - expired; 337 337 - hubs; 338 338 - items; 339 339 - } 79 79 + let unknown t = t.unknown 340 80 341 341 - let of_jsonm dec = 342 342 - try 343 343 - let json = decode_value dec in 344 344 - match json with 345 345 - | Object obj -> Ok (parse_feed_obj obj) 346 346 - | _ -> error_msgf "Feed must be a JSON object" 347 347 - with 348 348 - | Invalid_feed msg -> error_msgf "%s" msg 81 81 + let equal a b = 82 82 + a.title = b.title && 83 83 + a.items = b.items 349 84 350 350 - (* JSON serialization *) 85 85 + let pp ppf t = 86 86 + Format.fprintf ppf "Feed: %s (%d items)" t.title (List.length t.items) 351 87 352 352 - let to_jsonm enc feed = 353 353 - let enc_field name value_fn = 354 354 - ignore (Jsonm.encode enc (`Lexeme (`Name name))); 355 355 - value_fn () 356 356 - in 88 88 + let pp_summary ppf t = 89 89 + Format.fprintf ppf "%s (%d items)" t.title (List.length t.items) 357 90 358 358 - let enc_string s = 359 359 - ignore (Jsonm.encode enc (`Lexeme (`String s))) 360 360 - in 91 91 + (* Jsont type *) 361 92 362 362 - let enc_bool b = 363 363 - ignore (Jsonm.encode enc (`Lexeme (`Bool b))) 93 93 + let jsont = 94 94 + let kind = "JSON Feed" in 95 95 + let doc = "A JSON Feed document" in 96 96 + let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 97 97 + let open Jsont.Object.Mems in 98 98 + let dec_empty () = [] in 99 99 + let dec_add _meta (name : string) value acc = 100 100 + ((name, Jsont.Meta.none), value) :: acc 101 101 + in 102 102 + let dec_finish _meta mems = 103 103 + List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in 104 104 + let enc = { 105 105 + enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) -> 106 106 + List.fold_left (fun acc (name, value) -> 107 107 + 108 108 + f Jsont.Meta.none name value acc 109 109 + ) acc unknown 110 110 + } in 111 111 + map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc 364 112 in 365 113 366 366 - let enc_opt enc_fn = function 367 367 - | None -> () 368 368 - | Some v -> enc_fn v 114 114 + (* Helper constructor that sets version automatically *) 115 115 + let make_from_json _version title home_page_url feed_url description user_comment 116 116 + next_url icon favicon authors language expired hubs items unknown = 117 117 + { 118 118 + version = "https://jsonfeed.org/version/1.1"; 119 119 + title; 120 120 + home_page_url; 121 121 + feed_url; 122 122 + description; 123 123 + user_comment; 124 124 + next_url; 125 125 + icon; 126 126 + favicon; 127 127 + authors; 128 128 + language; 129 129 + expired; 130 130 + hubs; 131 131 + items; 132 132 + unknown; 133 133 + } 369 134 in 370 135 371 371 - let enc_list enc_fn lst = 372 372 - ignore (Jsonm.encode enc (`Lexeme `As)); 373 373 - List.iter enc_fn lst; 374 374 - ignore (Jsonm.encode enc (`Lexeme `Ae)) 375 375 - in 136 136 + Jsont.Object.map ~kind ~doc make_from_json 137 137 + |> Jsont.Object.mem "version" Jsont.string ~enc:version 138 138 + |> Jsont.Object.mem "title" Jsont.string ~enc:title 139 139 + |> Jsont.Object.opt_mem "home_page_url" Jsont.string ~enc:home_page_url 140 140 + |> Jsont.Object.opt_mem "feed_url" Jsont.string ~enc:feed_url 141 141 + |> Jsont.Object.opt_mem "description" Jsont.string ~enc:description 142 142 + |> Jsont.Object.opt_mem "user_comment" Jsont.string ~enc:user_comment 143 143 + |> Jsont.Object.opt_mem "next_url" Jsont.string ~enc:next_url 144 144 + |> Jsont.Object.opt_mem "icon" Jsont.string ~enc:icon 145 145 + |> Jsont.Object.opt_mem "favicon" Jsont.string ~enc:favicon 146 146 + |> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:authors 147 147 + |> Jsont.Object.opt_mem "language" Jsont.string ~enc:language 148 148 + |> Jsont.Object.opt_mem "expired" Jsont.bool ~enc:expired 149 149 + |> Jsont.Object.opt_mem "hubs" (Jsont.list Hub.jsont) ~enc:hubs 150 150 + |> Jsont.Object.mem "items" (Jsont.list Item.jsont) ~enc:items 151 151 + |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown 152 152 + |> Jsont.Object.finish 376 153 377 377 - let enc_author author = 378 378 - ignore (Jsonm.encode enc (`Lexeme `Os)); 379 379 - (match Author.name author with 380 380 - | Some name -> enc_field "name" (fun () -> enc_string name) 381 381 - | None -> ()); 382 382 - (match Author.url author with 383 383 - | Some url -> enc_field "url" (fun () -> enc_string url) 384 384 - | None -> ()); 385 385 - (match Author.avatar author with 386 386 - | Some avatar -> enc_field "avatar" (fun () -> enc_string avatar) 387 387 - | None -> ()); 388 388 - ignore (Jsonm.encode enc (`Lexeme `Oe)) 389 389 - in 154 154 + (* Encoding and Decoding *) 390 155 391 391 - let enc_attachment att = 392 392 - ignore (Jsonm.encode enc (`Lexeme `Os)); 393 393 - enc_field "url" (fun () -> enc_string (Attachment.url att)); 394 394 - enc_field "mime_type" (fun () -> enc_string (Attachment.mime_type att)); 395 395 - enc_opt (fun title -> enc_field "title" (fun () -> enc_string title)) 396 396 - (Attachment.title att); 397 397 - enc_opt (fun size -> 398 398 - enc_field "size_in_bytes" (fun () -> 399 399 - ignore (Jsonm.encode enc (`Lexeme (`Float (Int64.to_float size)))))) 400 400 - (Attachment.size_in_bytes att); 401 401 - enc_opt (fun dur -> 402 402 - enc_field "duration_in_seconds" (fun () -> 403 403 - ignore (Jsonm.encode enc (`Lexeme (`Float (float_of_int dur)))))) 404 404 - (Attachment.duration_in_seconds att); 405 405 - ignore (Jsonm.encode enc (`Lexeme `Oe)) 406 406 - in 156 156 + let decode ?layout ?locs ?file r = 157 157 + Jsont_bytesrw.decode' ?layout ?locs ?file jsont r 407 158 408 408 - let enc_reference ref = 409 409 - ignore (Jsonm.encode enc (`Lexeme `Os)); 410 410 - enc_field "url" (fun () -> enc_string (Reference.url ref)); 411 411 - enc_opt (fun doi -> enc_field "doi" (fun () -> enc_string doi)) 412 412 - (Reference.doi ref); 413 413 - enc_opt (fun cito_list -> 414 414 - enc_field "cito" (fun () -> 415 415 - enc_list (fun cito -> enc_string (Cito.to_string cito)) cito_list)) 416 416 - (Reference.cito ref); 417 417 - ignore (Jsonm.encode enc (`Lexeme `Oe)) 418 418 - in 159 159 + let decode_string ?layout ?locs ?file s = 160 160 + Jsont_bytesrw.decode_string' ?layout ?locs ?file jsont s 419 161 420 420 - let enc_hub hub = 421 421 - ignore (Jsonm.encode enc (`Lexeme `Os)); 422 422 - enc_field "type" (fun () -> enc_string (Hub.type_ hub)); 423 423 - enc_field "url" (fun () -> enc_string (Hub.url hub)); 424 424 - ignore (Jsonm.encode enc (`Lexeme `Oe)) 425 425 - in 426 426 - 427 427 - let enc_item item = 428 428 - ignore (Jsonm.encode enc (`Lexeme `Os)); 429 429 - enc_field "id" (fun () -> enc_string (Item.id item)); 430 430 - 431 431 - (* Encode content *) 432 432 - (match Item.content item with 433 433 - | `Html html -> 434 434 - enc_field "content_html" (fun () -> enc_string html) 435 435 - | `Text text -> 436 436 - enc_field "content_text" (fun () -> enc_string text) 437 437 - | `Both (html, text) -> 438 438 - enc_field "content_html" (fun () -> enc_string html); 439 439 - enc_field "content_text" (fun () -> enc_string text)); 440 440 - 441 441 - enc_opt (fun url -> enc_field "url" (fun () -> enc_string url)) 442 442 - (Item.url item); 443 443 - enc_opt (fun url -> enc_field "external_url" (fun () -> enc_string url)) 444 444 - (Item.external_url item); 445 445 - enc_opt (fun title -> enc_field "title" (fun () -> enc_string title)) 446 446 - (Item.title item); 447 447 - enc_opt (fun summary -> enc_field "summary" (fun () -> enc_string summary)) 448 448 - (Item.summary item); 449 449 - enc_opt (fun img -> enc_field "image" (fun () -> enc_string img)) 450 450 - (Item.image item); 451 451 - enc_opt (fun img -> enc_field "banner_image" (fun () -> enc_string img)) 452 452 - (Item.banner_image item); 453 453 - enc_opt (fun date -> enc_field "date_published" (fun () -> enc_string (format_rfc3339 date))) 454 454 - (Item.date_published item); 455 455 - enc_opt (fun date -> enc_field "date_modified" (fun () -> enc_string (format_rfc3339 date))) 456 456 - (Item.date_modified item); 457 457 - enc_opt (fun authors -> 458 458 - enc_field "authors" (fun () -> enc_list enc_author authors)) 459 459 - (Item.authors item); 460 460 - enc_opt (fun tags -> 461 461 - enc_field "tags" (fun () -> enc_list enc_string tags)) 462 462 - (Item.tags item); 463 463 - enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang)) 464 464 - (Item.language item); 465 465 - enc_opt (fun atts -> 466 466 - enc_field "attachments" (fun () -> enc_list enc_attachment atts)) 467 467 - (Item.attachments item); 468 468 - enc_opt (fun refs -> 469 469 - enc_field "_references" (fun () -> enc_list enc_reference refs)) 470 470 - (Item.references item); 471 471 - 472 472 - ignore (Jsonm.encode enc (`Lexeme `Oe)) 473 473 - in 162 162 + let encode ?format ?number_format feed ~eod w = 163 163 + Jsont_bytesrw.encode' ?format ?number_format jsont feed ~eod w 474 164 475 475 - (* Encode the feed *) 476 476 - ignore (Jsonm.encode enc (`Lexeme `Os)); 477 477 - enc_field "version" (fun () -> enc_string feed.version); 478 478 - enc_field "title" (fun () -> enc_string feed.title); 479 479 - enc_opt (fun url -> enc_field "home_page_url" (fun () -> enc_string url)) 480 480 - feed.home_page_url; 481 481 - enc_opt (fun url -> enc_field "feed_url" (fun () -> enc_string url)) 482 482 - feed.feed_url; 483 483 - enc_opt (fun desc -> enc_field "description" (fun () -> enc_string desc)) 484 484 - feed.description; 485 485 - enc_opt (fun comment -> enc_field "user_comment" (fun () -> enc_string comment)) 486 486 - feed.user_comment; 487 487 - enc_opt (fun url -> enc_field "next_url" (fun () -> enc_string url)) 488 488 - feed.next_url; 489 489 - enc_opt (fun icon -> enc_field "icon" (fun () -> enc_string icon)) 490 490 - feed.icon; 491 491 - enc_opt (fun favicon -> enc_field "favicon" (fun () -> enc_string favicon)) 492 492 - feed.favicon; 493 493 - enc_opt (fun authors -> 494 494 - enc_field "authors" (fun () -> enc_list enc_author authors)) 495 495 - feed.authors; 496 496 - enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang)) 497 497 - feed.language; 498 498 - enc_opt (fun expired -> enc_field "expired" (fun () -> enc_bool expired)) 499 499 - feed.expired; 500 500 - enc_opt (fun hubs -> 501 501 - enc_field "hubs" (fun () -> enc_list enc_hub hubs)) 502 502 - feed.hubs; 503 503 - enc_field "items" (fun () -> enc_list enc_item feed.items); 504 504 - ignore (Jsonm.encode enc (`Lexeme `Oe)); 505 505 - ignore (Jsonm.encode enc `End) 165 165 + let encode_string ?format ?number_format feed = 166 166 + Jsont_bytesrw.encode_string' ?format ?number_format jsont feed 506 167 507 168 let of_string s = 508 508 - let dec = Jsonm.decoder (`String s) in 509 509 - of_jsonm dec 169 169 + decode_string s 510 170 511 171 let to_string ?(minify=false) feed = 512 512 - let buf = Buffer.create 1024 in 513 513 - let enc = Jsonm.encoder ~minify (`Buffer buf) in 514 514 - to_jsonm enc feed; 515 515 - Buffer.contents buf 172 172 + let format = if minify then Jsont.Minify else Jsont.Indent in 173 173 + encode_string ~format feed 516 174 517 175 (* Validation *) 518 176 ··· 554 212 | None -> ()) 555 213 ) feed.items; 556 214 557 557 - if !errors = [] then Ok () 558 558 - else Error (List.rev !errors) 559 559 - 560 560 - (* Comparison *) 561 561 - 562 562 - let equal a b = 563 563 - a.version = b.version && 564 564 - a.title = b.title && 565 565 - a.home_page_url = b.home_page_url && 566 566 - a.feed_url = b.feed_url && 567 567 - a.description = b.description && 568 568 - a.user_comment = b.user_comment && 569 569 - a.next_url = b.next_url && 570 570 - a.icon = b.icon && 571 571 - a.favicon = b.favicon && 572 572 - a.language = b.language && 573 573 - a.expired = b.expired && 574 574 - (* Note: We're doing structural equality on items *) 575 575 - List.length a.items = List.length b.items 576 576 - 577 577 - (* Pretty printing *) 578 578 - 579 579 - let pp_summary ppf feed = 580 580 - Format.fprintf ppf "%s (%d items)" feed.title (List.length feed.items) 581 581 - 582 582 - let pp ppf feed = 583 583 - Format.fprintf ppf "Feed: %s" feed.title; 584 584 - (match feed.home_page_url with 585 585 - | Some url -> Format.fprintf ppf " (%s)" url 586 586 - | None -> ()); 587 587 - Format.fprintf ppf "@\n"; 588 588 - 589 589 - Format.fprintf ppf " Items: %d@\n" (List.length feed.items); 590 590 - 591 591 - (match feed.authors with 592 592 - | Some authors when authors <> [] -> 593 593 - Format.fprintf ppf " Authors: "; 594 594 - List.iteri (fun i author -> 595 595 - if i > 0 then Format.fprintf ppf ", "; 596 596 - Format.fprintf ppf "%a" Author.pp author 597 597 - ) authors; 598 598 - Format.fprintf ppf "@\n" 599 599 - | _ -> ()); 600 600 - 601 601 - (match feed.language with 602 602 - | Some lang -> Format.fprintf ppf " Language: %s@\n" lang 603 603 - | None -> ()) 215 215 + match !errors with 216 216 + | [] -> Ok () 217 217 + | errs -> Error (List.rev errs)

+81 -292

lib/jsonfeed.mli

··· 1 1 - (** JSON Feed format parser and serializer. 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 2 5 3 3 - This library implements the JSON Feed specification version 1.1, providing 4 4 - type-safe parsing and serialization of JSON Feed documents. JSON Feed is a 5 5 - syndication format similar to RSS and Atom, but using JSON instead of XML. 6 6 - 7 7 - {b Quick Start:} 8 8 - {[ 9 9 - (* Create a simple feed *) 10 10 - let feed = Jsonfeed.create 11 11 - ~title:"My Blog" 12 12 - ~home_page_url:"https://example.com" 13 13 - ~feed_url:"https://example.com/feed.json" 14 14 - ~items:[ 15 15 - Item.create 16 16 - ~id:"https://example.com/post/1" 17 17 - ~content:(Item.Html "<p>Hello, world!</p>") 18 18 - ~title:"First Post" 19 19 - () 20 20 - ] 21 21 - () 22 22 - 23 23 - (* Serialize to string *) 24 24 - let json = Jsonfeed.to_string feed 25 25 - 26 26 - (* Parse from string *) 27 27 - match Jsonfeed.of_string json with 28 28 - | Ok feed -> Printf.printf "Feed: %s\n" (Jsonfeed.title feed) 29 29 - | Error err -> Printf.eprintf "Error: %s\n" err 30 30 - ]} 6 6 + (** JSON Feed format parser and serializer using Jsont and Bytesrw. 31 7 32 8 @see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *) 33 9 ··· 35 11 (** The type representing a complete JSON Feed. *) 36 12 type t 37 13 38 38 - (** Exception raised when attempting to parse an invalid feed. *) 39 39 - exception Invalid_feed of string 40 14 41 41 - (** {1 Construction} *) 15 15 + (** {1 Unknown Fields} *) 42 16 43 43 - (** [create ~title ?home_page_url ?feed_url ?description ?user_comment ?next_url 44 44 - ?icon ?favicon ?authors ?language ?expired ?hubs ~items ()] 45 45 - creates a JSON Feed. 17 17 + module Unknown : sig 18 18 + type t = (string * Jsont.json) list 19 19 + (** Unknown/unrecognized JSON object members. 20 20 + Useful for preserving fields from custom extensions or future spec versions. *) 46 21 47 47 - @param title The name of the feed (required) 48 48 - @param home_page_url The URL of the resource the feed describes 49 49 - @param feed_url The URL of the feed itself (serves as unique identifier) 50 50 - @param description Additional information about the feed 51 51 - @param user_comment A description of the feed's purpose for humans reading the raw JSON 52 52 - @param next_url URL of the next page of items (for pagination) 53 53 - @param icon The feed's icon URL (should be square, 512x512 or larger) 54 54 - @param favicon The feed's favicon URL (should be square, 64x64 or larger) 55 55 - @param authors The feed's default authors (inherited by items without authors) 56 56 - @param language The primary language of the feed (RFC 5646 format, e.g. ["en-US"]) 57 57 - @param expired Whether the feed will update again ([true] means no more updates) 58 58 - @param hubs Endpoints for real-time notifications 59 59 - @param items The list of feed items (required) 22 22 + val empty : t 23 23 + (** [empty] is the empty list of unknown fields. *) 24 24 + 25 25 + val is_empty : t -> bool 26 26 + (** [is_empty u] returns [true] if there are no unknown fields. *) 27 27 + end 28 28 + 29 29 + 30 30 + (** {1 Jsont Type} *) 31 31 + 32 32 + val jsont : t Jsont.t 33 33 + (** Declarative JSON type for JSON feeds. 34 34 + 35 35 + Maps the complete JSON Feed 1.1 specification including all required 36 36 + and optional fields. *) 60 37 61 61 - {b Examples:} 62 62 - {[ 63 63 - (* Minimal feed *) 64 64 - let feed = Jsonfeed.create 65 65 - ~title:"My Blog" 66 66 - ~items:[] () 67 38 68 68 - (* Full-featured blog feed *) 69 69 - let feed = Jsonfeed.create 70 70 - ~title:"Example Blog" 71 71 - ~home_page_url:"https://example.com" 72 72 - ~feed_url:"https://example.com/feed.json" 73 73 - ~description:"A blog about OCaml and functional programming" 74 74 - ~icon:"https://example.com/icon.png" 75 75 - ~authors:[ 76 76 - Author.create 77 77 - ~name:"Jane Doe" 78 78 - ~url:"https://example.com/about" 79 79 - () 80 80 - ] 81 81 - ~language:"en-US" 82 82 - ~items:[ 83 83 - Item.create 84 84 - ~id:"https://example.com/posts/1" 85 85 - ~content:(Item.Html "<p>First post</p>") 86 86 - ~title:"Hello World" 87 87 - (); 88 88 - Item.create 89 89 - ~id:"https://example.com/posts/2" 90 90 - ~content:(Item.Html "<p>Second post</p>") 91 91 - ~title:"Another Post" 92 92 - () 93 93 - ] 94 94 - () 39 39 + (** {1 Construction} *) 95 40 96 96 - (* Podcast feed with hubs *) 97 97 - let hub = Hub.create 98 98 - ~type_:"WebSub" 99 99 - ~url:"https://pubsubhubbub.appspot.com/" 100 100 - () in 101 101 - let feed = Jsonfeed.create 102 102 - ~title:"My Podcast" 103 103 - ~home_page_url:"https://podcast.example.com" 104 104 - ~feed_url:"https://podcast.example.com/feed.json" 105 105 - ~hubs:[hub] 106 106 - ~items:[ 107 107 - Item.create 108 108 - ~id:"https://podcast.example.com/episodes/1" 109 109 - ~content:(Item.Html "<p>Episode description</p>") 110 110 - ~title:"Episode 1" 111 111 - ~attachments:[ 112 112 - Attachment.create 113 113 - ~url:"https://podcast.example.com/ep1.mp3" 114 114 - ~mime_type:"audio/mpeg" 115 115 - ~duration_in_seconds:1800 116 116 - () 117 117 - ] 118 118 - () 119 119 - ] 120 120 - () 121 121 - ]} *) 122 41 val create : 123 42 title:string -> 124 43 ?home_page_url:string -> ··· 136 55 unit -> 137 56 t 138 57 58 58 + val make : 59 59 + title:string -> 60 60 + ?home_page_url:string -> 61 61 + ?feed_url:string -> 62 62 + ?description:string -> 63 63 + ?user_comment:string -> 64 64 + ?next_url:string -> 65 65 + ?icon:string -> 66 66 + ?favicon:string -> 67 67 + ?authors:Author.t list -> 68 68 + ?language:string -> 69 69 + ?expired:bool -> 70 70 + ?hubs:Hub.t list -> 71 71 + items:Item.t list -> 72 72 + ?unknown:Unknown.t -> 73 73 + unit -> 74 74 + t 139 75 140 140 - (** {1 Accessors} *) 141 76 142 142 - (** [version t] returns the JSON Feed version URL. 77 77 + (** {1 Accessors} *) 143 78 144 144 - This is always ["https://jsonfeed.org/version/1.1"] for feeds created 145 145 - by this library, but may differ when parsing external feeds. *) 146 79 val version : t -> string 147 147 - 148 148 - (** [title t] returns the feed's title. *) 149 80 val title : t -> string 150 150 - 151 151 - (** [home_page_url t] returns the feed's home page URL, if set. *) 152 81 val home_page_url : t -> string option 153 153 - 154 154 - (** [feed_url t] returns the feed's URL, if set. *) 155 82 val feed_url : t -> string option 156 156 - 157 157 - (** [description t] returns the feed's description, if set. *) 158 83 val description : t -> string option 159 159 - 160 160 - (** [user_comment t] returns the feed's user comment, if set. *) 161 84 val user_comment : t -> string option 162 162 - 163 163 - (** [next_url t] returns the URL for the next page of items, if set. *) 164 85 val next_url : t -> string option 165 165 - 166 166 - (** [icon t] returns the feed's icon URL, if set. *) 167 86 val icon : t -> string option 168 168 - 169 169 - (** [favicon t] returns the feed's favicon URL, if set. *) 170 87 val favicon : t -> string option 171 171 - 172 172 - (** [authors t] returns the feed's default authors, if set. *) 173 88 val authors : t -> Author.t list option 174 174 - 175 175 - (** [language t] returns the feed's primary language, if set. *) 176 89 val language : t -> string option 177 177 - 178 178 - (** [expired t] returns whether the feed will update again. *) 179 90 val expired : t -> bool option 180 180 - 181 181 - (** [hubs t] returns the feed's hub endpoints, if set. *) 182 91 val hubs : t -> Hub.t list option 183 183 - 184 184 - (** [items t] returns the feed's items. *) 185 92 val items : t -> Item.t list 93 93 + val unknown : t -> Unknown.t 186 94 187 95 188 188 - (** {1 Parsing and Serialization} *) 96 96 + (** {1 Encoding and Decoding with Bytesrw} *) 189 97 190 190 - (** Error type for parsing operations. *) 191 191 - type error = string 192 192 - 193 193 - (** [of_jsonm decoder] parses a JSON Feed from a Jsonm decoder. 98 98 + val decode : 99 99 + ?layout:bool -> ?locs:bool -> ?file:string -> 100 100 + Bytesrw.Bytes.Reader.t -> (t, Jsont.Error.t) result 101 101 + (** [decode r] decodes a JSON Feed from bytesrw reader [r]. 194 102 195 195 - This is the lowest-level parsing function, suitable for integration 196 196 - with streaming JSON processing pipelines. 103 103 + @param layout Preserve whitespace for round-tripping (default: false) 104 104 + @param locs Track locations for better error messages (default: false) 105 105 + @param file Source file name for error reporting *) 197 106 198 198 - @param decoder A Jsonm decoder positioned at the start of a JSON Feed document 199 199 - @return [Ok feed] on success, [Error err] on parse error 107 107 + val decode_string : 108 108 + ?layout:bool -> ?locs:bool -> ?file:string -> 109 109 + string -> (t, Jsont.Error.t) result 110 110 + (** [decode_string s] decodes a JSON Feed from string [s]. *) 200 111 201 201 - {b Example:} 202 202 - {[ 203 203 - let decoder = Jsonm.decoder (`String json_string) in 204 204 - match Jsonfeed.of_jsonm decoder with 205 205 - | Ok feed -> (* process feed *) 206 206 - | Error err -> (* handle error *) 207 207 - ]} *) 208 208 - val of_jsonm : Jsonm.decoder -> (t, error) result 209 209 - 210 210 - (** [to_jsonm encoder feed] serializes a JSON Feed to a Jsonm encoder. 211 211 - 212 212 - This is the lowest-level serialization function, suitable for integration 213 213 - with streaming JSON generation pipelines. 214 214 - 215 215 - @param encoder A Jsonm encoder 216 216 - @param feed The feed to serialize 217 217 - 218 218 - {b Example:} 219 219 - {[ 220 220 - let buffer = Buffer.create 1024 in 221 221 - let encoder = Jsonm.encoder (`Buffer buffer) in 222 222 - Jsonfeed.to_jsonm encoder feed; 223 223 - let json = Buffer.contents buffer 224 224 - ]} *) 225 225 - val to_jsonm : Jsonm.encoder -> t -> unit 226 226 - 227 227 - (** [of_string s] parses a JSON Feed from a string. 228 228 - 229 229 - @param s A JSON string containing a JSON Feed document 230 230 - @return [Ok feed] on success, [Error err] on parse error 231 231 - 232 232 - {b Example:} 233 233 - {[ 234 234 - let json = {|{ 235 235 - "version": "https://jsonfeed.org/version/1.1", 236 236 - "title": "My Feed", 237 237 - "items": [] 238 238 - }|} in 239 239 - match Jsonfeed.of_string json with 240 240 - | Ok feed -> Printf.printf "Parsed: %s\n" (Jsonfeed.title feed) 241 241 - | Error err -> Printf.eprintf "Error: %s\n" err 242 242 - ]} *) 243 243 - val of_string : string -> (t, error) result 244 244 - 245 245 - (** [to_string ?minify feed] serializes a JSON Feed to a string. 246 246 - 247 247 - @param minify If [true], produces compact JSON without whitespace. 248 248 - If [false] (default), produces indented, human-readable JSON. 249 249 - @param feed The feed to serialize 250 250 - @return A JSON string 251 251 - 252 252 - {b Example:} 253 253 - {[ 254 254 - let json = Jsonfeed.to_string feed 255 255 - let compact = Jsonfeed.to_string ~minify:true feed 256 256 - ]} *) 257 257 - val to_string : ?minify:bool -> t -> string 258 258 - 259 259 - 260 260 - (** {1 Date Utilities} *) 261 261 - 262 262 - (** [parse_rfc3339 s] parses an RFC 3339 date/time string. 263 263 - 264 264 - This function parses timestamps in the format required by JSON Feed, 265 265 - such as ["2024-11-03T10:30:00Z"] or ["2024-11-03T10:30:00-08:00"]. 266 266 - 267 267 - @param s An RFC 3339 formatted date/time string 268 268 - @return [Some time] on success, [None] if the string is invalid 269 269 - 270 270 - {b Examples:} 271 271 - {[ 272 272 - parse_rfc3339 "2024-11-03T10:30:00Z" 273 273 - (* returns Some time *) 112 112 + val encode : 113 113 + ?format:Jsont.format -> ?number_format:Jsont.number_format -> 114 114 + t -> eod:bool -> Bytesrw.Bytes.Writer.t -> (unit, Jsont.Error.t) result 115 115 + (** [encode feed w] encodes [feed] to bytesrw writer [w]. 274 116 275 275 - parse_rfc3339 "2024-11-03T10:30:00-08:00" 276 276 - (* returns Some time *) 117 117 + @param format Output formatting: [Jsont.Minify] or [Jsont.Indent] (default: Minify) 118 118 + @param number_format Printf format for numbers (default: "%.16g") 119 119 + @param eod Write end-of-data marker *) 277 120 278 278 - parse_rfc3339 "invalid" 279 279 - (* returns None *) 280 280 - ]} *) 281 281 - val parse_rfc3339 : string -> Ptime.t option 121 121 + val encode_string : 122 122 + ?format:Jsont.format -> ?number_format:Jsont.number_format -> 123 123 + t -> (string, Jsont.Error.t) result 124 124 + (** [encode_string feed] encodes [feed] to a string. *) 282 125 283 283 - (** [format_rfc3339 time] formats a timestamp as an RFC 3339 string. 284 126 285 285 - The output uses UTC timezone (Z suffix) and includes fractional seconds 286 286 - if the timestamp has sub-second precision. 127 127 + (** {1 Convenience Functions} *) 287 128 288 288 - @param time A Ptime timestamp 289 289 - @return An RFC 3339 formatted string 129 129 + val of_string : string -> (t, Jsont.Error.t) result 130 130 + (** Alias for [decode_string] with default options. *) 290 131 291 291 - {b Example:} 292 292 - {[ 293 293 - let now = Ptime_clock.now () in 294 294 - let s = format_rfc3339 now 295 295 - (* returns "2024-11-03T10:30:45.123Z" or similar *) 296 296 - ]} *) 297 297 - val format_rfc3339 : Ptime.t -> string 132 132 + val to_string : ?minify:bool -> t -> (string, Jsont.Error.t) result 133 133 + (** [to_string feed] encodes [feed] to string. 134 134 + @param minify Use compact format (true) or indented (false, default) *) 298 135 299 136 300 137 (** {1 Validation} *) 301 138 302 302 - (** [validate feed] validates a JSON Feed. 303 303 - 304 304 - Checks that: 305 305 - - All required fields are present 306 306 - - All items have unique IDs 307 307 - - All items have valid content 308 308 - - All URLs are well-formed (if possible) 309 309 - - Authors have at least one field set 310 310 - 311 311 - @param feed The feed to validate 312 312 - @return [Ok ()] if valid, [Error errors] with a list of validation issues 313 313 - 314 314 - {b Example:} 315 315 - {[ 316 316 - match Jsonfeed.validate feed with 317 317 - | Ok () -> (* feed is valid *) 318 318 - | Error errors -> 319 319 - List.iter (Printf.eprintf "Validation error: %s\n") errors 320 320 - ]} *) 321 139 val validate : t -> (unit, string list) result 140 140 + (** [validate feed] validates the feed structure. 141 141 + Checks for unique item IDs, valid content, etc. *) 322 142 323 143 324 144 (** {1 Comparison} *) 325 145 326 326 - (** [equal a b] tests equality between two feeds. 327 327 - 328 328 - Feeds are compared structurally, including all fields and items. *) 329 146 val equal : t -> t -> bool 147 147 + (** [equal a b] tests equality between two feeds. *) 330 148 331 149 332 150 (** {1 Pretty Printing} *) 333 151 334 334 - (** [pp ppf feed] pretty prints a feed to the formatter. 335 335 - 336 336 - The output is human-readable and suitable for debugging. It shows 337 337 - the feed's metadata and a summary of items. 338 338 - 339 339 - {b Example output:} 340 340 - {v 341 341 - Feed: My Blog (https://example.com) 342 342 - Items: 2 343 343 - Authors: Jane Doe 344 344 - Language: en-US 345 345 - v} *) 346 152 val pp : Format.formatter -> t -> unit 347 347 - 348 348 - (** [pp_summary ppf feed] prints a brief summary of the feed. 349 349 - 350 350 - Shows only the title and item count. 351 351 - 352 352 - {b Example output:} 353 353 - {v My Blog (2 items) v} *) 354 153 val pp_summary : Format.formatter -> t -> unit 355 154 356 155 357 357 - (** {1 Feed Content} *) 156 156 + (** {1 Submodules} *) 358 157 359 359 - (** Author information for feeds and items. *) 158 158 + module Rfc3339 = Rfc3339 159 159 + module Cito = Cito 360 160 module Author = Author 361 361 - 362 362 - (** Attachments for feed items (audio, video, downloads). *) 363 161 module Attachment = Attachment 364 364 - 365 365 - (** Hub endpoints for real-time notifications. *) 366 162 module Hub = Hub 367 367 - 368 368 - (** Feed items (posts, episodes, entries). *) 163 163 + module Reference = Reference 369 164 module Item = Item 370 370 - 371 371 - (** References to cited sources in items (extension). *) 372 372 - module Reference = Reference 373 373 - 374 374 - (** Citation Typing Ontology annotations for references (extension). *) 375 375 - module Cito = Cito

+47 -1

lib/reference.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + module Unknown = struct 7 7 + type t = (string * Jsont.json) list 8 8 + 9 9 + let empty = [] 10 10 + let is_empty = function [] -> true | _ -> false 11 11 + end 12 12 + 1 13 type t = { 2 14 url : string; 3 15 doi : string option; 4 16 cito : Cito.t list option; 17 17 + unknown : Unknown.t; 5 18 } 6 19 7 7 - let create ~url ?doi ?cito () = { url; doi; cito } 20 20 + let make ~url ?doi ?cito ?(unknown = Unknown.empty) () = 21 21 + { url; doi; cito; unknown } 22 22 + 23 23 + let create ~url ?doi ?cito () = 24 24 + make ~url ?doi ?cito () 8 25 9 26 let url t = t.url 10 27 let doi t = t.doi 11 28 let cito t = t.cito 29 29 + let unknown t = t.unknown 12 30 13 31 let equal a b = String.equal a.url b.url 14 32 ··· 18 36 match t.doi with 19 37 | Some d -> fprintf ppf " [DOI: %s]" d 20 38 | None -> () 39 39 + 40 40 + let jsont = 41 41 + let kind = "Reference" in 42 42 + let doc = "A reference to a cited source" in 43 43 + let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 44 44 + let open Jsont.Object.Mems in 45 45 + let dec_empty () = [] in 46 46 + let dec_add _meta (name : string) value acc = 47 47 + ((name, Jsont.Meta.none), value) :: acc 48 48 + in 49 49 + let dec_finish _meta mems = 50 50 + List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in 51 51 + let enc = { 52 52 + enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) -> 53 53 + List.fold_left (fun acc (name, value) -> 54 54 + 55 55 + f Jsont.Meta.none name value acc 56 56 + ) acc unknown 57 57 + } in 58 58 + map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc 59 59 + in 60 60 + let make_obj url doi cito unknown = make ~url ?doi ?cito ~unknown () in 61 61 + Jsont.Object.map ~kind ~doc make_obj 62 62 + |> Jsont.Object.mem "url" Jsont.string ~enc:url 63 63 + |> Jsont.Object.opt_mem "doi" Jsont.string ~enc:doi 64 64 + |> Jsont.Object.opt_mem "cito" (Jsont.list Cito.jsont) ~enc:cito 65 65 + |> Jsont.Object.keep_unknown unknown_mems ~enc:unknown 66 66 + |> Jsont.Object.finish

+46 -12

lib/reference.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 1 6 (** References extension for JSON Feed items. 2 7 3 8 This implements the references extension that allows items to cite sources. ··· 11 16 type t 12 17 13 18 19 19 + (** {1 Unknown Fields} *) 20 20 + 21 21 + module Unknown : sig 22 22 + type t = (string * Jsont.json) list 23 23 + (** Unknown/unrecognized JSON object members. 24 24 + Useful for preserving fields from custom extensions or future spec versions. *) 25 25 + 26 26 + val empty : t 27 27 + (** [empty] is the empty list of unknown fields. *) 28 28 + 29 29 + val is_empty : t -> bool 30 30 + (** [is_empty u] returns [true] if there are no unknown fields. *) 31 31 + end 32 32 + 33 33 + 34 34 + (** {1 Jsont Type} *) 35 35 + 36 36 + val jsont : t Jsont.t 37 37 + (** Declarative JSON type for references. 38 38 + 39 39 + Maps JSON objects with "url" (required) and optional "doi" and "cito" fields. *) 40 40 + 41 41 + 14 42 (** {1 Construction} *) 15 43 44 44 + val create : 45 45 + url:string -> 46 46 + ?doi:string -> 47 47 + ?cito:Cito.t list -> 48 48 + unit -> 49 49 + t 16 50 (** [create ~url ?doi ?cito ()] creates a reference. 17 51 18 52 @param url Unique URL for the reference (required). ··· 39 73 ~doi:"10.5281/zenodo.16755947" 40 74 ~cito:[`CitesAsRecommendedReading; `UsesMethodIn] 41 75 () 42 42 - 43 43 - (* Reference with custom CiTO term *) 44 44 - let ref4 = Reference.create 45 45 - ~url:"https://example.com/paper" 46 46 - ~cito:[`Other "customIntent"] 47 47 - () 48 76 ]} *) 49 49 - val create : 77 77 + 78 78 + val make : 50 79 url:string -> 51 80 ?doi:string -> 52 81 ?cito:Cito.t list -> 82 82 + ?unknown:Unknown.t -> 53 83 unit -> 54 84 t 85 85 + (** [make] is like {!create} but allows setting unknown fields. *) 55 86 56 87 57 88 (** {1 Accessors} *) 58 89 59 59 - (** [url t] returns the reference's URL. *) 60 90 val url : t -> string 91 91 + (** [url t] returns the reference's URL. *) 61 92 93 93 + val doi : t -> string option 62 94 (** [doi t] returns the reference's DOI, if set. *) 63 63 - val doi : t -> string option 64 95 96 96 + val cito : t -> Cito.t list option 65 97 (** [cito t] returns the reference's CiTO annotations, if set. *) 66 66 - val cito : t -> Cito.t list option 98 98 + 99 99 + val unknown : t -> Unknown.t 100 100 + (** [unknown t] returns unrecognized fields from the JSON. *) 67 101 68 102 69 103 (** {1 Comparison} *) 70 104 105 105 + val equal : t -> t -> bool 71 106 (** [equal a b] tests equality between two references. 72 107 73 108 References are considered equal if they have the same URL. *) 74 74 - val equal : t -> t -> bool 75 109 76 110 77 111 (** {1 Pretty Printing} *) 78 112 113 113 + val pp : Format.formatter -> t -> unit 79 114 (** [pp ppf t] pretty prints a reference to the formatter. 80 115 81 116 {b Example output:} 82 117 {v https://doi.org/10.5281/zenodo.16755947 [DOI: 10.5281/zenodo.16755947] v} *) 83 83 - val pp : Format.formatter -> t -> unit

+25

lib/rfc3339.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + let parse s = 7 7 + match Ptime.of_rfc3339 s with 8 8 + | Ok (t, _, _) -> Some t 9 9 + | Error _ -> None 10 10 + 11 11 + let format t = 12 12 + Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t 13 13 + 14 14 + let pp ppf t = 15 15 + Format.pp_print_string ppf (format t) 16 16 + 17 17 + let jsont = 18 18 + let kind = "RFC 3339 timestamp" in 19 19 + let doc = "An RFC 3339 date-time string" in 20 20 + let dec s = match parse s with 21 21 + | Some t -> t 22 22 + | None -> Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S" kind s 23 23 + in 24 24 + let enc = format in 25 25 + Jsont.map ~kind ~doc ~dec ~enc Jsont.string

+45

lib/rfc3339.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2024 Anil Madhavapeddy. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** RFC 3339 date/time handling for JSON Feed. 7 7 + 8 8 + Provides parsing, formatting, and jsont combinators for RFC 3339 timestamps 9 9 + as required by the JSON Feed specification. 10 10 + 11 11 + @see <https://www.rfc-editor.org/rfc/rfc3339> RFC 3339 *) 12 12 + 13 13 + 14 14 + val jsont : Ptime.t Jsont.t 15 15 + (** [jsont] is a bidirectional JSON type for RFC 3339 timestamps. 16 16 + 17 17 + On decode: accepts JSON strings in RFC 3339 format (e.g., "2024-11-03T10:30:00Z") 18 18 + On encode: produces UTC timestamps with 'Z' suffix 19 19 + 20 20 + {b Example:} 21 21 + {[ 22 22 + let time = Ptime.of_float_s (Unix.time ()) |> Option.get in 23 23 + Jsont_bytesrw.encode_string Rfc3339.jsont time 24 24 + ]} *) 25 25 + 26 26 + val parse : string -> Ptime.t option 27 27 + (** [parse s] parses an RFC 3339 timestamp string. 28 28 + 29 29 + Accepts various formats: 30 30 + - "2024-11-03T10:30:00Z" (UTC) 31 31 + - "2024-11-03T10:30:00-08:00" (with timezone offset) 32 32 + - "2024-11-03T10:30:00.123Z" (with fractional seconds) 33 33 + 34 34 + Returns [None] if the string is not valid RFC 3339. *) 35 35 + 36 36 + val format : Ptime.t -> string 37 37 + (** [format t] formats a timestamp as RFC 3339. 38 38 + 39 39 + Always uses UTC timezone (Z suffix) and includes fractional seconds 40 40 + if the timestamp has sub-second precision. 41 41 + 42 42 + {b Example output:} ["2024-11-03T10:30:45.123Z"] *) 43 43 + 44 44 + val pp : Format.formatter -> Ptime.t -> unit 45 45 + (** [pp ppf t] pretty prints a timestamp in RFC 3339 format. *)

+25 -18

test/test_jsonfeed.ml

··· 221 221 222 222 let test_feed_to_string () = 223 223 let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in 224 224 - let json = Jsonfeed.to_string feed in 225 225 - Alcotest.(check bool) "contains version" true (contains_substring json "version"); 226 226 - Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed") 224 224 + match Jsonfeed.to_string feed with 225 225 + | Ok json -> 226 226 + Alcotest.(check bool) "contains version" true (contains_substring json "version"); 227 227 + Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed") 228 228 + | Error e -> 229 229 + Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e)) 227 230 228 231 let test_feed_parse_minimal () = 229 232 let json = {|{ ··· 236 239 Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed); 237 240 Alcotest.(check int) "items" 0 (List.length (Jsonfeed.items feed)) 238 241 | Error err -> 239 239 - Alcotest.fail (Printf.sprintf "Parse failed: %s" err) 242 242 + Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err)) 240 243 241 244 let test_feed_parse_with_item () = 242 245 let json = {|{ ··· 259 262 Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item) 260 263 | _ -> Alcotest.fail "Expected 1 item") 261 264 | Error err -> 262 262 - Alcotest.fail (Printf.sprintf "Parse failed: %s" err) 265 265 + Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err)) 263 266 264 267 let test_feed_roundtrip () = 265 268 let author = Author.create ~name:"Test Author" () in ··· 267 270 ~id:"https://example.com/1" 268 271 ~title:"Test Item" 269 272 ~content:(`Html "<p>Hello, world!</p>") 270 270 - ~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get) 273 273 + ~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get) 271 274 ~tags:["test"; "example"] 272 275 () in 273 276 ··· 279 282 () in 280 283 281 284 (* Serialize and parse *) 282 282 - let json = Jsonfeed.to_string feed1 in 283 283 - match Jsonfeed.of_string json with 284 284 - | Ok feed2 -> 285 285 - Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2); 286 286 - Alcotest.(check (option string)) "home_page_url" 287 287 - (Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2); 288 288 - Alcotest.(check int) "items count" 289 289 - (List.length (Jsonfeed.items feed1)) 290 290 - (List.length (Jsonfeed.items feed2)) 291 291 - | Error err -> 292 292 - Alcotest.fail (Printf.sprintf "Round-trip failed: %s" err) 285 285 + match Jsonfeed.to_string feed1 with 286 286 + | Error e -> 287 287 + Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e)) 288 288 + | Ok json -> 289 289 + match Jsonfeed.of_string json with 290 290 + | Ok feed2 -> 291 291 + Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2); 292 292 + Alcotest.(check (option string)) "home_page_url" 293 293 + (Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2); 294 294 + Alcotest.(check int) "items count" 295 295 + (List.length (Jsonfeed.items feed1)) 296 296 + (List.length (Jsonfeed.items feed2)) 297 297 + | Error err -> 298 298 + Alcotest.fail (Printf.sprintf "Round-trip parse failed: %s" (Jsont.Error.to_string err)) 293 299 294 300 let test_feed_parse_invalid_missing_content () = 295 301 let json = {|{ ··· 304 310 match Jsonfeed.of_string json with 305 311 | Ok _ -> Alcotest.fail "Should reject item without content" 306 312 | Error err -> 313 313 + let err_str = Jsont.Error.to_string err in 307 314 Alcotest.(check bool) "has error" true 308 308 - (contains_substring err "content") 315 315 + (contains_substring err_str "content") 309 316 310 317 let jsonfeed_tests = [ 311 318 "create minimal feed", `Quick, test_feed_create_minimal;

+4 -1

test/test_serialization.ml

··· 19 19 () in 20 20 21 21 (* Serialize to JSON *) 22 22 - let json = Jsonfeed.to_string feed in 22 22 + let json = match Jsonfeed.to_string feed with 23 23 + | Ok s -> s 24 24 + | Error e -> failwith (Jsont.Error.to_string e) 25 25 + in 23 26 24 27 (* Print it *) 25 28 Printf.printf "Generated JSON Feed:\n%s\n\n" json;