OCaml library for JSONfeed parsing and creation

jsont wip

+3
.gitignore
···
_build
blog-feed.json
+
*.bak*
+
*.old
+
.*.swp
+22 -14
example/feed_example.ml
···
(* Helper to write feed to output channel *)
let to_file filename feed =
-
let s = Jsonfeed.to_string feed in
-
Out_channel.with_open_gen
-
[Open_wronly; Open_creat; Open_trunc; Open_text]
-
0o644
-
filename
-
(fun oc -> Out_channel.output_string oc s)
+
match Jsonfeed.to_string feed with
+
| Ok s ->
+
Out_channel.with_open_gen
+
[Open_wronly; Open_creat; Open_trunc; Open_text]
+
0o644
+
filename
+
(fun oc -> Out_channel.output_string oc s)
+
| Error e ->
+
Printf.eprintf "Error encoding feed: %s\n" (Jsont.Error.to_string e);
+
exit 1
let create_blog_feed () =
(* Create some authors *)
···
"<p>OCaml is a powerful functional programming language.</p>",
"OCaml is a powerful functional programming language."
))
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
-
~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:30:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
+
~date_modified:(Jsonfeed.Rfc3339.parse "2024-11-01T15:30:00Z" |> Option.get)
~authors:[jane]
~tags:["ocaml"; "programming"; "functional"]
~summary:"A beginner's guide to OCaml programming"
···
~url:"https://example.com/posts/2"
~title:"JSON Feed for Syndication"
~content:(`Html "<p>JSON Feed is a modern alternative to RSS and Atom.</p>")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-02T09:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-02T09:00:00Z" |> Option.get)
~authors:[jane; john]
~tags:["json"; "syndication"; "web"]
~image:"https://example.com/images/jsonfeed.png"
···
let item3 = Item.create
~id:"https://example.com/micro/42"
~content:(`Text "Just shipped a new feature! 🚀")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-03T08:15:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-03T08:15:00Z" |> Option.get)
~tags:["microblog"]
() in
···
~url:"https://podcast.example.com/episodes/1"
~title:"Episode 1: Introduction"
~content:(`Html "<p>Welcome to our first episode!</p>")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get)
~attachments:[attachment]
~authors:[host]
~image:"https://podcast.example.com/episodes/ep1-cover.jpg"
···
Format.printf "Created blog feed: %a\n\n" Jsonfeed.pp blog_feed;
(* Serialize to string *)
-
let json_string = Jsonfeed.to_string blog_feed in
-
Format.printf "JSON (first 200 chars): %s...\n\n"
-
(String.sub json_string 0 (min 200 (String.length json_string)));
+
(match Jsonfeed.to_string blog_feed with
+
| Ok json_string ->
+
Format.printf "JSON (first 200 chars): %s...\n\n"
+
(String.sub json_string 0 (min 200 (String.length json_string)))
+
| Error e ->
+
Printf.eprintf "Error serializing to string: %s\n" (Jsont.Error.to_string e);
+
exit 1);
(* Serialize to file *)
to_file "blog-feed.json" blog_feed;
+16 -12
example/feed_parser.ml
···
(match Item.date_published item with
| Some date ->
Format.printf " Published: %s\n"
-
(Jsonfeed.format_rfc3339 date)
+
(Jsonfeed.Rfc3339.format date)
| None -> ());
(match Item.date_modified item with
| Some date ->
Format.printf " Modified: %s\n"
-
(Jsonfeed.format_rfc3339 date)
+
(Jsonfeed.Rfc3339.format date)
| None -> ());
(* Print tags *)
···
(* Demonstrate round-trip parsing *)
Format.printf "\n=== Round-trip Test ===\n\n";
-
let json = Jsonfeed.to_string feed in
-
(match Jsonfeed.of_string json with
-
| Ok feed2 ->
-
if Jsonfeed.equal feed feed2 then
-
Format.printf "✓ Round-trip successful: feeds are equal\n"
-
else
-
Format.printf "✗ Round-trip failed: feeds differ\n"
-
| Error err ->
-
Format.eprintf "✗ Round-trip failed: %s\n" err)
+
(match Jsonfeed.to_string feed with
+
| Error e ->
+
Printf.eprintf "Error serializing feed: %s\n" (Jsont.Error.to_string e);
+
exit 1
+
| Ok json ->
+
match Jsonfeed.of_string json with
+
| Ok feed2 ->
+
if Jsonfeed.equal feed feed2 then
+
Format.printf "✓ Round-trip successful: feeds are equal\n"
+
else
+
Format.printf "✗ Round-trip failed: feeds differ\n"
+
| Error err ->
+
Format.eprintf "✗ Round-trip failed: %s\n" (Jsont.Error.to_string err))
| Error err ->
-
Format.eprintf "Error parsing feed: %s\n" err
+
Format.eprintf "Error parsing feed: %s\n" (Jsont.Error.to_string err)
with
| Sys_error msg ->
Format.eprintf "Error reading file: %s\n" msg)
+10 -10
example/feed_validator.ml
···
~summary:"A test item"
~image:"https://example.com/image.jpg"
~banner_image:"https://example.com/banner.jpg"
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
-
~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
+
~date_modified:(Jsonfeed.Rfc3339.parse "2024-11-01T15:00:00Z" |> Option.get)
~authors:[author]
~tags:["test"; "example"]
~language:"en"
···
~id:(Printf.sprintf "https://example.com/items/%d" i)
~content:(`Text (Printf.sprintf "Item %d content" i))
~title:(Printf.sprintf "Item %d" i)
-
~date_published:(Jsonfeed.parse_rfc3339
+
~date_published:(Jsonfeed.Rfc3339.parse
(Printf.sprintf "2024-11-%02dT10:00:00Z" (i + 1)) |> Option.get)
()
) in
···
~url:"https://podcast.example.com/episodes/1"
~title:"Episode 1: Introduction"
~content:(`Html "<p>Welcome to the first episode!</p>")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get)
~authors:[host]
~attachments:[episode1; episode1_aac]
~image:"https://podcast.example.com/ep1-cover.jpg"
···
Item.create
~id:"https://micro.example.com/1"
~content:(`Text "Just posted a new photo!")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T08:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T08:00:00Z" |> Option.get)
();
Item.create
~id:"https://micro.example.com/2"
~content:(`Text "Having a great day! ☀️")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:30:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:30:00Z" |> Option.get)
();
Item.create
~id:"https://micro.example.com/3"
~content:(`Html "<p>Check out this <a href=\"#\">link</a></p>")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T16:45:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T16:45:00Z" |> Option.get)
()
] in
···
(match Jsonfeed.of_string invalid_json1 with
| Ok _ -> Format.printf "✗ Should have failed (missing version)\n"
| Error err ->
-
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err));
(* Missing required title field *)
let invalid_json2 = {|{
···
(match Jsonfeed.of_string invalid_json2 with
| Ok _ -> Format.printf "✗ Should have failed (missing title)\n"
| Error err ->
-
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err));
(* Item without id *)
let invalid_json3 = {|{
···
(match Jsonfeed.of_string invalid_json3 with
| Ok _ -> Format.printf "✗ Should have failed (item without id)\n"
| Error err ->
-
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" (Jsont.Error.to_string err));
Format.printf "\n"
+49 -2
lib/attachment.ml
···
-
(** Attachments for JSON Feed items. *)
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
type t = {
url : string;
···
title : string option;
size_in_bytes : int64 option;
duration_in_seconds : int option;
+
unknown : Unknown.t;
}
+
let make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ?(unknown = Unknown.empty) () =
+
{ url; mime_type; title; size_in_bytes; duration_in_seconds; unknown }
+
let create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds () =
-
{ url; mime_type; title; size_in_bytes; duration_in_seconds }
+
make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()
let url t = t.url
let mime_type t = t.mime_type
let title t = t.title
let size_in_bytes t = t.size_in_bytes
let duration_in_seconds t = t.duration_in_seconds
+
let unknown t = t.unknown
let equal a b =
a.url = b.url &&
···
| None -> ());
Format.fprintf ppf ")"
+
+
let jsont =
+
let kind = "Attachment" in
+
let doc = "An attachment object" in
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
+
in
+
let make_obj url mime_type title size_in_bytes duration_in_seconds unknown =
+
make ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ~unknown ()
+
in
+
Jsont.Object.map ~kind ~doc make_obj
+
|> Jsont.Object.mem "url" Jsont.string ~enc:url
+
|> Jsont.Object.mem "mime_type" Jsont.string ~enc:mime_type
+
|> Jsont.Object.opt_mem "title" Jsont.string ~enc:title
+
|> Jsont.Object.opt_mem "size_in_bytes" Jsont.int64 ~enc:size_in_bytes
+
|> Jsont.Object.opt_mem "duration_in_seconds" Jsont.int ~enc:duration_in_seconds
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
+
|> Jsont.Object.finish
+51 -16
lib/attachment.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
(** Attachments for JSON Feed items.
An attachment represents an external resource related to a feed item,
···
type t
+
(** {1 Unknown Fields} *)
+
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
+
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
+
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
+
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for attachments.
+
+
Maps JSON objects with "url" (required), "mime_type" (required),
+
and optional "title", "size_in_bytes", "duration_in_seconds" fields. *)
+
+
(** {1 Construction} *)
+
val create :
+
url:string ->
+
mime_type:string ->
+
?title:string ->
+
?size_in_bytes:int64 ->
+
?duration_in_seconds:int ->
+
unit ->
+
t
(** [create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()]
creates an attachment object.
···
~title:"Episode 42"
~size_in_bytes:15_728_640L
~duration_in_seconds:1800 ()
-
-
(* Alternate format (same title indicates same content) *)
-
let att2 = Attachment.create
-
~url:"https://example.com/episode.aac"
-
~mime_type:"audio/aac"
-
~title:"Episode 42"
-
~size_in_bytes:12_582_912L
-
~duration_in_seconds:1800 ()
]} *)
-
val create :
+
+
val make :
url:string ->
mime_type:string ->
?title:string ->
?size_in_bytes:int64 ->
?duration_in_seconds:int ->
+
?unknown:Unknown.t ->
unit ->
t
+
(** [make] is like {!create} but allows setting unknown fields. *)
(** {1 Accessors} *)
+
val url : t -> string
(** [url t] returns the attachment's URL. *)
-
val url : t -> string
-
(** [mime_type t] returns the attachment's MIME type. *)
val mime_type : t -> string
+
(** [mime_type t] returns the attachment's MIME type. *)
-
(** [title t] returns the attachment's title, if set. *)
val title : t -> string option
+
(** [title t] returns the attachment's title, if set. *)
-
(** [size_in_bytes t] returns the attachment's size in bytes, if set. *)
val size_in_bytes : t -> int64 option
+
(** [size_in_bytes t] returns the attachment's size in bytes, if set. *)
-
(** [duration_in_seconds t] returns the attachment's duration, if set. *)
val duration_in_seconds : t -> int option
+
(** [duration_in_seconds t] returns the attachment's duration, if set. *)
+
+
val unknown : t -> Unknown.t
+
(** [unknown t] returns unrecognized fields from the JSON. *)
(** {1 Comparison} *)
-
(** [equal a b] tests equality between two attachments. *)
val equal : t -> t -> bool
+
(** [equal a b] tests equality between two attachments. *)
(** {1 Pretty Printing} *)
+
val pp : Format.formatter -> t -> unit
(** [pp ppf t] pretty prints an attachment to the formatter.
The output is human-readable and suitable for debugging.
{b Example output:}
{v episode.mp3 (audio/mpeg, 15.0 MB, 30m0s) v} *)
-
val pp : Format.formatter -> t -> unit
+50 -3
lib/author.ml
···
-
(** Author information for JSON Feed items and feeds. *)
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
type t = {
name : string option;
url : string option;
avatar : string option;
+
unknown : Unknown.t;
}
+
let make ?name ?url ?avatar ?(unknown = Unknown.empty) () =
+
{ name; url; avatar; unknown }
+
let create ?name ?url ?avatar () =
if name = None && url = None && avatar = None then
invalid_arg "Author.create: at least one field (name, url, or avatar) must be provided";
-
{ name; url; avatar }
+
make ?name ?url ?avatar ()
let name t = t.name
let url t = t.url
let avatar t = t.avatar
+
let unknown t = t.unknown
let is_valid t =
t.name <> None || t.url <> None || t.avatar <> None
let equal a b =
-
a.name = b.name && a.url = b.url && a.avatar = b.avatar
+
a.name = b.name &&
+
a.url = b.url &&
+
a.avatar = b.avatar
let pp ppf t =
match t.name, t.url with
···
match t.avatar with
| Some avatar -> Format.fprintf ppf "(avatar: %s)" avatar
| None -> Format.fprintf ppf "(empty author)"
+
+
let jsont =
+
let kind = "Author" in
+
let doc = "An author object with at least one field set" in
+
(* Custom mems map for Unknown.t that strips metadata from names *)
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
+
in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
+
in
+
(* Constructor that matches the jsont object map pattern *)
+
let make_obj name url avatar unknown = make ?name ?url ?avatar ~unknown () in
+
Jsont.Object.map ~kind ~doc make_obj
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
+
|> Jsont.Object.opt_mem "url" Jsont.string ~enc:url
+
|> Jsont.Object.opt_mem "avatar" Jsont.string ~enc:avatar
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
+
|> Jsont.Object.finish
+46 -8
lib/author.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
(** Author information for JSON Feed items and feeds.
An author object provides information about the creator of a feed or item.
···
type t
+
(** {1 Unknown Fields} *)
+
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
+
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
+
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
+
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for authors.
+
+
Maps JSON objects with optional "name", "url", and "avatar" fields.
+
At least one field must be present during decoding. *)
+
+
(** {1 Construction} *)
-
(** [create ?name ?url ?avatar ()] creates an author object.
+
val create : ?name:string -> ?url:string -> ?avatar:string -> unit -> t
+
(** [create ?name ?url ?avatar ()] creates an author.
At least one of the optional parameters must be provided, otherwise
the function will raise [Invalid_argument].
···
~url:"https://janedoe.com"
~avatar:"https://janedoe.com/avatar.png" ()
]} *)
-
val create : ?name:string -> ?url:string -> ?avatar:string -> unit -> t
+
+
val make :
+
?name:string -> ?url:string -> ?avatar:string ->
+
?unknown:Unknown.t -> unit -> t
+
(** [make] is like {!create} but allows setting unknown fields.
+
Useful when round-tripping JSON with custom extensions. *)
(** {1 Accessors} *)
+
val name : t -> string option
(** [name t] returns the author's name, if set. *)
-
val name : t -> string option
-
(** [url t] returns the author's URL, if set. *)
val url : t -> string option
+
(** [url t] returns the author's URL, if set. *)
+
val avatar : t -> string option
(** [avatar t] returns the author's avatar URL, if set. *)
-
val avatar : t -> string option
+
+
val unknown : t -> Unknown.t
+
(** [unknown t] returns unrecognized fields from the JSON. *)
(** {1 Predicates} *)
+
val is_valid : t -> bool
(** [is_valid t] checks if the author has at least one field set.
This should always return [true] for authors created via {!create},
but may be useful when parsing from external sources. *)
-
val is_valid : t -> bool
(** {1 Comparison} *)
-
(** [equal a b] tests equality between two authors. *)
val equal : t -> t -> bool
+
(** [equal a b] tests equality between two authors. *)
(** {1 Pretty Printing} *)
+
val pp : Format.formatter -> t -> unit
(** [pp ppf t] pretty prints an author to the formatter.
The output is human-readable and suitable for debugging.
{b Example output:}
{v Jane Doe <https://janedoe.com> v} *)
-
val pp : Format.formatter -> t -> unit
+7
lib/cito.ml
···
| _ -> a = b
let pp ppf t = Format.fprintf ppf "%s" (to_string t)
+
+
let jsont =
+
let kind = "CiTO intent" in
+
let doc = "A Citation Typing Ontology intent annotation" in
+
let dec = of_string in
+
let enc = to_string in
+
Jsont.map ~kind ~doc ~dec ~enc Jsont.string
+9
lib/cito.mli
···
val equal : t -> t -> bool
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for CiTO annotations.
+
+
Maps CiTO intent strings to the corresponding variants.
+
Unknown intents are mapped to [`Other s]. *)
+
+
(** {1 Pretty Printing} *)
(** [pp ppf t] pretty prints a CiTO annotation to the formatter.
+1 -1
lib/dune
···
(library
(name jsonfeed)
(public_name jsonfeed)
-
(libraries jsonm ptime fmt))
+
(libraries jsont jsont.bytesrw bytesrw ptime))
+43 -2
lib/hub.ml
···
-
(** Hub endpoints for real-time notifications. *)
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
type t = {
type_ : string;
url : string;
+
unknown : Unknown.t;
}
+
let make ~type_ ~url ?(unknown = Unknown.empty) () =
+
{ type_; url; unknown }
+
let create ~type_ ~url () =
-
{ type_; url }
+
make ~type_ ~url ()
let type_ t = t.type_
let url t = t.url
+
let unknown t = t.unknown
let equal a b =
a.type_ = b.type_ && a.url = b.url
let pp ppf t =
Format.fprintf ppf "%s: %s" t.type_ t.url
+
+
let jsont =
+
let kind = "Hub" in
+
let doc = "A hub endpoint" in
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
+
in
+
let make_obj type_ url unknown = make ~type_ ~url ~unknown () in
+
Jsont.Object.map ~kind ~doc make_obj
+
|> Jsont.Object.mem "type" Jsont.string ~enc:type_
+
|> Jsont.Object.mem "url" Jsont.string ~enc:url
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
+
|> Jsont.Object.finish
+41 -5
lib/hub.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
(** Hub endpoints for real-time notifications.
Hubs describe endpoints that can be used to subscribe to real-time
···
type t
+
(** {1 Unknown Fields} *)
+
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
+
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
+
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
+
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for hubs.
+
+
Maps JSON objects with "type" and "url" fields (both required). *)
+
+
(** {1 Construction} *)
+
val create : type_:string -> url:string -> unit -> t
(** [create ~type_ ~url ()] creates a hub object.
@param type_ The type of hub protocol (e.g., ["rssCloud"], ["WebSub"])
···
~type_:"WebSub"
~url:"https://pubsubhubbub.appspot.com/" ()
]} *)
-
val create : type_:string -> url:string -> unit -> t
+
+
val make :
+
type_:string -> url:string ->
+
?unknown:Unknown.t -> unit -> t
+
(** [make] is like {!create} but allows setting unknown fields. *)
(** {1 Accessors} *)
-
(** [type_ t] returns the hub's protocol type. *)
val type_ : t -> string
+
(** [type_ t] returns the hub's protocol type. *)
+
val url : t -> string
(** [url t] returns the hub's endpoint URL. *)
-
val url : t -> string
+
+
val unknown : t -> Unknown.t
+
(** [unknown t] returns unrecognized fields from the JSON. *)
(** {1 Comparison} *)
-
(** [equal a b] tests equality between two hubs. *)
val equal : t -> t -> bool
+
(** [equal a b] tests equality between two hubs. *)
(** {1 Pretty Printing} *)
+
val pp : Format.formatter -> t -> unit
(** [pp ppf t] pretty prints a hub to the formatter.
The output is human-readable and suitable for debugging.
{b Example output:}
{v WebSub: https://pubsubhubbub.appspot.com/ v} *)
-
val pp : Format.formatter -> t -> unit
+116 -36
lib/item.ml
···
-
(** Feed items in a JSON Feed. *)
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
-
type content =
-
[ `Html of string
+
type content = [
+
| `Html of string
| `Text of string
| `Both of string * string
-
]
+
]
type t = {
id : string;
···
language : string option;
attachments : Attachment.t list option;
references : Reference.t list option;
+
unknown : Unknown.t;
}
-
let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
-
?date_published ?date_modified ?authors ?tags ?language ?attachments ?references () =
+
let make ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
+
?date_published ?date_modified ?authors ?tags ?language ?attachments ?references
+
?(unknown = Unknown.empty) () =
{
-
id;
-
content;
-
url;
-
external_url;
-
title;
-
summary;
-
image;
-
banner_image;
-
date_published;
-
date_modified;
-
authors;
-
tags;
-
language;
-
attachments;
-
references;
+
id; content; url; external_url; title; summary; image; banner_image;
+
date_published; date_modified; authors; tags; language; attachments; references;
+
unknown;
}
+
+
let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
+
?date_published ?date_modified ?authors ?tags ?language ?attachments ?references () =
+
make ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
+
?date_published ?date_modified ?authors ?tags ?language ?attachments ?references ()
let id t = t.id
let content t = t.content
···
let language t = t.language
let attachments t = t.attachments
let references t = t.references
+
let unknown t = t.unknown
let content_html t =
match t.content with
···
| `Text text -> Some text
| `Both (_, text) -> Some text
-
let equal a b =
-
(* Items are equal if they have the same ID *)
-
a.id = b.id
+
let equal a b = a.id = b.id
let compare a b =
-
(* Compare by publication date, with items without dates considered older *)
match a.date_published, b.date_published with
| None, None -> 0
-
| None, Some _ -> -1 (* Items without dates are "older" *)
+
| None, Some _ -> -1
| Some _, None -> 1
| Some da, Some db -> Ptime.compare da db
-
let pp_content ppf = function
-
| `Html html ->
-
Format.fprintf ppf "HTML (%d chars)" (String.length html)
-
| `Text text ->
-
Format.fprintf ppf "Text (%d chars)" (String.length text)
-
| `Both (html, text) ->
-
Format.fprintf ppf "Both (HTML: %d chars, Text: %d chars)"
-
(String.length html) (String.length text)
-
let pp ppf t =
match t.date_published, t.title with
| Some date, Some title ->
-
(* Use Ptime's date formatting *)
let (y, m, d), _ = Ptime.to_date_time date in
Format.fprintf ppf "[%04d-%02d-%02d] %s (%s)" y m d title t.id
| Some date, None ->
···
Format.fprintf ppf "%s (%s)" title t.id
| None, None ->
Format.fprintf ppf "%s" t.id
+
+
let pp_summary ppf t =
+
match t.title with
+
| Some title -> Format.fprintf ppf "%s" title
+
| None -> Format.fprintf ppf "%s" t.id
+
+
(* Jsont type *)
+
+
let jsont =
+
let kind = "Item" in
+
let doc = "A JSON Feed item" in
+
+
(* Helper to construct item from JSON fields *)
+
let make_from_json id content_html content_text url external_url title summary
+
image banner_image date_published date_modified authors tags language
+
attachments references _extensions unknown =
+
(* Determine content from content_html and content_text *)
+
let content = match content_html, content_text with
+
| Some html, Some text -> `Both (html, text)
+
| Some html, None -> `Html html
+
| None, Some text -> `Text text
+
| None, None ->
+
Jsont.Error.msg Jsont.Meta.none
+
"Item must have at least one of content_html or content_text"
+
in
+
{ id; content; url; external_url; title; summary; image; banner_image;
+
date_published; date_modified; authors; tags; language; attachments;
+
references; unknown }
+
in
+
+
(* Encoders to extract fields from item *)
+
let enc_id t = t.id in
+
let enc_content_html t = content_html t in
+
let enc_content_text t = content_text t in
+
let enc_url t = t.url in
+
let enc_external_url t = t.external_url in
+
let enc_title t = t.title in
+
let enc_summary t = t.summary in
+
let enc_image t = t.image in
+
let enc_banner_image t = t.banner_image in
+
let enc_date_published t = t.date_published in
+
let enc_date_modified t = t.date_modified in
+
let enc_authors t = t.authors in
+
let enc_tags t = t.tags in
+
let enc_language t = t.language in
+
let enc_attachments t = t.attachments in
+
let enc_references t = t.references in
+
let enc_unknown t = t.unknown in
+
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
+
in
+
+
Jsont.Object.map ~kind ~doc make_from_json
+
|> Jsont.Object.mem "id" Jsont.string ~enc:enc_id
+
|> Jsont.Object.opt_mem "content_html" Jsont.string ~enc:enc_content_html
+
|> Jsont.Object.opt_mem "content_text" Jsont.string ~enc:enc_content_text
+
|> Jsont.Object.opt_mem "url" Jsont.string ~enc:enc_url
+
|> Jsont.Object.opt_mem "external_url" Jsont.string ~enc:enc_external_url
+
|> Jsont.Object.opt_mem "title" Jsont.string ~enc:enc_title
+
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:enc_summary
+
|> Jsont.Object.opt_mem "image" Jsont.string ~enc:enc_image
+
|> Jsont.Object.opt_mem "banner_image" Jsont.string ~enc:enc_banner_image
+
|> Jsont.Object.opt_mem "date_published" Rfc3339.jsont ~enc:enc_date_published
+
|> Jsont.Object.opt_mem "date_modified" Rfc3339.jsont ~enc:enc_date_modified
+
|> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:enc_authors
+
|> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:enc_tags
+
|> Jsont.Object.opt_mem "language" Jsont.string ~enc:enc_language
+
|> Jsont.Object.opt_mem "attachments" (Jsont.list Attachment.jsont) ~enc:enc_attachments
+
|> Jsont.Object.opt_mem "_references" (Jsont.list Reference.jsont) ~enc:enc_references
+
|> Jsont.Object.opt_mem "_extensions" Jsont.json_object ~enc:(fun _t -> None)
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:enc_unknown
+
|> Jsont.Object.finish
+51 -129
lib/item.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
(** Feed items in a JSON Feed.
An item represents a single entry in a feed, such as a blog post, podcast episode,
···
- [`Html s]: Item has HTML content only
- [`Text s]: Item has plain text content only
- [`Both (html, text)]: Item has both HTML and plain text versions *)
-
type content =
-
[ `Html of string
+
type content = [
+
| `Html of string
| `Text of string
| `Both of string * string
-
]
+
]
-
(** {1 Construction} *)
+
(** {1 Unknown Fields} *)
-
(** [create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
-
?date_published ?date_modified ?authors ?tags ?language ?attachments ()]
-
creates a feed item.
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
-
@param id Unique identifier for the item (required). Should be a full URL if possible.
-
@param content The item's content in HTML and/or plain text (required)
-
@param url Permalink to the item
-
@param external_url URL of an external resource (useful for linkblogs)
-
@param title Plain text title of the item
-
@param summary Plain text summary/excerpt of the item
-
@param image URL of the main featured image for the item
-
@param banner_image URL of a banner image for the item
-
@param date_published Publication date/time (RFC 3339 format)
-
@param date_modified Last modification date/time (RFC 3339 format)
-
@param authors Item-specific authors (overrides feed-level authors)
-
@param tags Plain text tags/categories for the item
-
@param language Primary language of the item (RFC 5646 format, e.g. ["en-US"])
-
@param attachments Related resources like audio files or downloads
-
@param references References to cited sources (extension)
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
-
{b Examples:}
-
{[
-
(* Simple blog post *)
-
let item = Item.create
-
~id:"https://example.com/posts/42"
-
~content:(`Html "<p>Hello, world!</p>")
-
~title:"My First Post"
-
~url:"https://example.com/posts/42" ()
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
-
(* Microblog entry with plain text *)
-
let item = Item.create
-
~id:"https://example.com/micro/123"
-
~content:(`Text "Just posted a new photo!")
-
~date_published:(Ptime.of_float_s (Unix.time ()) |> Option.get) ()
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for feed items.
+
+
Maps JSON objects with "id" (required), content fields, and various optional metadata.
+
The content must have at least one of "content_html" or "content_text". *)
-
(* Article with both HTML and plain text *)
-
let item = Item.create
-
~id:"https://example.com/article/99"
-
~content:(`Both ("<p>Rich content</p>", "Plain version"))
-
~title:"Article Title"
-
~tags:["ocaml"; "programming"] ()
-
(* Podcast episode with attachment *)
-
let attachment = Attachment.create
-
~url:"https://example.com/ep1.mp3"
-
~mime_type:"audio/mpeg"
-
~duration_in_seconds:1800 () in
-
let item = Item.create
-
~id:"https://example.com/podcast/1"
-
~content:(`Html "<p>Episode description</p>")
-
~title:"Episode 1"
-
~attachments:[attachment] ()
+
(** {1 Construction} *)
-
(* Article with references *)
-
let reference = Reference.create
-
~url:"https://doi.org/10.5281/zenodo.16755947"
-
~doi:"10.5281/zenodo.16755947"
-
~cito:[`CitesAsRecommendedReading; `UsesMethodIn] () in
-
let item = Item.create
-
~id:"https://doi.org/10.59350/krw9n-dv417"
-
~content:(`Html "<p>Research article content</p>")
-
~title:"One Million IUPAC names #4: a lot is happening"
-
~url:"https://chem-bla-ics.linkedchemistry.info/2025/08/09/one-million-iupac-names-4.html"
-
~references:[reference] ()
-
]} *)
val create :
id:string ->
content:content ->
···
unit ->
t
+
val make :
+
id:string ->
+
content:content ->
+
?url:string ->
+
?external_url:string ->
+
?title:string ->
+
?summary:string ->
+
?image:string ->
+
?banner_image:string ->
+
?date_published:Ptime.t ->
+
?date_modified:Ptime.t ->
+
?authors:Author.t list ->
+
?tags:string list ->
+
?language:string ->
+
?attachments:Attachment.t list ->
+
?references:Reference.t list ->
+
?unknown:Unknown.t ->
+
unit ->
+
t
+
(** {1 Accessors} *)
-
(** [id t] returns the item's unique identifier. *)
val id : t -> string
-
-
(** [content t] returns the item's content. *)
val content : t -> content
-
-
(** [url t] returns the item's permalink URL, if set. *)
+
val content_html : t -> string option
+
val content_text : t -> string option
val url : t -> string option
-
-
(** [external_url t] returns the external resource URL, if set. *)
val external_url : t -> string option
-
-
(** [title t] returns the item's title, if set. *)
val title : t -> string option
-
-
(** [summary t] returns the item's summary, if set. *)
val summary : t -> string option
-
-
(** [image t] returns the item's featured image URL, if set. *)
val image : t -> string option
-
-
(** [banner_image t] returns the item's banner image URL, if set. *)
val banner_image : t -> string option
-
-
(** [date_published t] returns the item's publication date, if set. *)
val date_published : t -> Ptime.t option
-
-
(** [date_modified t] returns the item's last modification date, if set. *)
val date_modified : t -> Ptime.t option
-
-
(** [authors t] returns the item's authors, if set. *)
val authors : t -> Author.t list option
-
-
(** [tags t] returns the item's tags, if set. *)
val tags : t -> string list option
-
-
(** [language t] returns the item's language code, if set. *)
val language : t -> string option
-
-
(** [attachments t] returns the item's attachments, if set. *)
val attachments : t -> Attachment.t list option
-
-
(** [references t] returns the item's references, if set. *)
val references : t -> Reference.t list option
-
-
-
(** {1 Content Helpers} *)
-
-
(** [content_html t] extracts HTML content from the item.
-
-
Returns [Some html] if the item has HTML content (either [Html] or [Both]),
-
[None] otherwise. *)
-
val content_html : t -> string option
-
-
(** [content_text t] extracts plain text content from the item.
-
-
Returns [Some text] if the item has plain text content (either [Text] or [Both]),
-
[None] otherwise. *)
-
val content_text : t -> string option
+
val unknown : t -> Unknown.t
(** {1 Comparison} *)
-
(** [equal a b] tests equality between two items.
-
-
Items are considered equal if they have the same ID. *)
val equal : t -> t -> bool
-
-
(** [compare a b] compares two items by their publication dates.
-
-
Items without publication dates are considered older than items with dates.
-
Useful for sorting items chronologically. *)
val compare : t -> t -> int
(** {1 Pretty Printing} *)
-
(** [pp ppf t] pretty prints an item to the formatter.
-
-
The output is human-readable and suitable for debugging.
-
-
{b Example output:}
-
{v [2024-11-03] My First Post (https://example.com/posts/42) v} *)
val pp : Format.formatter -> t -> unit
-
-
(** [pp_content ppf content] pretty prints content to the formatter.
-
-
{b Example output:}
-
{v HTML (123 chars) v}
-
{v Text (56 chars) v}
-
{v Both (HTML: 123 chars, Text: 56 chars) v} *)
-
val pp_content : Format.formatter -> content -> unit
+
val pp_summary : Format.formatter -> t -> unit
+104 -490
lib/jsonfeed.ml
···
-
(** JSON Feed format parser and serializer. *)
-
-
exception Invalid_feed of string
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
module Rfc3339 = Rfc3339
+
module Cito = Cito
module Author = Author
module Attachment = Attachment
module Hub = Hub
+
module Reference = Reference
module Item = Item
-
module Reference = Reference
-
module Cito = Cito
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
type t = {
version : string;
···
expired : bool option;
hubs : Hub.t list option;
items : Item.t list;
+
unknown : Unknown.t;
}
-
let create ~title ?home_page_url ?feed_url ?description ?user_comment
-
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () =
+
let make ~title ?home_page_url ?feed_url ?description ?user_comment
+
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items
+
?(unknown = Unknown.empty) () =
{
version = "https://jsonfeed.org/version/1.1";
title;
···
expired;
hubs;
items;
+
unknown;
}
+
let create ~title ?home_page_url ?feed_url ?description ?user_comment
+
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () =
+
make ~title ?home_page_url ?feed_url ?description ?user_comment
+
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items ()
+
let version t = t.version
let title t = t.title
let home_page_url t = t.home_page_url
···
let expired t = t.expired
let hubs t = t.hubs
let items t = t.items
-
-
(* RFC3339 date utilities *)
-
-
let parse_rfc3339 s =
-
match Ptime.of_rfc3339 s with
-
| Ok (t, _, _) -> Some t
-
| Error _ -> None
-
-
let format_rfc3339 t =
-
Ptime.to_rfc3339 t
-
-
(* JSON parsing and serialization *)
-
-
type error = string
-
-
let error_msgf fmt = Format.kasprintf (fun s -> Error s) fmt
-
-
(* JSON parsing helpers *)
-
-
type json_value =
-
| Null
-
| Bool of bool
-
| Float of float
-
| String of string
-
| Array of json_value list
-
| Object of (string * json_value) list
-
-
let rec decode_value dec =
-
match Jsonm.decode dec with
-
| `Lexeme `Null -> Null
-
| `Lexeme (`Bool b) -> Bool b
-
| `Lexeme (`Float f) -> Float f
-
| `Lexeme (`String s) -> String s
-
| `Lexeme `Os -> decode_object dec []
-
| `Lexeme `As -> decode_array dec []
-
| `Lexeme _ -> Null
-
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
-
| `End | `Await -> Null
-
-
and decode_object dec acc =
-
match Jsonm.decode dec with
-
| `Lexeme `Oe -> Object (List.rev acc)
-
| `Lexeme (`Name n) ->
-
let v = decode_value dec in
-
decode_object dec ((n, v) :: acc)
-
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
-
| _ -> Object (List.rev acc)
-
-
and decode_array dec acc =
-
match Jsonm.decode dec with
-
| `Lexeme `Ae -> Array (List.rev acc)
-
| `Lexeme `Os ->
-
let v = decode_object dec [] in
-
decode_array dec (v :: acc)
-
| `Lexeme `As ->
-
let v = decode_array dec [] in
-
decode_array dec (v :: acc)
-
| `Lexeme `Null -> decode_array dec (Null :: acc)
-
| `Lexeme (`Bool b) -> decode_array dec (Bool b :: acc)
-
| `Lexeme (`Float f) -> decode_array dec (Float f :: acc)
-
| `Lexeme (`String s) -> decode_array dec (String s :: acc)
-
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
-
| _ -> Array (List.rev acc)
-
-
(* Helpers to extract values from JSON *)
-
-
let get_string = function String s -> Some s | _ -> None
-
let get_bool = function Bool b -> Some b | _ -> None
-
let _get_float = function Float f -> Some f | _ -> None
-
let get_int = function Float f -> Some (int_of_float f) | _ -> None
-
let get_int64 = function Float f -> Some (Int64.of_float f) | _ -> None
-
let get_array = function Array arr -> Some arr | _ -> None
-
let _get_object = function Object obj -> Some obj | _ -> None
-
-
let find_field name obj = List.assoc_opt name obj
-
-
let require_field name obj =
-
match find_field name obj with
-
| Some v -> v
-
| None -> raise (Invalid_feed (Printf.sprintf "Missing required field: %s" name))
-
-
let require_string name obj =
-
match require_field name obj |> get_string with
-
| Some s -> s
-
| None -> raise (Invalid_feed (Printf.sprintf "Field %s must be a string" name))
-
-
let optional_string name obj =
-
match find_field name obj with Some v -> get_string v | None -> None
-
-
let optional_bool name obj =
-
match find_field name obj with Some v -> get_bool v | None -> None
-
-
let optional_int name obj =
-
match find_field name obj with Some v -> get_int v | None -> None
-
-
let optional_int64 name obj =
-
match find_field name obj with Some v -> get_int64 v | None -> None
-
-
let optional_array name obj =
-
match find_field name obj with Some v -> get_array v | None -> None
-
-
(* Parse Author *)
-
-
let parse_author_obj obj =
-
let name = optional_string "name" obj in
-
let url = optional_string "url" obj in
-
let avatar = optional_string "avatar" obj in
-
if name = None && url = None && avatar = None then
-
raise (Invalid_feed "Author must have at least one field");
-
Author.create ?name ?url ?avatar ()
-
-
let parse_author = function
-
| Object obj -> parse_author_obj obj
-
| _ -> raise (Invalid_feed "Author must be an object")
-
-
(* Parse Attachment *)
-
-
let parse_attachment_obj obj =
-
let url = require_string "url" obj in
-
let mime_type = require_string "mime_type" obj in
-
let title = optional_string "title" obj in
-
let size_in_bytes = optional_int64 "size_in_bytes" obj in
-
let duration_in_seconds = optional_int "duration_in_seconds" obj in
-
Attachment.create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()
-
-
let parse_attachment = function
-
| Object obj -> parse_attachment_obj obj
-
| _ -> raise (Invalid_feed "Attachment must be an object")
-
-
(* Parse Hub *)
-
-
let parse_hub_obj obj =
-
let type_ = require_string "type" obj in
-
let url = require_string "url" obj in
-
Hub.create ~type_ ~url ()
-
-
let parse_hub = function
-
| Object obj -> parse_hub_obj obj
-
| _ -> raise (Invalid_feed "Hub must be an object")
-
-
(* Parse Item *)
-
-
let parse_item_obj obj =
-
let id = require_string "id" obj in
-
-
(* Parse content - at least one required *)
-
let content_html = optional_string "content_html" obj in
-
let content_text = optional_string "content_text" obj in
-
let content = match content_html, content_text with
-
| Some html, Some text -> `Both (html, text)
-
| Some html, None -> `Html html
-
| None, Some text -> `Text text
-
| None, None ->
-
raise (Invalid_feed "Item must have content_html or content_text")
-
in
-
-
let url = optional_string "url" obj in
-
let external_url = optional_string "external_url" obj in
-
let title = optional_string "title" obj in
-
let summary = optional_string "summary" obj in
-
let image = optional_string "image" obj in
-
let banner_image = optional_string "banner_image" obj in
-
-
let date_published =
-
match optional_string "date_published" obj with
-
| Some s -> parse_rfc3339 s
-
| None -> None
-
in
-
-
let date_modified =
-
match optional_string "date_modified" obj with
-
| Some s -> parse_rfc3339 s
-
| None -> None
-
in
-
-
let authors =
-
match optional_array "authors" obj with
-
| Some arr ->
-
let parsed = List.map parse_author arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
let tags =
-
match optional_array "tags" obj with
-
| Some arr ->
-
let parsed = List.filter_map get_string arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
let language = optional_string "language" obj in
-
-
let attachments =
-
match optional_array "attachments" obj with
-
| Some arr ->
-
let parsed = List.map parse_attachment arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
let parse_reference = function
-
| Object obj ->
-
let url = require_string "url" obj in
-
let doi = optional_string "doi" obj in
-
Reference.create ~url ?doi ()
-
| _ -> raise (Invalid_feed "Reference must be an object")
-
in
-
-
let references =
-
match optional_array "_references" obj with
-
| Some arr ->
-
let parsed = List.map parse_reference arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
Item.create ~id ~content ?url ?external_url ?title ?summary ?image
-
?banner_image ?date_published ?date_modified ?authors ?tags ?language
-
?attachments ?references ()
-
-
let parse_item = function
-
| Object obj -> parse_item_obj obj
-
| _ -> raise (Invalid_feed "Item must be an object")
-
-
(* Parse Feed *)
-
-
let parse_feed_obj obj =
-
let version = require_string "version" obj in
-
let title = require_string "title" obj in
-
let home_page_url = optional_string "home_page_url" obj in
-
let feed_url = optional_string "feed_url" obj in
-
let description = optional_string "description" obj in
-
let user_comment = optional_string "user_comment" obj in
-
let next_url = optional_string "next_url" obj in
-
let icon = optional_string "icon" obj in
-
let favicon = optional_string "favicon" obj in
-
let language = optional_string "language" obj in
-
let expired = optional_bool "expired" obj in
-
-
let authors =
-
match optional_array "authors" obj with
-
| Some arr ->
-
let parsed = List.map parse_author arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
let hubs =
-
match optional_array "hubs" obj with
-
| Some arr ->
-
let parsed = List.map parse_hub arr in
-
if parsed = [] then None else Some parsed
-
| None -> None
-
in
-
-
let items =
-
match optional_array "items" obj with
-
| Some arr -> List.map parse_item arr
-
| None -> []
-
in
-
-
{
-
version;
-
title;
-
home_page_url;
-
feed_url;
-
description;
-
user_comment;
-
next_url;
-
icon;
-
favicon;
-
authors;
-
language;
-
expired;
-
hubs;
-
items;
-
}
+
let unknown t = t.unknown
-
let of_jsonm dec =
-
try
-
let json = decode_value dec in
-
match json with
-
| Object obj -> Ok (parse_feed_obj obj)
-
| _ -> error_msgf "Feed must be a JSON object"
-
with
-
| Invalid_feed msg -> error_msgf "%s" msg
+
let equal a b =
+
a.title = b.title &&
+
a.items = b.items
-
(* JSON serialization *)
+
let pp ppf t =
+
Format.fprintf ppf "Feed: %s (%d items)" t.title (List.length t.items)
-
let to_jsonm enc feed =
-
let enc_field name value_fn =
-
ignore (Jsonm.encode enc (`Lexeme (`Name name)));
-
value_fn ()
-
in
+
let pp_summary ppf t =
+
Format.fprintf ppf "%s (%d items)" t.title (List.length t.items)
-
let enc_string s =
-
ignore (Jsonm.encode enc (`Lexeme (`String s)))
-
in
+
(* Jsont type *)
-
let enc_bool b =
-
ignore (Jsonm.encode enc (`Lexeme (`Bool b)))
+
let jsont =
+
let kind = "JSON Feed" in
+
let doc = "A JSON Feed document" in
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
in
-
let enc_opt enc_fn = function
-
| None -> ()
-
| Some v -> enc_fn v
+
(* Helper constructor that sets version automatically *)
+
let make_from_json _version title home_page_url feed_url description user_comment
+
next_url icon favicon authors language expired hubs items unknown =
+
{
+
version = "https://jsonfeed.org/version/1.1";
+
title;
+
home_page_url;
+
feed_url;
+
description;
+
user_comment;
+
next_url;
+
icon;
+
favicon;
+
authors;
+
language;
+
expired;
+
hubs;
+
items;
+
unknown;
+
}
in
-
let enc_list enc_fn lst =
-
ignore (Jsonm.encode enc (`Lexeme `As));
-
List.iter enc_fn lst;
-
ignore (Jsonm.encode enc (`Lexeme `Ae))
-
in
+
Jsont.Object.map ~kind ~doc make_from_json
+
|> Jsont.Object.mem "version" Jsont.string ~enc:version
+
|> Jsont.Object.mem "title" Jsont.string ~enc:title
+
|> Jsont.Object.opt_mem "home_page_url" Jsont.string ~enc:home_page_url
+
|> Jsont.Object.opt_mem "feed_url" Jsont.string ~enc:feed_url
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:description
+
|> Jsont.Object.opt_mem "user_comment" Jsont.string ~enc:user_comment
+
|> Jsont.Object.opt_mem "next_url" Jsont.string ~enc:next_url
+
|> Jsont.Object.opt_mem "icon" Jsont.string ~enc:icon
+
|> Jsont.Object.opt_mem "favicon" Jsont.string ~enc:favicon
+
|> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:authors
+
|> Jsont.Object.opt_mem "language" Jsont.string ~enc:language
+
|> Jsont.Object.opt_mem "expired" Jsont.bool ~enc:expired
+
|> Jsont.Object.opt_mem "hubs" (Jsont.list Hub.jsont) ~enc:hubs
+
|> Jsont.Object.mem "items" (Jsont.list Item.jsont) ~enc:items
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
+
|> Jsont.Object.finish
-
let enc_author author =
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
(match Author.name author with
-
| Some name -> enc_field "name" (fun () -> enc_string name)
-
| None -> ());
-
(match Author.url author with
-
| Some url -> enc_field "url" (fun () -> enc_string url)
-
| None -> ());
-
(match Author.avatar author with
-
| Some avatar -> enc_field "avatar" (fun () -> enc_string avatar)
-
| None -> ());
-
ignore (Jsonm.encode enc (`Lexeme `Oe))
-
in
+
(* Encoding and Decoding *)
-
let enc_attachment att =
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
enc_field "url" (fun () -> enc_string (Attachment.url att));
-
enc_field "mime_type" (fun () -> enc_string (Attachment.mime_type att));
-
enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
-
(Attachment.title att);
-
enc_opt (fun size ->
-
enc_field "size_in_bytes" (fun () ->
-
ignore (Jsonm.encode enc (`Lexeme (`Float (Int64.to_float size))))))
-
(Attachment.size_in_bytes att);
-
enc_opt (fun dur ->
-
enc_field "duration_in_seconds" (fun () ->
-
ignore (Jsonm.encode enc (`Lexeme (`Float (float_of_int dur))))))
-
(Attachment.duration_in_seconds att);
-
ignore (Jsonm.encode enc (`Lexeme `Oe))
-
in
+
let decode ?layout ?locs ?file r =
+
Jsont_bytesrw.decode' ?layout ?locs ?file jsont r
-
let enc_reference ref =
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
enc_field "url" (fun () -> enc_string (Reference.url ref));
-
enc_opt (fun doi -> enc_field "doi" (fun () -> enc_string doi))
-
(Reference.doi ref);
-
enc_opt (fun cito_list ->
-
enc_field "cito" (fun () ->
-
enc_list (fun cito -> enc_string (Cito.to_string cito)) cito_list))
-
(Reference.cito ref);
-
ignore (Jsonm.encode enc (`Lexeme `Oe))
-
in
+
let decode_string ?layout ?locs ?file s =
+
Jsont_bytesrw.decode_string' ?layout ?locs ?file jsont s
-
let enc_hub hub =
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
enc_field "type" (fun () -> enc_string (Hub.type_ hub));
-
enc_field "url" (fun () -> enc_string (Hub.url hub));
-
ignore (Jsonm.encode enc (`Lexeme `Oe))
-
in
-
-
let enc_item item =
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
enc_field "id" (fun () -> enc_string (Item.id item));
-
-
(* Encode content *)
-
(match Item.content item with
-
| `Html html ->
-
enc_field "content_html" (fun () -> enc_string html)
-
| `Text text ->
-
enc_field "content_text" (fun () -> enc_string text)
-
| `Both (html, text) ->
-
enc_field "content_html" (fun () -> enc_string html);
-
enc_field "content_text" (fun () -> enc_string text));
-
-
enc_opt (fun url -> enc_field "url" (fun () -> enc_string url))
-
(Item.url item);
-
enc_opt (fun url -> enc_field "external_url" (fun () -> enc_string url))
-
(Item.external_url item);
-
enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
-
(Item.title item);
-
enc_opt (fun summary -> enc_field "summary" (fun () -> enc_string summary))
-
(Item.summary item);
-
enc_opt (fun img -> enc_field "image" (fun () -> enc_string img))
-
(Item.image item);
-
enc_opt (fun img -> enc_field "banner_image" (fun () -> enc_string img))
-
(Item.banner_image item);
-
enc_opt (fun date -> enc_field "date_published" (fun () -> enc_string (format_rfc3339 date)))
-
(Item.date_published item);
-
enc_opt (fun date -> enc_field "date_modified" (fun () -> enc_string (format_rfc3339 date)))
-
(Item.date_modified item);
-
enc_opt (fun authors ->
-
enc_field "authors" (fun () -> enc_list enc_author authors))
-
(Item.authors item);
-
enc_opt (fun tags ->
-
enc_field "tags" (fun () -> enc_list enc_string tags))
-
(Item.tags item);
-
enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
-
(Item.language item);
-
enc_opt (fun atts ->
-
enc_field "attachments" (fun () -> enc_list enc_attachment atts))
-
(Item.attachments item);
-
enc_opt (fun refs ->
-
enc_field "_references" (fun () -> enc_list enc_reference refs))
-
(Item.references item);
-
-
ignore (Jsonm.encode enc (`Lexeme `Oe))
-
in
+
let encode ?format ?number_format feed ~eod w =
+
Jsont_bytesrw.encode' ?format ?number_format jsont feed ~eod w
-
(* Encode the feed *)
-
ignore (Jsonm.encode enc (`Lexeme `Os));
-
enc_field "version" (fun () -> enc_string feed.version);
-
enc_field "title" (fun () -> enc_string feed.title);
-
enc_opt (fun url -> enc_field "home_page_url" (fun () -> enc_string url))
-
feed.home_page_url;
-
enc_opt (fun url -> enc_field "feed_url" (fun () -> enc_string url))
-
feed.feed_url;
-
enc_opt (fun desc -> enc_field "description" (fun () -> enc_string desc))
-
feed.description;
-
enc_opt (fun comment -> enc_field "user_comment" (fun () -> enc_string comment))
-
feed.user_comment;
-
enc_opt (fun url -> enc_field "next_url" (fun () -> enc_string url))
-
feed.next_url;
-
enc_opt (fun icon -> enc_field "icon" (fun () -> enc_string icon))
-
feed.icon;
-
enc_opt (fun favicon -> enc_field "favicon" (fun () -> enc_string favicon))
-
feed.favicon;
-
enc_opt (fun authors ->
-
enc_field "authors" (fun () -> enc_list enc_author authors))
-
feed.authors;
-
enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
-
feed.language;
-
enc_opt (fun expired -> enc_field "expired" (fun () -> enc_bool expired))
-
feed.expired;
-
enc_opt (fun hubs ->
-
enc_field "hubs" (fun () -> enc_list enc_hub hubs))
-
feed.hubs;
-
enc_field "items" (fun () -> enc_list enc_item feed.items);
-
ignore (Jsonm.encode enc (`Lexeme `Oe));
-
ignore (Jsonm.encode enc `End)
+
let encode_string ?format ?number_format feed =
+
Jsont_bytesrw.encode_string' ?format ?number_format jsont feed
let of_string s =
-
let dec = Jsonm.decoder (`String s) in
-
of_jsonm dec
+
decode_string s
let to_string ?(minify=false) feed =
-
let buf = Buffer.create 1024 in
-
let enc = Jsonm.encoder ~minify (`Buffer buf) in
-
to_jsonm enc feed;
-
Buffer.contents buf
+
let format = if minify then Jsont.Minify else Jsont.Indent in
+
encode_string ~format feed
(* Validation *)
···
| None -> ())
) feed.items;
-
if !errors = [] then Ok ()
-
else Error (List.rev !errors)
-
-
(* Comparison *)
-
-
let equal a b =
-
a.version = b.version &&
-
a.title = b.title &&
-
a.home_page_url = b.home_page_url &&
-
a.feed_url = b.feed_url &&
-
a.description = b.description &&
-
a.user_comment = b.user_comment &&
-
a.next_url = b.next_url &&
-
a.icon = b.icon &&
-
a.favicon = b.favicon &&
-
a.language = b.language &&
-
a.expired = b.expired &&
-
(* Note: We're doing structural equality on items *)
-
List.length a.items = List.length b.items
-
-
(* Pretty printing *)
-
-
let pp_summary ppf feed =
-
Format.fprintf ppf "%s (%d items)" feed.title (List.length feed.items)
-
-
let pp ppf feed =
-
Format.fprintf ppf "Feed: %s" feed.title;
-
(match feed.home_page_url with
-
| Some url -> Format.fprintf ppf " (%s)" url
-
| None -> ());
-
Format.fprintf ppf "@\n";
-
-
Format.fprintf ppf " Items: %d@\n" (List.length feed.items);
-
-
(match feed.authors with
-
| Some authors when authors <> [] ->
-
Format.fprintf ppf " Authors: ";
-
List.iteri (fun i author ->
-
if i > 0 then Format.fprintf ppf ", ";
-
Format.fprintf ppf "%a" Author.pp author
-
) authors;
-
Format.fprintf ppf "@\n"
-
| _ -> ());
-
-
(match feed.language with
-
| Some lang -> Format.fprintf ppf " Language: %s@\n" lang
-
| None -> ())
+
match !errors with
+
| [] -> Ok ()
+
| errs -> Error (List.rev errs)
+81 -292
lib/jsonfeed.mli
···
-
(** JSON Feed format parser and serializer.
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
-
This library implements the JSON Feed specification version 1.1, providing
-
type-safe parsing and serialization of JSON Feed documents. JSON Feed is a
-
syndication format similar to RSS and Atom, but using JSON instead of XML.
-
-
{b Quick Start:}
-
{[
-
(* Create a simple feed *)
-
let feed = Jsonfeed.create
-
~title:"My Blog"
-
~home_page_url:"https://example.com"
-
~feed_url:"https://example.com/feed.json"
-
~items:[
-
Item.create
-
~id:"https://example.com/post/1"
-
~content:(Item.Html "<p>Hello, world!</p>")
-
~title:"First Post"
-
()
-
]
-
()
-
-
(* Serialize to string *)
-
let json = Jsonfeed.to_string feed
-
-
(* Parse from string *)
-
match Jsonfeed.of_string json with
-
| Ok feed -> Printf.printf "Feed: %s\n" (Jsonfeed.title feed)
-
| Error err -> Printf.eprintf "Error: %s\n" err
-
]}
+
(** JSON Feed format parser and serializer using Jsont and Bytesrw.
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
···
(** The type representing a complete JSON Feed. *)
type t
-
(** Exception raised when attempting to parse an invalid feed. *)
-
exception Invalid_feed of string
-
(** {1 Construction} *)
+
(** {1 Unknown Fields} *)
-
(** [create ~title ?home_page_url ?feed_url ?description ?user_comment ?next_url
-
?icon ?favicon ?authors ?language ?expired ?hubs ~items ()]
-
creates a JSON Feed.
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
-
@param title The name of the feed (required)
-
@param home_page_url The URL of the resource the feed describes
-
@param feed_url The URL of the feed itself (serves as unique identifier)
-
@param description Additional information about the feed
-
@param user_comment A description of the feed's purpose for humans reading the raw JSON
-
@param next_url URL of the next page of items (for pagination)
-
@param icon The feed's icon URL (should be square, 512x512 or larger)
-
@param favicon The feed's favicon URL (should be square, 64x64 or larger)
-
@param authors The feed's default authors (inherited by items without authors)
-
@param language The primary language of the feed (RFC 5646 format, e.g. ["en-US"])
-
@param expired Whether the feed will update again ([true] means no more updates)
-
@param hubs Endpoints for real-time notifications
-
@param items The list of feed items (required)
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
+
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
+
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for JSON feeds.
+
+
Maps the complete JSON Feed 1.1 specification including all required
+
and optional fields. *)
-
{b Examples:}
-
{[
-
(* Minimal feed *)
-
let feed = Jsonfeed.create
-
~title:"My Blog"
-
~items:[] ()
-
(* Full-featured blog feed *)
-
let feed = Jsonfeed.create
-
~title:"Example Blog"
-
~home_page_url:"https://example.com"
-
~feed_url:"https://example.com/feed.json"
-
~description:"A blog about OCaml and functional programming"
-
~icon:"https://example.com/icon.png"
-
~authors:[
-
Author.create
-
~name:"Jane Doe"
-
~url:"https://example.com/about"
-
()
-
]
-
~language:"en-US"
-
~items:[
-
Item.create
-
~id:"https://example.com/posts/1"
-
~content:(Item.Html "<p>First post</p>")
-
~title:"Hello World"
-
();
-
Item.create
-
~id:"https://example.com/posts/2"
-
~content:(Item.Html "<p>Second post</p>")
-
~title:"Another Post"
-
()
-
]
-
()
+
(** {1 Construction} *)
-
(* Podcast feed with hubs *)
-
let hub = Hub.create
-
~type_:"WebSub"
-
~url:"https://pubsubhubbub.appspot.com/"
-
() in
-
let feed = Jsonfeed.create
-
~title:"My Podcast"
-
~home_page_url:"https://podcast.example.com"
-
~feed_url:"https://podcast.example.com/feed.json"
-
~hubs:[hub]
-
~items:[
-
Item.create
-
~id:"https://podcast.example.com/episodes/1"
-
~content:(Item.Html "<p>Episode description</p>")
-
~title:"Episode 1"
-
~attachments:[
-
Attachment.create
-
~url:"https://podcast.example.com/ep1.mp3"
-
~mime_type:"audio/mpeg"
-
~duration_in_seconds:1800
-
()
-
]
-
()
-
]
-
()
-
]} *)
val create :
title:string ->
?home_page_url:string ->
···
unit ->
t
+
val make :
+
title:string ->
+
?home_page_url:string ->
+
?feed_url:string ->
+
?description:string ->
+
?user_comment:string ->
+
?next_url:string ->
+
?icon:string ->
+
?favicon:string ->
+
?authors:Author.t list ->
+
?language:string ->
+
?expired:bool ->
+
?hubs:Hub.t list ->
+
items:Item.t list ->
+
?unknown:Unknown.t ->
+
unit ->
+
t
-
(** {1 Accessors} *)
-
(** [version t] returns the JSON Feed version URL.
+
(** {1 Accessors} *)
-
This is always ["https://jsonfeed.org/version/1.1"] for feeds created
-
by this library, but may differ when parsing external feeds. *)
val version : t -> string
-
-
(** [title t] returns the feed's title. *)
val title : t -> string
-
-
(** [home_page_url t] returns the feed's home page URL, if set. *)
val home_page_url : t -> string option
-
-
(** [feed_url t] returns the feed's URL, if set. *)
val feed_url : t -> string option
-
-
(** [description t] returns the feed's description, if set. *)
val description : t -> string option
-
-
(** [user_comment t] returns the feed's user comment, if set. *)
val user_comment : t -> string option
-
-
(** [next_url t] returns the URL for the next page of items, if set. *)
val next_url : t -> string option
-
-
(** [icon t] returns the feed's icon URL, if set. *)
val icon : t -> string option
-
-
(** [favicon t] returns the feed's favicon URL, if set. *)
val favicon : t -> string option
-
-
(** [authors t] returns the feed's default authors, if set. *)
val authors : t -> Author.t list option
-
-
(** [language t] returns the feed's primary language, if set. *)
val language : t -> string option
-
-
(** [expired t] returns whether the feed will update again. *)
val expired : t -> bool option
-
-
(** [hubs t] returns the feed's hub endpoints, if set. *)
val hubs : t -> Hub.t list option
-
-
(** [items t] returns the feed's items. *)
val items : t -> Item.t list
+
val unknown : t -> Unknown.t
-
(** {1 Parsing and Serialization} *)
+
(** {1 Encoding and Decoding with Bytesrw} *)
-
(** Error type for parsing operations. *)
-
type error = string
-
-
(** [of_jsonm decoder] parses a JSON Feed from a Jsonm decoder.
+
val decode :
+
?layout:bool -> ?locs:bool -> ?file:string ->
+
Bytesrw.Bytes.Reader.t -> (t, Jsont.Error.t) result
+
(** [decode r] decodes a JSON Feed from bytesrw reader [r].
-
This is the lowest-level parsing function, suitable for integration
-
with streaming JSON processing pipelines.
+
@param layout Preserve whitespace for round-tripping (default: false)
+
@param locs Track locations for better error messages (default: false)
+
@param file Source file name for error reporting *)
-
@param decoder A Jsonm decoder positioned at the start of a JSON Feed document
-
@return [Ok feed] on success, [Error err] on parse error
+
val decode_string :
+
?layout:bool -> ?locs:bool -> ?file:string ->
+
string -> (t, Jsont.Error.t) result
+
(** [decode_string s] decodes a JSON Feed from string [s]. *)
-
{b Example:}
-
{[
-
let decoder = Jsonm.decoder (`String json_string) in
-
match Jsonfeed.of_jsonm decoder with
-
| Ok feed -> (* process feed *)
-
| Error err -> (* handle error *)
-
]} *)
-
val of_jsonm : Jsonm.decoder -> (t, error) result
-
-
(** [to_jsonm encoder feed] serializes a JSON Feed to a Jsonm encoder.
-
-
This is the lowest-level serialization function, suitable for integration
-
with streaming JSON generation pipelines.
-
-
@param encoder A Jsonm encoder
-
@param feed The feed to serialize
-
-
{b Example:}
-
{[
-
let buffer = Buffer.create 1024 in
-
let encoder = Jsonm.encoder (`Buffer buffer) in
-
Jsonfeed.to_jsonm encoder feed;
-
let json = Buffer.contents buffer
-
]} *)
-
val to_jsonm : Jsonm.encoder -> t -> unit
-
-
(** [of_string s] parses a JSON Feed from a string.
-
-
@param s A JSON string containing a JSON Feed document
-
@return [Ok feed] on success, [Error err] on parse error
-
-
{b Example:}
-
{[
-
let json = {|{
-
"version": "https://jsonfeed.org/version/1.1",
-
"title": "My Feed",
-
"items": []
-
}|} in
-
match Jsonfeed.of_string json with
-
| Ok feed -> Printf.printf "Parsed: %s\n" (Jsonfeed.title feed)
-
| Error err -> Printf.eprintf "Error: %s\n" err
-
]} *)
-
val of_string : string -> (t, error) result
-
-
(** [to_string ?minify feed] serializes a JSON Feed to a string.
-
-
@param minify If [true], produces compact JSON without whitespace.
-
If [false] (default), produces indented, human-readable JSON.
-
@param feed The feed to serialize
-
@return A JSON string
-
-
{b Example:}
-
{[
-
let json = Jsonfeed.to_string feed
-
let compact = Jsonfeed.to_string ~minify:true feed
-
]} *)
-
val to_string : ?minify:bool -> t -> string
-
-
-
(** {1 Date Utilities} *)
-
-
(** [parse_rfc3339 s] parses an RFC 3339 date/time string.
-
-
This function parses timestamps in the format required by JSON Feed,
-
such as ["2024-11-03T10:30:00Z"] or ["2024-11-03T10:30:00-08:00"].
-
-
@param s An RFC 3339 formatted date/time string
-
@return [Some time] on success, [None] if the string is invalid
-
-
{b Examples:}
-
{[
-
parse_rfc3339 "2024-11-03T10:30:00Z"
-
(* returns Some time *)
+
val encode :
+
?format:Jsont.format -> ?number_format:Jsont.number_format ->
+
t -> eod:bool -> Bytesrw.Bytes.Writer.t -> (unit, Jsont.Error.t) result
+
(** [encode feed w] encodes [feed] to bytesrw writer [w].
-
parse_rfc3339 "2024-11-03T10:30:00-08:00"
-
(* returns Some time *)
+
@param format Output formatting: [Jsont.Minify] or [Jsont.Indent] (default: Minify)
+
@param number_format Printf format for numbers (default: "%.16g")
+
@param eod Write end-of-data marker *)
-
parse_rfc3339 "invalid"
-
(* returns None *)
-
]} *)
-
val parse_rfc3339 : string -> Ptime.t option
+
val encode_string :
+
?format:Jsont.format -> ?number_format:Jsont.number_format ->
+
t -> (string, Jsont.Error.t) result
+
(** [encode_string feed] encodes [feed] to a string. *)
-
(** [format_rfc3339 time] formats a timestamp as an RFC 3339 string.
-
The output uses UTC timezone (Z suffix) and includes fractional seconds
-
if the timestamp has sub-second precision.
+
(** {1 Convenience Functions} *)
-
@param time A Ptime timestamp
-
@return An RFC 3339 formatted string
+
val of_string : string -> (t, Jsont.Error.t) result
+
(** Alias for [decode_string] with default options. *)
-
{b Example:}
-
{[
-
let now = Ptime_clock.now () in
-
let s = format_rfc3339 now
-
(* returns "2024-11-03T10:30:45.123Z" or similar *)
-
]} *)
-
val format_rfc3339 : Ptime.t -> string
+
val to_string : ?minify:bool -> t -> (string, Jsont.Error.t) result
+
(** [to_string feed] encodes [feed] to string.
+
@param minify Use compact format (true) or indented (false, default) *)
(** {1 Validation} *)
-
(** [validate feed] validates a JSON Feed.
-
-
Checks that:
-
- All required fields are present
-
- All items have unique IDs
-
- All items have valid content
-
- All URLs are well-formed (if possible)
-
- Authors have at least one field set
-
-
@param feed The feed to validate
-
@return [Ok ()] if valid, [Error errors] with a list of validation issues
-
-
{b Example:}
-
{[
-
match Jsonfeed.validate feed with
-
| Ok () -> (* feed is valid *)
-
| Error errors ->
-
List.iter (Printf.eprintf "Validation error: %s\n") errors
-
]} *)
val validate : t -> (unit, string list) result
+
(** [validate feed] validates the feed structure.
+
Checks for unique item IDs, valid content, etc. *)
(** {1 Comparison} *)
-
(** [equal a b] tests equality between two feeds.
-
-
Feeds are compared structurally, including all fields and items. *)
val equal : t -> t -> bool
+
(** [equal a b] tests equality between two feeds. *)
(** {1 Pretty Printing} *)
-
(** [pp ppf feed] pretty prints a feed to the formatter.
-
-
The output is human-readable and suitable for debugging. It shows
-
the feed's metadata and a summary of items.
-
-
{b Example output:}
-
{v
-
Feed: My Blog (https://example.com)
-
Items: 2
-
Authors: Jane Doe
-
Language: en-US
-
v} *)
val pp : Format.formatter -> t -> unit
-
-
(** [pp_summary ppf feed] prints a brief summary of the feed.
-
-
Shows only the title and item count.
-
-
{b Example output:}
-
{v My Blog (2 items) v} *)
val pp_summary : Format.formatter -> t -> unit
-
(** {1 Feed Content} *)
+
(** {1 Submodules} *)
-
(** Author information for feeds and items. *)
+
module Rfc3339 = Rfc3339
+
module Cito = Cito
module Author = Author
-
-
(** Attachments for feed items (audio, video, downloads). *)
module Attachment = Attachment
-
-
(** Hub endpoints for real-time notifications. *)
module Hub = Hub
-
-
(** Feed items (posts, episodes, entries). *)
+
module Reference = Reference
module Item = Item
-
-
(** References to cited sources in items (extension). *)
-
module Reference = Reference
-
-
(** Citation Typing Ontology annotations for references (extension). *)
-
module Cito = Cito
+47 -1
lib/reference.ml
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
module Unknown = struct
+
type t = (string * Jsont.json) list
+
+
let empty = []
+
let is_empty = function [] -> true | _ -> false
+
end
+
type t = {
url : string;
doi : string option;
cito : Cito.t list option;
+
unknown : Unknown.t;
}
-
let create ~url ?doi ?cito () = { url; doi; cito }
+
let make ~url ?doi ?cito ?(unknown = Unknown.empty) () =
+
{ url; doi; cito; unknown }
+
+
let create ~url ?doi ?cito () =
+
make ~url ?doi ?cito ()
let url t = t.url
let doi t = t.doi
let cito t = t.cito
+
let unknown t = t.unknown
let equal a b = String.equal a.url b.url
···
match t.doi with
| Some d -> fprintf ppf " [DOI: %s]" d
| None -> ()
+
+
let jsont =
+
let kind = "Reference" in
+
let doc = "A reference to a cited source" in
+
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
+
let open Jsont.Object.Mems in
+
let dec_empty () = [] in
+
let dec_add _meta (name : string) value acc =
+
((name, Jsont.Meta.none), value) :: acc
+
in
+
let dec_finish _meta mems =
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
+
let enc = {
+
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
+
List.fold_left (fun acc (name, value) ->
+
+
f Jsont.Meta.none name value acc
+
) acc unknown
+
} in
+
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
+
in
+
let make_obj url doi cito unknown = make ~url ?doi ?cito ~unknown () in
+
Jsont.Object.map ~kind ~doc make_obj
+
|> Jsont.Object.mem "url" Jsont.string ~enc:url
+
|> Jsont.Object.opt_mem "doi" Jsont.string ~enc:doi
+
|> Jsont.Object.opt_mem "cito" (Jsont.list Cito.jsont) ~enc:cito
+
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
+
|> Jsont.Object.finish
+46 -12
lib/reference.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
(** References extension for JSON Feed items.
This implements the references extension that allows items to cite sources.
···
type t
+
(** {1 Unknown Fields} *)
+
+
module Unknown : sig
+
type t = (string * Jsont.json) list
+
(** Unknown/unrecognized JSON object members.
+
Useful for preserving fields from custom extensions or future spec versions. *)
+
+
val empty : t
+
(** [empty] is the empty list of unknown fields. *)
+
+
val is_empty : t -> bool
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
+
end
+
+
+
(** {1 Jsont Type} *)
+
+
val jsont : t Jsont.t
+
(** Declarative JSON type for references.
+
+
Maps JSON objects with "url" (required) and optional "doi" and "cito" fields. *)
+
+
(** {1 Construction} *)
+
val create :
+
url:string ->
+
?doi:string ->
+
?cito:Cito.t list ->
+
unit ->
+
t
(** [create ~url ?doi ?cito ()] creates a reference.
@param url Unique URL for the reference (required).
···
~doi:"10.5281/zenodo.16755947"
~cito:[`CitesAsRecommendedReading; `UsesMethodIn]
()
-
-
(* Reference with custom CiTO term *)
-
let ref4 = Reference.create
-
~url:"https://example.com/paper"
-
~cito:[`Other "customIntent"]
-
()
]} *)
-
val create :
+
+
val make :
url:string ->
?doi:string ->
?cito:Cito.t list ->
+
?unknown:Unknown.t ->
unit ->
t
+
(** [make] is like {!create} but allows setting unknown fields. *)
(** {1 Accessors} *)
-
(** [url t] returns the reference's URL. *)
val url : t -> string
+
(** [url t] returns the reference's URL. *)
+
val doi : t -> string option
(** [doi t] returns the reference's DOI, if set. *)
-
val doi : t -> string option
+
val cito : t -> Cito.t list option
(** [cito t] returns the reference's CiTO annotations, if set. *)
-
val cito : t -> Cito.t list option
+
+
val unknown : t -> Unknown.t
+
(** [unknown t] returns unrecognized fields from the JSON. *)
(** {1 Comparison} *)
+
val equal : t -> t -> bool
(** [equal a b] tests equality between two references.
References are considered equal if they have the same URL. *)
-
val equal : t -> t -> bool
(** {1 Pretty Printing} *)
+
val pp : Format.formatter -> t -> unit
(** [pp ppf t] pretty prints a reference to the formatter.
{b Example output:}
{v https://doi.org/10.5281/zenodo.16755947 [DOI: 10.5281/zenodo.16755947] v} *)
-
val pp : Format.formatter -> t -> unit
+25
lib/rfc3339.ml
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
let parse s =
+
match Ptime.of_rfc3339 s with
+
| Ok (t, _, _) -> Some t
+
| Error _ -> None
+
+
let format t =
+
Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t
+
+
let pp ppf t =
+
Format.pp_print_string ppf (format t)
+
+
let jsont =
+
let kind = "RFC 3339 timestamp" in
+
let doc = "An RFC 3339 date-time string" in
+
let dec s = match parse s with
+
| Some t -> t
+
| None -> Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S" kind s
+
in
+
let enc = format in
+
Jsont.map ~kind ~doc ~dec ~enc Jsont.string
+45
lib/rfc3339.mli
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 Anil Madhavapeddy. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
(** RFC 3339 date/time handling for JSON Feed.
+
+
Provides parsing, formatting, and jsont combinators for RFC 3339 timestamps
+
as required by the JSON Feed specification.
+
+
@see <https://www.rfc-editor.org/rfc/rfc3339> RFC 3339 *)
+
+
+
val jsont : Ptime.t Jsont.t
+
(** [jsont] is a bidirectional JSON type for RFC 3339 timestamps.
+
+
On decode: accepts JSON strings in RFC 3339 format (e.g., "2024-11-03T10:30:00Z")
+
On encode: produces UTC timestamps with 'Z' suffix
+
+
{b Example:}
+
{[
+
let time = Ptime.of_float_s (Unix.time ()) |> Option.get in
+
Jsont_bytesrw.encode_string Rfc3339.jsont time
+
]} *)
+
+
val parse : string -> Ptime.t option
+
(** [parse s] parses an RFC 3339 timestamp string.
+
+
Accepts various formats:
+
- "2024-11-03T10:30:00Z" (UTC)
+
- "2024-11-03T10:30:00-08:00" (with timezone offset)
+
- "2024-11-03T10:30:00.123Z" (with fractional seconds)
+
+
Returns [None] if the string is not valid RFC 3339. *)
+
+
val format : Ptime.t -> string
+
(** [format t] formats a timestamp as RFC 3339.
+
+
Always uses UTC timezone (Z suffix) and includes fractional seconds
+
if the timestamp has sub-second precision.
+
+
{b Example output:} ["2024-11-03T10:30:45.123Z"] *)
+
+
val pp : Format.formatter -> Ptime.t -> unit
+
(** [pp ppf t] pretty prints a timestamp in RFC 3339 format. *)
+25 -18
test/test_jsonfeed.ml
···
let test_feed_to_string () =
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in
-
let json = Jsonfeed.to_string feed in
-
Alcotest.(check bool) "contains version" true (contains_substring json "version");
-
Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed")
+
match Jsonfeed.to_string feed with
+
| Ok json ->
+
Alcotest.(check bool) "contains version" true (contains_substring json "version");
+
Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed")
+
| Error e ->
+
Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
let test_feed_parse_minimal () =
let json = {|{
···
Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed);
Alcotest.(check int) "items" 0 (List.length (Jsonfeed.items feed))
| Error err ->
-
Alcotest.fail (Printf.sprintf "Parse failed: %s" err)
+
Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
let test_feed_parse_with_item () =
let json = {|{
···
Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item)
| _ -> Alcotest.fail "Expected 1 item")
| Error err ->
-
Alcotest.fail (Printf.sprintf "Parse failed: %s" err)
+
Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
let test_feed_roundtrip () =
let author = Author.create ~name:"Test Author" () in
···
~id:"https://example.com/1"
~title:"Test Item"
~content:(`Html "<p>Hello, world!</p>")
-
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
+
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
~tags:["test"; "example"]
() in
···
() in
(* Serialize and parse *)
-
let json = Jsonfeed.to_string feed1 in
-
match Jsonfeed.of_string json with
-
| Ok feed2 ->
-
Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2);
-
Alcotest.(check (option string)) "home_page_url"
-
(Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2);
-
Alcotest.(check int) "items count"
-
(List.length (Jsonfeed.items feed1))
-
(List.length (Jsonfeed.items feed2))
-
| Error err ->
-
Alcotest.fail (Printf.sprintf "Round-trip failed: %s" err)
+
match Jsonfeed.to_string feed1 with
+
| Error e ->
+
Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
+
| Ok json ->
+
match Jsonfeed.of_string json with
+
| Ok feed2 ->
+
Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2);
+
Alcotest.(check (option string)) "home_page_url"
+
(Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2);
+
Alcotest.(check int) "items count"
+
(List.length (Jsonfeed.items feed1))
+
(List.length (Jsonfeed.items feed2))
+
| Error err ->
+
Alcotest.fail (Printf.sprintf "Round-trip parse failed: %s" (Jsont.Error.to_string err))
let test_feed_parse_invalid_missing_content () =
let json = {|{
···
match Jsonfeed.of_string json with
| Ok _ -> Alcotest.fail "Should reject item without content"
| Error err ->
+
let err_str = Jsont.Error.to_string err in
Alcotest.(check bool) "has error" true
-
(contains_substring err "content")
+
(contains_substring err_str "content")
let jsonfeed_tests = [
"create minimal feed", `Quick, test_feed_create_minimal;
+4 -1
test/test_serialization.ml
···
() in
(* Serialize to JSON *)
-
let json = Jsonfeed.to_string feed in
+
let json = match Jsonfeed.to_string feed with
+
| Ok s -> s
+
| Error e -> failwith (Jsont.Error.to_string e)
+
in
(* Print it *)
Printf.printf "Generated JSON Feed:\n%s\n\n" json;