anil.recoil.org
OCaml library for JSONfeed parsing and creation
initial import
+1
.gitignore
+1
.gitignore
···
1
+
_build
+44
.tangled/workflows/build.yml
+44
.tangled/workflows/build.yml
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
dependencies:
6
+
nixpkgs:
7
+
- shell
8
+
- stdenv
9
+
- findutils
10
+
- binutils
11
+
- libunwind
12
+
- ncurses
13
+
- opam
14
+
- git
15
+
- gawk
16
+
- gnupatch
17
+
- gnum4
18
+
- gnumake
19
+
- gnutar
20
+
- gnused
21
+
- gnugrep
22
+
- diffutils
23
+
- gzip
24
+
- bzip2
25
+
- gcc
26
+
- ocaml
27
+
28
+
steps:
29
+
- name: opam
30
+
command: |
31
+
opam init --disable-sandboxing -any
32
+
- name: switch
33
+
command: |
34
+
opam install . --confirm-level=unsafe-yes --deps-only
35
+
- name: build
36
+
command: |
37
+
opam exec -- dune build --verbose
38
+
- name: test
39
+
command: |
40
+
opam exec -- dune runtest --verbose
41
+
- name: doc
42
+
command: |
43
+
opam install -y odoc
44
+
opam exec -- dune build @doc
+28
dune-project
+28
dune-project
···
1
+
(lang dune 3.20)
2
+
3
+
(name jsonfeed)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy")
9
+
(homepage "https://tangled.sh/@anil.recoil.org/ocaml-jsonfeed")
10
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
+
(bug_reports "https://tangled.sh/@anil.recoil.org/ocaml-jsonfeed")
12
+
(maintenance_intent "(latest)")
13
+
14
+
(package
15
+
(name jsonfeed)
16
+
(synopsis "JSON Feed format parser and serializer for OCaml")
17
+
(description
18
+
"This library implements the JSON Feed specification (version 1.1) \
19
+
for OCaml. JSON Feed is a syndication format similar to RSS and Atom, \
20
+
but using JSON instead of XML. The library provides type-safe parsing \
21
+
and serialization using Jsonm and Ptime.")
22
+
(depends
23
+
(ocaml (>= 5.2.0))
24
+
(jsonm (>= 1.0.0))
25
+
(ptime (>= 1.2.0))
26
+
(fmt (>= 0.11.0))
27
+
(odoc :with-doc)
28
+
(alcotest (and :with-test (>= 1.9.0)))))
+14
example/dune
+14
example/dune
···
1
+
(executable
2
+
(name feed_example)
3
+
(modules feed_example)
4
+
(libraries jsonfeed eio_main))
5
+
6
+
(executable
7
+
(name feed_parser)
8
+
(modules feed_parser)
9
+
(libraries jsonfeed eio_main))
10
+
11
+
(executable
12
+
(name feed_validator)
13
+
(modules feed_validator)
14
+
(libraries jsonfeed eio_main))
+25
example/example_feed.json
+25
example/example_feed.json
···
1
+
{
2
+
"version": "https://jsonfeed.org/version/1",
3
+
"title": "JSON Feed",
4
+
"icon": "https://cdn.micro.blog/jsonfeed/avatar.jpg",
5
+
"home_page_url": "https://www.jsonfeed.org/",
6
+
"feed_url": "https://www.jsonfeed.org/feed.json",
7
+
"items": [
8
+
{
9
+
"id": "http://jsonfeed.micro.blog/2020/08/07/json-feed-version.html",
10
+
"title": "JSON Feed version 1.1",
11
+
"content_html": "<p>We’ve updated the spec to <a href=\"https://jsonfeed.org/version/1.1\">version 1.1</a>. It’s a minor update to JSON Feed, clarifying a few things in the spec and adding a couple new fields such as <code>authors</code> and <code>language</code>.</p>\n\n<p>For version 1.1, we’re starting to move to the more specific MIME type <code>application/feed+json</code>. Clients that parse HTML to discover feeds should prefer that MIME type, while still falling back to accepting <code>application/json</code> too.</p>\n\n<p>The <a href=\"https://jsonfeed.org/code/\">code page</a> has also been updated with several new code libraries and apps that support JSON Feed.</p>\n",
12
+
13
+
"date_published": "2020-08-07T11:44:36-05:00",
14
+
"url": "https://www.jsonfeed.org/2020/08/07/json-feed-version.html"
15
+
},
16
+
{
17
+
"id": "http://jsonfeed.micro.blog/2017/05/17/announcing-json-feed.html",
18
+
"title": "Announcing JSON Feed",
19
+
"content_html": "\n\n<p>We — Manton Reece and Brent Simmons — have noticed that JSON has become the developers’ choice for APIs, and that developers will often go out of their way to avoid XML. JSON is simpler to read and write, and it’s less prone to bugs.</p>\n\n<p>So we developed JSON Feed, a format similar to <a href=\"http://cyber.harvard.edu/rss/rss.html\">RSS</a> and <a href=\"https://tools.ietf.org/html/rfc4287\">Atom</a> but in JSON. It reflects the lessons learned from our years of work reading and publishing feeds.</p>\n\n<p><a href=\"https://jsonfeed.org/version/1\">See the spec</a>. It’s at version 1, which may be the only version ever needed. If future versions are needed, version 1 feeds will still be valid feeds.</p>\n\n<h4 id=\"notes\">Notes</h4>\n\n<p>We have a <a href=\"https://github.com/manton/jsonfeed-wp\">WordPress plugin</a> and, coming soon, a JSON Feed Parser for Swift. As more code is written, by us and others, we’ll update the <a href=\"https://jsonfeed.org/code\">code</a> page.</p>\n\n<p>See <a href=\"https://jsonfeed.org/mappingrssandatom\">Mapping RSS and Atom to JSON Feed</a> for more on the similarities between the formats.</p>\n\n<p>This website — the Markdown files and supporting resources — <a href=\"https://github.com/brentsimmons/JSONFeed\">is up on GitHub</a>, and you’re welcome to comment there.</p>\n\n<p>This website is also a blog, and you can subscribe to the <a href=\"https://jsonfeed.org/xml/rss.xml\">RSS feed</a> or the <a href=\"https://jsonfeed.org/feed.json\">JSON feed</a> (if your reader supports it).</p>\n\n<p>We worked with a number of people on this over the course of several months. We list them, and thank them, at the bottom of the <a href=\"https://jsonfeed.org/version/1\">spec</a>. But — most importantly — <a href=\"http://furbo.org/\">Craig Hockenberry</a> spent a little time making it look pretty. :)</p>\n",
20
+
21
+
"date_published": "2017-05-17T10:02:12-05:00",
22
+
"url": "https://www.jsonfeed.org/2017/05/17/announcing-json-feed.html"
23
+
}
24
+
]
25
+
}
+162
example/feed_example.ml
+162
example/feed_example.ml
···
1
+
(** Example: Creating and serializing a JSON Feed
2
+
3
+
This demonstrates:
4
+
- Creating authors
5
+
- Creating items with different content types
6
+
- Creating a complete feed
7
+
- Serializing to JSON string and file *)
8
+
9
+
open Jsonfeed
10
+
11
+
(* Helper to write feed to Eio flow *)
12
+
let to_flow flow feed =
13
+
let s = Jsonfeed.to_string feed in
14
+
Eio.Flow.copy_string s flow
15
+
16
+
let create_blog_feed () =
17
+
(* Create some authors *)
18
+
let jane = Author.create
19
+
~name:"Jane Doe"
20
+
~url:"https://example.com/authors/jane"
21
+
~avatar:"https://example.com/avatars/jane.png"
22
+
() in
23
+
24
+
let john = Author.create
25
+
~name:"John Smith"
26
+
~url:"https://example.com/authors/john"
27
+
() in
28
+
29
+
(* Create items with different content types *)
30
+
let item1 = Item.create
31
+
~id:"https://example.com/posts/1"
32
+
~url:"https://example.com/posts/1"
33
+
~title:"Introduction to OCaml"
34
+
~content:(`Both (
35
+
"<p>OCaml is a powerful functional programming language.</p>",
36
+
"OCaml is a powerful functional programming language."
37
+
))
38
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
39
+
~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:30:00Z" |> Option.get)
40
+
~authors:[jane]
41
+
~tags:["ocaml"; "programming"; "functional"]
42
+
~summary:"A beginner's guide to OCaml programming"
43
+
() in
44
+
45
+
let item2 = Item.create
46
+
~id:"https://example.com/posts/2"
47
+
~url:"https://example.com/posts/2"
48
+
~title:"JSON Feed for Syndication"
49
+
~content:(`Html "<p>JSON Feed is a modern alternative to RSS and Atom.</p>")
50
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-02T09:00:00Z" |> Option.get)
51
+
~authors:[jane; john]
52
+
~tags:["json"; "syndication"; "web"]
53
+
~image:"https://example.com/images/jsonfeed.png"
54
+
() in
55
+
56
+
(* Microblog-style item (text only, no title) *)
57
+
let item3 = Item.create
58
+
~id:"https://example.com/micro/42"
59
+
~content:(`Text "Just shipped a new feature! 🚀")
60
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-03T08:15:00Z" |> Option.get)
61
+
~tags:["microblog"]
62
+
() in
63
+
64
+
(* Create the complete feed *)
65
+
let feed = Jsonfeed.create
66
+
~title:"Example Blog"
67
+
~home_page_url:"https://example.com"
68
+
~feed_url:"https://example.com/feed.json"
69
+
~description:"A blog about programming, web development, and technology"
70
+
~icon:"https://example.com/icon-512.png"
71
+
~favicon:"https://example.com/favicon-64.png"
72
+
~authors:[jane; john]
73
+
~language:"en-US"
74
+
~items:[item1; item2; item3]
75
+
() in
76
+
77
+
feed
78
+
79
+
let create_podcast_feed () =
80
+
(* Create podcast author *)
81
+
let host = Author.create
82
+
~name:"Podcast Host"
83
+
~url:"https://podcast.example.com/host"
84
+
~avatar:"https://podcast.example.com/host-avatar.jpg"
85
+
() in
86
+
87
+
(* Create episode with audio attachment *)
88
+
let attachment = Attachment.create
89
+
~url:"https://podcast.example.com/episodes/ep1.mp3"
90
+
~mime_type:"audio/mpeg"
91
+
~title:"Episode 1: Introduction"
92
+
~size_in_bytes:15_728_640L
93
+
~duration_in_seconds:1800
94
+
() in
95
+
96
+
let episode = Item.create
97
+
~id:"https://podcast.example.com/episodes/1"
98
+
~url:"https://podcast.example.com/episodes/1"
99
+
~title:"Episode 1: Introduction"
100
+
~content:(`Html "<p>Welcome to our first episode!</p>")
101
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get)
102
+
~attachments:[attachment]
103
+
~authors:[host]
104
+
~image:"https://podcast.example.com/episodes/ep1-cover.jpg"
105
+
() in
106
+
107
+
(* Create podcast feed with hub for real-time updates *)
108
+
let hub = Hub.create
109
+
~type_:"WebSub"
110
+
~url:"https://pubsubhubbub.appspot.com/"
111
+
() in
112
+
113
+
let feed = Jsonfeed.create
114
+
~title:"Example Podcast"
115
+
~home_page_url:"https://podcast.example.com"
116
+
~feed_url:"https://podcast.example.com/feed.json"
117
+
~description:"A podcast about interesting topics"
118
+
~icon:"https://podcast.example.com/icon.png"
119
+
~authors:[host]
120
+
~language:"en-US"
121
+
~hubs:[hub]
122
+
~items:[episode]
123
+
() in
124
+
125
+
feed
126
+
127
+
let main () =
128
+
Eio_main.run @@ fun env ->
129
+
130
+
(* Create blog feed *)
131
+
let blog_feed = create_blog_feed () in
132
+
Format.printf "Created blog feed: %a\n\n" Jsonfeed.pp blog_feed;
133
+
134
+
(* Serialize to string *)
135
+
let json_string = Jsonfeed.to_string blog_feed in
136
+
Format.printf "JSON (first 200 chars): %s...\n\n"
137
+
(String.sub json_string 0 (min 200 (String.length json_string)));
138
+
139
+
(* Serialize to file *)
140
+
let feed_path = Eio.Path.(env#fs / "blog-feed.json") in
141
+
Eio.Path.with_open_out ~create:(`Or_truncate 0o644) feed_path @@ fun flow ->
142
+
to_flow (flow :> Eio.Flow.sink_ty Eio.Resource.t) blog_feed;
143
+
Format.printf "Wrote blog feed to blog-feed.json\n\n";
144
+
145
+
(* Create podcast feed *)
146
+
let podcast_feed = create_podcast_feed () in
147
+
Format.printf "Created podcast feed: %a\n\n" Jsonfeed.pp_summary podcast_feed;
148
+
149
+
(* Validate feeds *)
150
+
(match Jsonfeed.validate blog_feed with
151
+
| Ok () -> Format.printf "✓ Blog feed is valid\n"
152
+
| Error errors ->
153
+
Format.printf "✗ Blog feed validation errors:\n";
154
+
List.iter (Format.printf " - %s\n") errors);
155
+
156
+
(match Jsonfeed.validate podcast_feed with
157
+
| Ok () -> Format.printf "✓ Podcast feed is valid\n"
158
+
| Error errors ->
159
+
Format.printf "✗ Podcast feed validation errors:\n";
160
+
List.iter (Format.printf " - %s\n") errors)
161
+
162
+
let () = main ()
+193
example/feed_parser.ml
+193
example/feed_parser.ml
···
1
+
(** Example: Parsing and analyzing JSON Feeds
2
+
3
+
This demonstrates:
4
+
- Parsing feeds from files
5
+
- Analyzing feed metadata
6
+
- Iterating over items
7
+
- Working with dates and content *)
8
+
9
+
open Jsonfeed
10
+
11
+
(* Helper to read feed from file *)
12
+
let of_file filename =
13
+
let content = In_channel.with_open_text filename In_channel.input_all in
14
+
Jsonfeed.of_string content
15
+
16
+
let print_feed_info feed =
17
+
Format.printf "Feed Information:\n";
18
+
Format.printf " Title: %s\n" (Jsonfeed.title feed);
19
+
Format.printf " Version: %s\n" (Jsonfeed.version feed);
20
+
21
+
(match Jsonfeed.home_page_url feed with
22
+
| Some url -> Format.printf " Home Page: %s\n" url
23
+
| None -> ());
24
+
25
+
(match Jsonfeed.feed_url feed with
26
+
| Some url -> Format.printf " Feed URL: %s\n" url
27
+
| None -> ());
28
+
29
+
(match Jsonfeed.description feed with
30
+
| Some desc -> Format.printf " Description: %s\n" desc
31
+
| None -> ());
32
+
33
+
(match Jsonfeed.language feed with
34
+
| Some lang -> Format.printf " Language: %s\n" lang
35
+
| None -> ());
36
+
37
+
(match Jsonfeed.authors feed with
38
+
| Some authors ->
39
+
Format.printf " Authors:\n";
40
+
List.iter (fun author ->
41
+
match Author.name author with
42
+
| Some name -> Format.printf " - %s" name;
43
+
(match Author.url author with
44
+
| Some url -> Format.printf " (%s)" url
45
+
| None -> ());
46
+
Format.printf "\n"
47
+
| None -> ()
48
+
) authors
49
+
| None -> ());
50
+
51
+
Format.printf " Items: %d\n\n" (List.length (Jsonfeed.items feed))
52
+
53
+
let print_item_details item =
54
+
Format.printf "Item: %s\n" (Item.id item);
55
+
56
+
(match Item.title item with
57
+
| Some title -> Format.printf " Title: %s\n" title
58
+
| None -> Format.printf " (No title - microblog entry)\n");
59
+
60
+
(match Item.url item with
61
+
| Some url -> Format.printf " URL: %s\n" url
62
+
| None -> ());
63
+
64
+
(* Print content info *)
65
+
(match Item.content item with
66
+
| `Html html ->
67
+
Format.printf " Content: HTML only (%d chars)\n"
68
+
(String.length html)
69
+
| `Text text ->
70
+
Format.printf " Content: Text only (%d chars)\n"
71
+
(String.length text)
72
+
| `Both (html, text) ->
73
+
Format.printf " Content: Both HTML (%d chars) and Text (%d chars)\n"
74
+
(String.length html) (String.length text));
75
+
76
+
(* Print dates *)
77
+
(match Item.date_published item with
78
+
| Some date ->
79
+
Format.printf " Published: %s\n"
80
+
(Jsonfeed.format_rfc3339 date)
81
+
| None -> ());
82
+
83
+
(match Item.date_modified item with
84
+
| Some date ->
85
+
Format.printf " Modified: %s\n"
86
+
(Jsonfeed.format_rfc3339 date)
87
+
| None -> ());
88
+
89
+
(* Print tags *)
90
+
(match Item.tags item with
91
+
| Some tags when tags <> [] ->
92
+
Format.printf " Tags: %s\n" (String.concat ", " tags)
93
+
| _ -> ());
94
+
95
+
(* Print attachments *)
96
+
(match Item.attachments item with
97
+
| Some attachments when attachments <> [] ->
98
+
Format.printf " Attachments:\n";
99
+
List.iter (fun att ->
100
+
Format.printf " - %s (%s)\n"
101
+
(Attachment.url att)
102
+
(Attachment.mime_type att);
103
+
(match Attachment.size_in_bytes att with
104
+
| Some size ->
105
+
let mb = Int64.to_float size /. (1024. *. 1024.) in
106
+
Format.printf " Size: %.2f MB\n" mb
107
+
| None -> ());
108
+
(match Attachment.duration_in_seconds att with
109
+
| Some duration ->
110
+
let mins = duration / 60 in
111
+
let secs = duration mod 60 in
112
+
Format.printf " Duration: %dm%ds\n" mins secs
113
+
| None -> ())
114
+
) attachments
115
+
| _ -> ());
116
+
117
+
Format.printf "\n"
118
+
119
+
let analyze_feed feed =
120
+
let items = Jsonfeed.items feed in
121
+
122
+
Format.printf "\n=== Feed Analysis ===\n\n";
123
+
124
+
(* Count content types *)
125
+
let html_only = ref 0 in
126
+
let text_only = ref 0 in
127
+
let both = ref 0 in
128
+
129
+
List.iter (fun item ->
130
+
match Item.content item with
131
+
| `Html _ -> incr html_only
132
+
| `Text _ -> incr text_only
133
+
| `Both _ -> incr both
134
+
) items;
135
+
136
+
Format.printf "Content Types:\n";
137
+
Format.printf " HTML only: %d\n" !html_only;
138
+
Format.printf " Text only: %d\n" !text_only;
139
+
Format.printf " Both: %d\n\n" !both;
140
+
141
+
(* Find items with attachments *)
142
+
let with_attachments = List.filter (fun item ->
143
+
match Item.attachments item with
144
+
| Some att when att <> [] -> true
145
+
| _ -> false
146
+
) items in
147
+
148
+
Format.printf "Items with attachments: %d\n\n" (List.length with_attachments);
149
+
150
+
(* Collect all unique tags *)
151
+
let all_tags = List.fold_left (fun acc item ->
152
+
match Item.tags item with
153
+
| Some tags -> acc @ tags
154
+
| None -> acc
155
+
) [] items in
156
+
let unique_tags = List.sort_uniq String.compare all_tags in
157
+
158
+
if unique_tags <> [] then (
159
+
Format.printf "All tags used: %s\n\n" (String.concat ", " unique_tags)
160
+
)
161
+
162
+
let main () =
163
+
(* Parse from example_feed.json file *)
164
+
Format.printf "=== Parsing JSON Feed from example_feed.json ===\n\n";
165
+
166
+
(try
167
+
match of_file "example/example_feed.json" with
168
+
| Ok feed ->
169
+
print_feed_info feed;
170
+
171
+
Format.printf "=== Items ===\n\n";
172
+
List.iter print_item_details (Jsonfeed.items feed);
173
+
174
+
analyze_feed feed;
175
+
176
+
(* Demonstrate round-trip parsing *)
177
+
Format.printf "\n=== Round-trip Test ===\n\n";
178
+
let json = Jsonfeed.to_string feed in
179
+
(match Jsonfeed.of_string json with
180
+
| Ok feed2 ->
181
+
if Jsonfeed.equal feed feed2 then
182
+
Format.printf "✓ Round-trip successful: feeds are equal\n"
183
+
else
184
+
Format.printf "✗ Round-trip failed: feeds differ\n"
185
+
| Error (`Msg err) ->
186
+
Format.eprintf "✗ Round-trip failed: %s\n" err)
187
+
| Error (`Msg err) ->
188
+
Format.eprintf "Error parsing feed: %s\n" err
189
+
with
190
+
| Sys_error msg ->
191
+
Format.eprintf "Error reading file: %s\n" msg)
192
+
193
+
let () = main ()
+303
example/feed_validator.ml
+303
example/feed_validator.ml
···
1
+
(** Example: Validating JSON Feeds
2
+
3
+
This demonstrates:
4
+
- Validating feed structure
5
+
- Testing various edge cases
6
+
- Handling invalid feeds
7
+
- Best practices for feed construction *)
8
+
9
+
open Jsonfeed
10
+
11
+
let test_valid_minimal_feed () =
12
+
Format.printf "=== Test: Minimal Valid Feed ===\n";
13
+
14
+
let feed = Jsonfeed.create
15
+
~title:"Minimal Feed"
16
+
~items:[]
17
+
() in
18
+
19
+
match Jsonfeed.validate feed with
20
+
| Ok () -> Format.printf "✓ Minimal feed is valid\n\n"
21
+
| Error errors ->
22
+
Format.printf "✗ Minimal feed validation failed:\n";
23
+
List.iter (Format.printf " - %s\n") errors;
24
+
Format.printf "\n"
25
+
26
+
let test_valid_complete_feed () =
27
+
Format.printf "=== Test: Complete Valid Feed ===\n";
28
+
29
+
let author = Author.create
30
+
~name:"Test Author"
31
+
~url:"https://example.com/author"
32
+
~avatar:"https://example.com/avatar.png"
33
+
() in
34
+
35
+
let attachment = Attachment.create
36
+
~url:"https://example.com/file.mp3"
37
+
~mime_type:"audio/mpeg"
38
+
~title:"Audio File"
39
+
~size_in_bytes:1024L
40
+
~duration_in_seconds:60
41
+
() in
42
+
43
+
let item = Item.create
44
+
~id:"https://example.com/items/1"
45
+
~url:"https://example.com/items/1"
46
+
~title:"Test Item"
47
+
~content:(`Both ("<p>HTML content</p>", "Text content"))
48
+
~summary:"A test item"
49
+
~image:"https://example.com/image.jpg"
50
+
~banner_image:"https://example.com/banner.jpg"
51
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
52
+
~date_modified:(Jsonfeed.parse_rfc3339 "2024-11-01T15:00:00Z" |> Option.get)
53
+
~authors:[author]
54
+
~tags:["test"; "example"]
55
+
~language:"en"
56
+
~attachments:[attachment]
57
+
() in
58
+
59
+
let hub = Hub.create
60
+
~type_:"WebSub"
61
+
~url:"https://pubsubhubbub.appspot.com/"
62
+
() in
63
+
64
+
let feed = Jsonfeed.create
65
+
~title:"Complete Feed"
66
+
~home_page_url:"https://example.com"
67
+
~feed_url:"https://example.com/feed.json"
68
+
~description:"A complete test feed"
69
+
~user_comment:"This is a test feed"
70
+
~icon:"https://example.com/icon.png"
71
+
~favicon:"https://example.com/favicon.ico"
72
+
~authors:[author]
73
+
~language:"en-US"
74
+
~hubs:[hub]
75
+
~items:[item]
76
+
() in
77
+
78
+
match Jsonfeed.validate feed with
79
+
| Ok () -> Format.printf "✓ Complete feed is valid\n\n"
80
+
| Error errors ->
81
+
Format.printf "✗ Complete feed validation failed:\n";
82
+
List.iter (Format.printf " - %s\n") errors;
83
+
Format.printf "\n"
84
+
85
+
let test_feed_with_multiple_items () =
86
+
Format.printf "=== Test: Feed with Multiple Items ===\n";
87
+
88
+
let items = List.init 10 (fun i ->
89
+
Item.create
90
+
~id:(Printf.sprintf "https://example.com/items/%d" i)
91
+
~content:(`Text (Printf.sprintf "Item %d content" i))
92
+
~title:(Printf.sprintf "Item %d" i)
93
+
~date_published:(Jsonfeed.parse_rfc3339
94
+
(Printf.sprintf "2024-11-%02dT10:00:00Z" (i + 1)) |> Option.get)
95
+
()
96
+
) in
97
+
98
+
let feed = Jsonfeed.create
99
+
~title:"Multi-item Feed"
100
+
~items
101
+
() in
102
+
103
+
match Jsonfeed.validate feed with
104
+
| Ok () ->
105
+
Format.printf "✓ Feed with %d items is valid\n\n" (List.length items)
106
+
| Error errors ->
107
+
Format.printf "✗ Multi-item feed validation failed:\n";
108
+
List.iter (Format.printf " - %s\n") errors;
109
+
Format.printf "\n"
110
+
111
+
let test_podcast_feed () =
112
+
Format.printf "=== Test: Podcast Feed ===\n";
113
+
114
+
let host = Author.create
115
+
~name:"Podcast Host"
116
+
~url:"https://podcast.example.com/host"
117
+
() in
118
+
119
+
let episode1 = Attachment.create
120
+
~url:"https://podcast.example.com/ep1.mp3"
121
+
~mime_type:"audio/mpeg"
122
+
~title:"Episode 1"
123
+
~size_in_bytes:20_971_520L (* 20 MB *)
124
+
~duration_in_seconds:1800 (* 30 minutes *)
125
+
() in
126
+
127
+
(* Alternate format of the same episode *)
128
+
let episode1_aac = Attachment.create
129
+
~url:"https://podcast.example.com/ep1.aac"
130
+
~mime_type:"audio/aac"
131
+
~title:"Episode 1"
132
+
~size_in_bytes:16_777_216L
133
+
~duration_in_seconds:1800
134
+
() in
135
+
136
+
let item = Item.create
137
+
~id:"https://podcast.example.com/episodes/1"
138
+
~url:"https://podcast.example.com/episodes/1"
139
+
~title:"Episode 1: Introduction"
140
+
~content:(`Html "<p>Welcome to the first episode!</p>")
141
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:00:00Z" |> Option.get)
142
+
~authors:[host]
143
+
~attachments:[episode1; episode1_aac]
144
+
~image:"https://podcast.example.com/ep1-cover.jpg"
145
+
() in
146
+
147
+
let feed = Jsonfeed.create
148
+
~title:"Example Podcast"
149
+
~home_page_url:"https://podcast.example.com"
150
+
~feed_url:"https://podcast.example.com/feed.json"
151
+
~authors:[host]
152
+
~items:[item]
153
+
() in
154
+
155
+
match Jsonfeed.validate feed with
156
+
| Ok () -> Format.printf "✓ Podcast feed is valid\n\n"
157
+
| Error errors ->
158
+
Format.printf "✗ Podcast feed validation failed:\n";
159
+
List.iter (Format.printf " - %s\n") errors;
160
+
Format.printf "\n"
161
+
162
+
let test_microblog_feed () =
163
+
Format.printf "=== Test: Microblog Feed (no titles) ===\n";
164
+
165
+
let author = Author.create
166
+
~name:"Microblogger"
167
+
~url:"https://micro.example.com"
168
+
() in
169
+
170
+
let items = [
171
+
Item.create
172
+
~id:"https://micro.example.com/1"
173
+
~content:(`Text "Just posted a new photo!")
174
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T08:00:00Z" |> Option.get)
175
+
();
176
+
Item.create
177
+
~id:"https://micro.example.com/2"
178
+
~content:(`Text "Having a great day! ☀️")
179
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T12:30:00Z" |> Option.get)
180
+
();
181
+
Item.create
182
+
~id:"https://micro.example.com/3"
183
+
~content:(`Html "<p>Check out this <a href=\"#\">link</a></p>")
184
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T16:45:00Z" |> Option.get)
185
+
()
186
+
] in
187
+
188
+
let feed = Jsonfeed.create
189
+
~title:"Microblog"
190
+
~home_page_url:"https://micro.example.com"
191
+
~authors:[author]
192
+
~items
193
+
() in
194
+
195
+
match Jsonfeed.validate feed with
196
+
| Ok () ->
197
+
Format.printf "✓ Microblog feed with %d items is valid\n\n"
198
+
(List.length items)
199
+
| Error errors ->
200
+
Format.printf "✗ Microblog feed validation failed:\n";
201
+
List.iter (Format.printf " - %s\n") errors;
202
+
Format.printf "\n"
203
+
204
+
let test_expired_feed () =
205
+
Format.printf "=== Test: Expired Feed ===\n";
206
+
207
+
let feed = Jsonfeed.create
208
+
~title:"Archived Blog"
209
+
~home_page_url:"https://archive.example.com"
210
+
~description:"This blog is no longer updated"
211
+
~expired:true
212
+
~items:[]
213
+
() in
214
+
215
+
match Jsonfeed.validate feed with
216
+
| Ok () -> Format.printf "✓ Expired feed is valid\n\n"
217
+
| Error errors ->
218
+
Format.printf "✗ Expired feed validation failed:\n";
219
+
List.iter (Format.printf " - %s\n") errors;
220
+
Format.printf "\n"
221
+
222
+
let test_paginated_feed () =
223
+
Format.printf "=== Test: Paginated Feed ===\n";
224
+
225
+
let items = List.init 25 (fun i ->
226
+
Item.create
227
+
~id:(Printf.sprintf "https://example.com/items/%d" i)
228
+
~content:(`Text (Printf.sprintf "Item %d" i))
229
+
()
230
+
) in
231
+
232
+
let feed = Jsonfeed.create
233
+
~title:"Large Feed"
234
+
~home_page_url:"https://example.com"
235
+
~feed_url:"https://example.com/feed.json?page=1"
236
+
~next_url:"https://example.com/feed.json?page=2"
237
+
~items
238
+
() in
239
+
240
+
match Jsonfeed.validate feed with
241
+
| Ok () ->
242
+
Format.printf "✓ Paginated feed is valid (page 1 with next_url)\n\n"
243
+
| Error errors ->
244
+
Format.printf "✗ Paginated feed validation failed:\n";
245
+
List.iter (Format.printf " - %s\n") errors;
246
+
Format.printf "\n"
247
+
248
+
let test_invalid_feed_from_json () =
249
+
Format.printf "=== Test: Parsing Invalid JSON ===\n";
250
+
251
+
(* Missing required version field *)
252
+
let invalid_json1 = {|{
253
+
"title": "Test",
254
+
"items": []
255
+
}|} in
256
+
257
+
(match Jsonfeed.of_string invalid_json1 with
258
+
| Ok _ -> Format.printf "✗ Should have failed (missing version)\n"
259
+
| Error (`Msg err) ->
260
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
261
+
262
+
(* Missing required title field *)
263
+
let invalid_json2 = {|{
264
+
"version": "https://jsonfeed.org/version/1.1",
265
+
"items": []
266
+
}|} in
267
+
268
+
(match Jsonfeed.of_string invalid_json2 with
269
+
| Ok _ -> Format.printf "✗ Should have failed (missing title)\n"
270
+
| Error (`Msg err) ->
271
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
272
+
273
+
(* Item without id *)
274
+
let invalid_json3 = {|{
275
+
"version": "https://jsonfeed.org/version/1.1",
276
+
"title": "Test",
277
+
"items": [{
278
+
"content_text": "Hello"
279
+
}]
280
+
}|} in
281
+
282
+
(match Jsonfeed.of_string invalid_json3 with
283
+
| Ok _ -> Format.printf "✗ Should have failed (item without id)\n"
284
+
| Error (`Msg err) ->
285
+
Format.printf "✓ Correctly rejected invalid feed: %s\n" err);
286
+
287
+
Format.printf "\n"
288
+
289
+
let main () =
290
+
Format.printf "\n=== JSON Feed Validation Tests ===\n\n";
291
+
292
+
test_valid_minimal_feed ();
293
+
test_valid_complete_feed ();
294
+
test_feed_with_multiple_items ();
295
+
test_podcast_feed ();
296
+
test_microblog_feed ();
297
+
test_expired_feed ();
298
+
test_paginated_feed ();
299
+
test_invalid_feed_from_json ();
300
+
301
+
Format.printf "=== All Tests Complete ===\n"
302
+
303
+
let () = main ()
+34
jsonfeed.opam
+34
jsonfeed.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "JSON Feed format parser and serializer for OCaml"
4
+
description:
5
+
"This library implements the JSON Feed specification (version 1.1) for OCaml. JSON Feed is a syndication format similar to RSS and Atom, but using JSON instead of XML. The library provides type-safe parsing and serialization using Jsonm and Ptime."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy"]
8
+
license: "ISC"
9
+
homepage: "https://tangled.sh/@anil.recoil.org/ocaml-jsonfeed"
10
+
bug-reports: "https://tangled.sh/@anil.recoil.org/ocaml-jsonfeed"
11
+
depends: [
12
+
"dune" {>= "3.20"}
13
+
"ocaml" {>= "5.2.0"}
14
+
"jsonm" {>= "1.0.0"}
15
+
"ptime" {>= "1.2.0"}
16
+
"fmt" {>= "0.11.0"}
17
+
"odoc" {with-doc}
18
+
"alcotest" {with-test & >= "1.9.0"}
19
+
]
20
+
build: [
21
+
["dune" "subst"] {dev}
22
+
[
23
+
"dune"
24
+
"build"
25
+
"-p"
26
+
name
27
+
"-j"
28
+
jobs
29
+
"@install"
30
+
"@runtest" {with-test}
31
+
"@doc" {with-doc}
32
+
]
33
+
]
34
+
x-maintenance-intent: ["(latest)"]
+51
lib/attachment.ml
+51
lib/attachment.ml
···
1
+
(** Attachments for JSON Feed items. *)
2
+
3
+
type t = {
4
+
url : string;
5
+
mime_type : string;
6
+
title : string option;
7
+
size_in_bytes : int64 option;
8
+
duration_in_seconds : int option;
9
+
}
10
+
11
+
let create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds () =
12
+
{ url; mime_type; title; size_in_bytes; duration_in_seconds }
13
+
14
+
let url t = t.url
15
+
let mime_type t = t.mime_type
16
+
let title t = t.title
17
+
let size_in_bytes t = t.size_in_bytes
18
+
let duration_in_seconds t = t.duration_in_seconds
19
+
20
+
let equal a b =
21
+
a.url = b.url &&
22
+
a.mime_type = b.mime_type &&
23
+
a.title = b.title &&
24
+
a.size_in_bytes = b.size_in_bytes &&
25
+
a.duration_in_seconds = b.duration_in_seconds
26
+
27
+
let pp ppf t =
28
+
(* Extract filename from URL *)
29
+
let filename =
30
+
try
31
+
let parts = String.split_on_char '/' t.url in
32
+
List.nth parts (List.length parts - 1)
33
+
with _ -> t.url
34
+
in
35
+
36
+
Format.fprintf ppf "%s (%s" filename t.mime_type;
37
+
38
+
(match t.size_in_bytes with
39
+
| Some size ->
40
+
let mb = Int64.to_float size /. (1024. *. 1024.) in
41
+
Format.fprintf ppf ", %.1f MB" mb
42
+
| None -> ());
43
+
44
+
(match t.duration_in_seconds with
45
+
| Some duration ->
46
+
let mins = duration / 60 in
47
+
let secs = duration mod 60 in
48
+
Format.fprintf ppf ", %dm%ds" mins secs
49
+
| None -> ());
50
+
51
+
Format.fprintf ppf ")"
+91
lib/attachment.mli
+91
lib/attachment.mli
···
1
+
(** Attachments for JSON Feed items.
2
+
3
+
An attachment represents an external resource related to a feed item,
4
+
such as audio files for podcasts, video files, or other downloadable content.
5
+
Attachments with identical titles indicate alternate formats of the same resource.
6
+
7
+
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
8
+
9
+
10
+
(** The type representing an attachment. *)
11
+
type t
12
+
13
+
14
+
(** {1 Construction} *)
15
+
16
+
(** [create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()]
17
+
creates an attachment object.
18
+
19
+
@param url The location of the attachment (required)
20
+
@param mime_type The MIME type of the attachment, e.g. ["audio/mpeg"] (required)
21
+
@param title The name of the attachment; identical titles indicate alternate formats
22
+
of the same resource
23
+
@param size_in_bytes The size of the attachment file in bytes
24
+
@param duration_in_seconds The duration of the attachment in seconds (for audio/video)
25
+
26
+
{b Examples:}
27
+
{[
28
+
(* Simple attachment *)
29
+
let att = Attachment.create
30
+
~url:"https://example.com/episode.mp3"
31
+
~mime_type:"audio/mpeg" ()
32
+
33
+
(* Podcast episode with metadata *)
34
+
let att = Attachment.create
35
+
~url:"https://example.com/episode.mp3"
36
+
~mime_type:"audio/mpeg"
37
+
~title:"Episode 42"
38
+
~size_in_bytes:15_728_640L
39
+
~duration_in_seconds:1800 ()
40
+
41
+
(* Alternate format (same title indicates same content) *)
42
+
let att2 = Attachment.create
43
+
~url:"https://example.com/episode.aac"
44
+
~mime_type:"audio/aac"
45
+
~title:"Episode 42"
46
+
~size_in_bytes:12_582_912L
47
+
~duration_in_seconds:1800 ()
48
+
]} *)
49
+
val create :
50
+
url:string ->
51
+
mime_type:string ->
52
+
?title:string ->
53
+
?size_in_bytes:int64 ->
54
+
?duration_in_seconds:int ->
55
+
unit ->
56
+
t
57
+
58
+
59
+
(** {1 Accessors} *)
60
+
61
+
(** [url t] returns the attachment's URL. *)
62
+
val url : t -> string
63
+
64
+
(** [mime_type t] returns the attachment's MIME type. *)
65
+
val mime_type : t -> string
66
+
67
+
(** [title t] returns the attachment's title, if set. *)
68
+
val title : t -> string option
69
+
70
+
(** [size_in_bytes t] returns the attachment's size in bytes, if set. *)
71
+
val size_in_bytes : t -> int64 option
72
+
73
+
(** [duration_in_seconds t] returns the attachment's duration, if set. *)
74
+
val duration_in_seconds : t -> int option
75
+
76
+
77
+
(** {1 Comparison} *)
78
+
79
+
(** [equal a b] tests equality between two attachments. *)
80
+
val equal : t -> t -> bool
81
+
82
+
83
+
(** {1 Pretty Printing} *)
84
+
85
+
(** [pp ppf t] pretty prints an attachment to the formatter.
86
+
87
+
The output is human-readable and suitable for debugging.
88
+
89
+
{b Example output:}
90
+
{v episode.mp3 (audio/mpeg, 15.0 MB, 30m0s) v} *)
91
+
val pp : Format.formatter -> t -> unit
+4
lib/dune
+4
lib/dune
+18
lib/hub.ml
+18
lib/hub.ml
···
1
+
(** Hub endpoints for real-time notifications. *)
2
+
3
+
type t = {
4
+
type_ : string;
5
+
url : string;
6
+
}
7
+
8
+
let create ~type_ ~url () =
9
+
{ type_; url }
10
+
11
+
let type_ t = t.type_
12
+
let url t = t.url
13
+
14
+
let equal a b =
15
+
a.type_ = b.type_ && a.url = b.url
16
+
17
+
let pp ppf t =
18
+
Format.fprintf ppf "%s: %s" t.type_ t.url
+53
lib/hub.mli
+53
lib/hub.mli
···
1
+
(** Hub endpoints for real-time notifications.
2
+
3
+
Hubs describe endpoints that can be used to subscribe to real-time
4
+
notifications of changes to the feed. This is an optional and rarely-used
5
+
feature of JSON Feed, primarily for feeds that update frequently.
6
+
7
+
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
8
+
9
+
10
+
(** The type representing a hub endpoint. *)
11
+
type t
12
+
13
+
14
+
(** {1 Construction} *)
15
+
16
+
(** [create ~type_ ~url ()] creates a hub object.
17
+
18
+
@param type_ The type of hub protocol (e.g., ["rssCloud"], ["WebSub"])
19
+
@param url The URL endpoint for the hub
20
+
21
+
{b Example:}
22
+
{[
23
+
let hub = Hub.create
24
+
~type_:"WebSub"
25
+
~url:"https://pubsubhubbub.appspot.com/" ()
26
+
]} *)
27
+
val create : type_:string -> url:string -> unit -> t
28
+
29
+
30
+
(** {1 Accessors} *)
31
+
32
+
(** [type_ t] returns the hub's protocol type. *)
33
+
val type_ : t -> string
34
+
35
+
(** [url t] returns the hub's endpoint URL. *)
36
+
val url : t -> string
37
+
38
+
39
+
(** {1 Comparison} *)
40
+
41
+
(** [equal a b] tests equality between two hubs. *)
42
+
val equal : t -> t -> bool
43
+
44
+
45
+
(** {1 Pretty Printing} *)
46
+
47
+
(** [pp ppf t] pretty prints a hub to the formatter.
48
+
49
+
The output is human-readable and suitable for debugging.
50
+
51
+
{b Example output:}
52
+
{v WebSub: https://pubsubhubbub.appspot.com/ v} *)
53
+
val pp : Format.formatter -> t -> unit
+105
lib/item.ml
+105
lib/item.ml
···
1
+
(** Feed items in a JSON Feed. *)
2
+
3
+
type content =
4
+
[ `Html of string
5
+
| `Text of string
6
+
| `Both of string * string
7
+
]
8
+
9
+
type t = {
10
+
id : string;
11
+
content : content;
12
+
url : string option;
13
+
external_url : string option;
14
+
title : string option;
15
+
summary : string option;
16
+
image : string option;
17
+
banner_image : string option;
18
+
date_published : Ptime.t option;
19
+
date_modified : Ptime.t option;
20
+
authors : Author.t list option;
21
+
tags : string list option;
22
+
language : string option;
23
+
attachments : Attachment.t list option;
24
+
}
25
+
26
+
let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
27
+
?date_published ?date_modified ?authors ?tags ?language ?attachments () =
28
+
{
29
+
id;
30
+
content;
31
+
url;
32
+
external_url;
33
+
title;
34
+
summary;
35
+
image;
36
+
banner_image;
37
+
date_published;
38
+
date_modified;
39
+
authors;
40
+
tags;
41
+
language;
42
+
attachments;
43
+
}
44
+
45
+
let id t = t.id
46
+
let content t = t.content
47
+
let url t = t.url
48
+
let external_url t = t.external_url
49
+
let title t = t.title
50
+
let summary t = t.summary
51
+
let image t = t.image
52
+
let banner_image t = t.banner_image
53
+
let date_published t = t.date_published
54
+
let date_modified t = t.date_modified
55
+
let authors t = t.authors
56
+
let tags t = t.tags
57
+
let language t = t.language
58
+
let attachments t = t.attachments
59
+
60
+
let content_html t =
61
+
match t.content with
62
+
| `Html html -> Some html
63
+
| `Text _ -> None
64
+
| `Both (html, _) -> Some html
65
+
66
+
let content_text t =
67
+
match t.content with
68
+
| `Html _ -> None
69
+
| `Text text -> Some text
70
+
| `Both (_, text) -> Some text
71
+
72
+
let equal a b =
73
+
(* Items are equal if they have the same ID *)
74
+
a.id = b.id
75
+
76
+
let compare a b =
77
+
(* Compare by publication date, with items without dates considered older *)
78
+
match a.date_published, b.date_published with
79
+
| None, None -> 0
80
+
| None, Some _ -> -1 (* Items without dates are "older" *)
81
+
| Some _, None -> 1
82
+
| Some da, Some db -> Ptime.compare da db
83
+
84
+
let pp_content ppf = function
85
+
| `Html html ->
86
+
Format.fprintf ppf "HTML (%d chars)" (String.length html)
87
+
| `Text text ->
88
+
Format.fprintf ppf "Text (%d chars)" (String.length text)
89
+
| `Both (html, text) ->
90
+
Format.fprintf ppf "Both (HTML: %d chars, Text: %d chars)"
91
+
(String.length html) (String.length text)
92
+
93
+
let pp ppf t =
94
+
match t.date_published, t.title with
95
+
| Some date, Some title ->
96
+
(* Use Ptime's date formatting *)
97
+
let (y, m, d), _ = Ptime.to_date_time date in
98
+
Format.fprintf ppf "[%04d-%02d-%02d] %s (%s)" y m d title t.id
99
+
| Some date, None ->
100
+
let (y, m, d), _ = Ptime.to_date_time date in
101
+
Format.fprintf ppf "[%04d-%02d-%02d] %s" y m d t.id
102
+
| None, Some title ->
103
+
Format.fprintf ppf "%s (%s)" title t.id
104
+
| None, None ->
105
+
Format.fprintf ppf "%s" t.id
+190
lib/item.mli
+190
lib/item.mli
···
1
+
(** Feed items in a JSON Feed.
2
+
3
+
An item represents a single entry in a feed, such as a blog post, podcast episode,
4
+
or microblog entry. Each item must have a unique identifier and content.
5
+
6
+
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
7
+
8
+
9
+
(** The type representing a feed item. *)
10
+
type t
11
+
12
+
(** Content representation for an item.
13
+
14
+
The JSON Feed specification requires that each item has at least one
15
+
form of content. This type enforces that requirement at compile time.
16
+
17
+
- [`Html s]: Item has HTML content only
18
+
- [`Text s]: Item has plain text content only
19
+
- [`Both (html, text)]: Item has both HTML and plain text versions *)
20
+
type content =
21
+
[ `Html of string
22
+
| `Text of string
23
+
| `Both of string * string
24
+
]
25
+
26
+
27
+
(** {1 Construction} *)
28
+
29
+
(** [create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
30
+
?date_published ?date_modified ?authors ?tags ?language ?attachments ()]
31
+
creates a feed item.
32
+
33
+
@param id Unique identifier for the item (required). Should be a full URL if possible.
34
+
@param content The item's content in HTML and/or plain text (required)
35
+
@param url Permalink to the item
36
+
@param external_url URL of an external resource (useful for linkblogs)
37
+
@param title Plain text title of the item
38
+
@param summary Plain text summary/excerpt of the item
39
+
@param image URL of the main featured image for the item
40
+
@param banner_image URL of a banner image for the item
41
+
@param date_published Publication date/time (RFC 3339 format)
42
+
@param date_modified Last modification date/time (RFC 3339 format)
43
+
@param authors Item-specific authors (overrides feed-level authors)
44
+
@param tags Plain text tags/categories for the item
45
+
@param language Primary language of the item (RFC 5646 format, e.g. ["en-US"])
46
+
@param attachments Related resources like audio files or downloads
47
+
48
+
{b Examples:}
49
+
{[
50
+
(* Simple blog post *)
51
+
let item = Item.create
52
+
~id:"https://example.com/posts/42"
53
+
~content:(`Html "<p>Hello, world!</p>")
54
+
~title:"My First Post"
55
+
~url:"https://example.com/posts/42" ()
56
+
57
+
(* Microblog entry with plain text *)
58
+
let item = Item.create
59
+
~id:"https://example.com/micro/123"
60
+
~content:(`Text "Just posted a new photo!")
61
+
~date_published:(Ptime.of_float_s (Unix.time ()) |> Option.get) ()
62
+
63
+
(* Article with both HTML and plain text *)
64
+
let item = Item.create
65
+
~id:"https://example.com/article/99"
66
+
~content:(`Both ("<p>Rich content</p>", "Plain version"))
67
+
~title:"Article Title"
68
+
~tags:["ocaml"; "programming"] ()
69
+
70
+
(* Podcast episode with attachment *)
71
+
let attachment = Attachment.create
72
+
~url:"https://example.com/ep1.mp3"
73
+
~mime_type:"audio/mpeg"
74
+
~duration_in_seconds:1800 () in
75
+
let item = Item.create
76
+
~id:"https://example.com/podcast/1"
77
+
~content:(`Html "<p>Episode description</p>")
78
+
~title:"Episode 1"
79
+
~attachments:[attachment] ()
80
+
]} *)
81
+
val create :
82
+
id:string ->
83
+
content:content ->
84
+
?url:string ->
85
+
?external_url:string ->
86
+
?title:string ->
87
+
?summary:string ->
88
+
?image:string ->
89
+
?banner_image:string ->
90
+
?date_published:Ptime.t ->
91
+
?date_modified:Ptime.t ->
92
+
?authors:Author.t list ->
93
+
?tags:string list ->
94
+
?language:string ->
95
+
?attachments:Attachment.t list ->
96
+
unit ->
97
+
t
98
+
99
+
100
+
(** {1 Accessors} *)
101
+
102
+
(** [id t] returns the item's unique identifier. *)
103
+
val id : t -> string
104
+
105
+
(** [content t] returns the item's content. *)
106
+
val content : t -> content
107
+
108
+
(** [url t] returns the item's permalink URL, if set. *)
109
+
val url : t -> string option
110
+
111
+
(** [external_url t] returns the external resource URL, if set. *)
112
+
val external_url : t -> string option
113
+
114
+
(** [title t] returns the item's title, if set. *)
115
+
val title : t -> string option
116
+
117
+
(** [summary t] returns the item's summary, if set. *)
118
+
val summary : t -> string option
119
+
120
+
(** [image t] returns the item's featured image URL, if set. *)
121
+
val image : t -> string option
122
+
123
+
(** [banner_image t] returns the item's banner image URL, if set. *)
124
+
val banner_image : t -> string option
125
+
126
+
(** [date_published t] returns the item's publication date, if set. *)
127
+
val date_published : t -> Ptime.t option
128
+
129
+
(** [date_modified t] returns the item's last modification date, if set. *)
130
+
val date_modified : t -> Ptime.t option
131
+
132
+
(** [authors t] returns the item's authors, if set. *)
133
+
val authors : t -> Author.t list option
134
+
135
+
(** [tags t] returns the item's tags, if set. *)
136
+
val tags : t -> string list option
137
+
138
+
(** [language t] returns the item's language code, if set. *)
139
+
val language : t -> string option
140
+
141
+
(** [attachments t] returns the item's attachments, if set. *)
142
+
val attachments : t -> Attachment.t list option
143
+
144
+
145
+
(** {1 Content Helpers} *)
146
+
147
+
(** [content_html t] extracts HTML content from the item.
148
+
149
+
Returns [Some html] if the item has HTML content (either [Html] or [Both]),
150
+
[None] otherwise. *)
151
+
val content_html : t -> string option
152
+
153
+
(** [content_text t] extracts plain text content from the item.
154
+
155
+
Returns [Some text] if the item has plain text content (either [Text] or [Both]),
156
+
[None] otherwise. *)
157
+
val content_text : t -> string option
158
+
159
+
160
+
(** {1 Comparison} *)
161
+
162
+
(** [equal a b] tests equality between two items.
163
+
164
+
Items are considered equal if they have the same ID. *)
165
+
val equal : t -> t -> bool
166
+
167
+
(** [compare a b] compares two items by their publication dates.
168
+
169
+
Items without publication dates are considered older than items with dates.
170
+
Useful for sorting items chronologically. *)
171
+
val compare : t -> t -> int
172
+
173
+
174
+
(** {1 Pretty Printing} *)
175
+
176
+
(** [pp ppf t] pretty prints an item to the formatter.
177
+
178
+
The output is human-readable and suitable for debugging.
179
+
180
+
{b Example output:}
181
+
{v [2024-11-03] My First Post (https://example.com/posts/42) v} *)
182
+
val pp : Format.formatter -> t -> unit
183
+
184
+
(** [pp_content ppf content] pretty prints content to the formatter.
185
+
186
+
{b Example output:}
187
+
{v HTML (123 chars) v}
188
+
{v Text (56 chars) v}
189
+
{v Both (HTML: 123 chars, Text: 56 chars) v} *)
190
+
val pp_content : Format.formatter -> content -> unit
+571
lib/jsonfeed.ml
+571
lib/jsonfeed.ml
···
1
+
(** JSON Feed format parser and serializer. *)
2
+
3
+
exception Invalid_feed of string
4
+
5
+
module Author = Author
6
+
module Attachment = Attachment
7
+
module Hub = Hub
8
+
module Item = Item
9
+
10
+
type t = {
11
+
version : string;
12
+
title : string;
13
+
home_page_url : string option;
14
+
feed_url : string option;
15
+
description : string option;
16
+
user_comment : string option;
17
+
next_url : string option;
18
+
icon : string option;
19
+
favicon : string option;
20
+
authors : Author.t list option;
21
+
language : string option;
22
+
expired : bool option;
23
+
hubs : Hub.t list option;
24
+
items : Item.t list;
25
+
}
26
+
27
+
let create ~title ?home_page_url ?feed_url ?description ?user_comment
28
+
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () =
29
+
{
30
+
version = "https://jsonfeed.org/version/1.1";
31
+
title;
32
+
home_page_url;
33
+
feed_url;
34
+
description;
35
+
user_comment;
36
+
next_url;
37
+
icon;
38
+
favicon;
39
+
authors;
40
+
language;
41
+
expired;
42
+
hubs;
43
+
items;
44
+
}
45
+
46
+
let version t = t.version
47
+
let title t = t.title
48
+
let home_page_url t = t.home_page_url
49
+
let feed_url t = t.feed_url
50
+
let description t = t.description
51
+
let user_comment t = t.user_comment
52
+
let next_url t = t.next_url
53
+
let icon t = t.icon
54
+
let favicon t = t.favicon
55
+
let authors t = t.authors
56
+
let language t = t.language
57
+
let expired t = t.expired
58
+
let hubs t = t.hubs
59
+
let items t = t.items
60
+
61
+
(* RFC3339 date utilities *)
62
+
63
+
let parse_rfc3339 s =
64
+
match Ptime.of_rfc3339 s with
65
+
| Ok (t, _, _) -> Some t
66
+
| Error _ -> None
67
+
68
+
let format_rfc3339 t =
69
+
Ptime.to_rfc3339 t
70
+
71
+
(* JSON parsing and serialization *)
72
+
73
+
type error = [ `Msg of string ]
74
+
75
+
let error_msgf fmt = Format.kasprintf (fun s -> Error (`Msg s)) fmt
76
+
77
+
(* JSON parsing helpers *)
78
+
79
+
type json_value =
80
+
| Null
81
+
| Bool of bool
82
+
| Float of float
83
+
| String of string
84
+
| Array of json_value list
85
+
| Object of (string * json_value) list
86
+
87
+
let rec decode_value dec =
88
+
match Jsonm.decode dec with
89
+
| `Lexeme `Null -> Null
90
+
| `Lexeme (`Bool b) -> Bool b
91
+
| `Lexeme (`Float f) -> Float f
92
+
| `Lexeme (`String s) -> String s
93
+
| `Lexeme `Os -> decode_object dec []
94
+
| `Lexeme `As -> decode_array dec []
95
+
| `Lexeme _ -> Null
96
+
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
97
+
| `End | `Await -> Null
98
+
99
+
and decode_object dec acc =
100
+
match Jsonm.decode dec with
101
+
| `Lexeme `Oe -> Object (List.rev acc)
102
+
| `Lexeme (`Name n) ->
103
+
let v = decode_value dec in
104
+
decode_object dec ((n, v) :: acc)
105
+
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
106
+
| _ -> Object (List.rev acc)
107
+
108
+
and decode_array dec acc =
109
+
match Jsonm.decode dec with
110
+
| `Lexeme `Ae -> Array (List.rev acc)
111
+
| `Lexeme `Os ->
112
+
let v = decode_object dec [] in
113
+
decode_array dec (v :: acc)
114
+
| `Lexeme `As ->
115
+
let v = decode_array dec [] in
116
+
decode_array dec (v :: acc)
117
+
| `Lexeme `Null -> decode_array dec (Null :: acc)
118
+
| `Lexeme (`Bool b) -> decode_array dec (Bool b :: acc)
119
+
| `Lexeme (`Float f) -> decode_array dec (Float f :: acc)
120
+
| `Lexeme (`String s) -> decode_array dec (String s :: acc)
121
+
| `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
122
+
| _ -> Array (List.rev acc)
123
+
124
+
(* Helpers to extract values from JSON *)
125
+
126
+
let get_string = function String s -> Some s | _ -> None
127
+
let get_bool = function Bool b -> Some b | _ -> None
128
+
let _get_float = function Float f -> Some f | _ -> None
129
+
let get_int = function Float f -> Some (int_of_float f) | _ -> None
130
+
let get_int64 = function Float f -> Some (Int64.of_float f) | _ -> None
131
+
let get_array = function Array arr -> Some arr | _ -> None
132
+
let _get_object = function Object obj -> Some obj | _ -> None
133
+
134
+
let find_field name obj = List.assoc_opt name obj
135
+
136
+
let require_field name obj =
137
+
match find_field name obj with
138
+
| Some v -> v
139
+
| None -> raise (Invalid_feed (Printf.sprintf "Missing required field: %s" name))
140
+
141
+
let require_string name obj =
142
+
match require_field name obj |> get_string with
143
+
| Some s -> s
144
+
| None -> raise (Invalid_feed (Printf.sprintf "Field %s must be a string" name))
145
+
146
+
let optional_string name obj =
147
+
match find_field name obj with Some v -> get_string v | None -> None
148
+
149
+
let optional_bool name obj =
150
+
match find_field name obj with Some v -> get_bool v | None -> None
151
+
152
+
let optional_int name obj =
153
+
match find_field name obj with Some v -> get_int v | None -> None
154
+
155
+
let optional_int64 name obj =
156
+
match find_field name obj with Some v -> get_int64 v | None -> None
157
+
158
+
let optional_array name obj =
159
+
match find_field name obj with Some v -> get_array v | None -> None
160
+
161
+
(* Parse Author *)
162
+
163
+
let parse_author_obj obj =
164
+
let name = optional_string "name" obj in
165
+
let url = optional_string "url" obj in
166
+
let avatar = optional_string "avatar" obj in
167
+
if name = None && url = None && avatar = None then
168
+
raise (Invalid_feed "Author must have at least one field");
169
+
Author.create ?name ?url ?avatar ()
170
+
171
+
let parse_author = function
172
+
| Object obj -> parse_author_obj obj
173
+
| _ -> raise (Invalid_feed "Author must be an object")
174
+
175
+
(* Parse Attachment *)
176
+
177
+
let parse_attachment_obj obj =
178
+
let url = require_string "url" obj in
179
+
let mime_type = require_string "mime_type" obj in
180
+
let title = optional_string "title" obj in
181
+
let size_in_bytes = optional_int64 "size_in_bytes" obj in
182
+
let duration_in_seconds = optional_int "duration_in_seconds" obj in
183
+
Attachment.create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()
184
+
185
+
let parse_attachment = function
186
+
| Object obj -> parse_attachment_obj obj
187
+
| _ -> raise (Invalid_feed "Attachment must be an object")
188
+
189
+
(* Parse Hub *)
190
+
191
+
let parse_hub_obj obj =
192
+
let type_ = require_string "type" obj in
193
+
let url = require_string "url" obj in
194
+
Hub.create ~type_ ~url ()
195
+
196
+
let parse_hub = function
197
+
| Object obj -> parse_hub_obj obj
198
+
| _ -> raise (Invalid_feed "Hub must be an object")
199
+
200
+
(* Parse Item *)
201
+
202
+
let parse_item_obj obj =
203
+
let id = require_string "id" obj in
204
+
205
+
(* Parse content - at least one required *)
206
+
let content_html = optional_string "content_html" obj in
207
+
let content_text = optional_string "content_text" obj in
208
+
let content = match content_html, content_text with
209
+
| Some html, Some text -> `Both (html, text)
210
+
| Some html, None -> `Html html
211
+
| None, Some text -> `Text text
212
+
| None, None ->
213
+
raise (Invalid_feed "Item must have content_html or content_text")
214
+
in
215
+
216
+
let url = optional_string "url" obj in
217
+
let external_url = optional_string "external_url" obj in
218
+
let title = optional_string "title" obj in
219
+
let summary = optional_string "summary" obj in
220
+
let image = optional_string "image" obj in
221
+
let banner_image = optional_string "banner_image" obj in
222
+
223
+
let date_published =
224
+
match optional_string "date_published" obj with
225
+
| Some s -> parse_rfc3339 s
226
+
| None -> None
227
+
in
228
+
229
+
let date_modified =
230
+
match optional_string "date_modified" obj with
231
+
| Some s -> parse_rfc3339 s
232
+
| None -> None
233
+
in
234
+
235
+
let authors =
236
+
match optional_array "authors" obj with
237
+
| Some arr ->
238
+
let parsed = List.map parse_author arr in
239
+
if parsed = [] then None else Some parsed
240
+
| None -> None
241
+
in
242
+
243
+
let tags =
244
+
match optional_array "tags" obj with
245
+
| Some arr ->
246
+
let parsed = List.filter_map get_string arr in
247
+
if parsed = [] then None else Some parsed
248
+
| None -> None
249
+
in
250
+
251
+
let language = optional_string "language" obj in
252
+
253
+
let attachments =
254
+
match optional_array "attachments" obj with
255
+
| Some arr ->
256
+
let parsed = List.map parse_attachment arr in
257
+
if parsed = [] then None else Some parsed
258
+
| None -> None
259
+
in
260
+
261
+
Item.create ~id ~content ?url ?external_url ?title ?summary ?image
262
+
?banner_image ?date_published ?date_modified ?authors ?tags ?language
263
+
?attachments ()
264
+
265
+
let parse_item = function
266
+
| Object obj -> parse_item_obj obj
267
+
| _ -> raise (Invalid_feed "Item must be an object")
268
+
269
+
(* Parse Feed *)
270
+
271
+
let parse_feed_obj obj =
272
+
let version = require_string "version" obj in
273
+
let title = require_string "title" obj in
274
+
let home_page_url = optional_string "home_page_url" obj in
275
+
let feed_url = optional_string "feed_url" obj in
276
+
let description = optional_string "description" obj in
277
+
let user_comment = optional_string "user_comment" obj in
278
+
let next_url = optional_string "next_url" obj in
279
+
let icon = optional_string "icon" obj in
280
+
let favicon = optional_string "favicon" obj in
281
+
let language = optional_string "language" obj in
282
+
let expired = optional_bool "expired" obj in
283
+
284
+
let authors =
285
+
match optional_array "authors" obj with
286
+
| Some arr ->
287
+
let parsed = List.map parse_author arr in
288
+
if parsed = [] then None else Some parsed
289
+
| None -> None
290
+
in
291
+
292
+
let hubs =
293
+
match optional_array "hubs" obj with
294
+
| Some arr ->
295
+
let parsed = List.map parse_hub arr in
296
+
if parsed = [] then None else Some parsed
297
+
| None -> None
298
+
in
299
+
300
+
let items =
301
+
match optional_array "items" obj with
302
+
| Some arr -> List.map parse_item arr
303
+
| None -> []
304
+
in
305
+
306
+
{
307
+
version;
308
+
title;
309
+
home_page_url;
310
+
feed_url;
311
+
description;
312
+
user_comment;
313
+
next_url;
314
+
icon;
315
+
favicon;
316
+
authors;
317
+
language;
318
+
expired;
319
+
hubs;
320
+
items;
321
+
}
322
+
323
+
let of_jsonm dec =
324
+
try
325
+
let json = decode_value dec in
326
+
match json with
327
+
| Object obj -> Ok (parse_feed_obj obj)
328
+
| _ -> error_msgf "Feed must be a JSON object"
329
+
with
330
+
| Invalid_feed msg -> error_msgf "%s" msg
331
+
332
+
(* JSON serialization *)
333
+
334
+
let to_jsonm enc feed =
335
+
(* Simplified serialization using Jsonm *)
336
+
let enc_field name value_fn =
337
+
ignore (Jsonm.encode enc (`Lexeme (`Name name)));
338
+
value_fn ()
339
+
in
340
+
341
+
let enc_string s =
342
+
ignore (Jsonm.encode enc (`Lexeme (`String s)))
343
+
in
344
+
345
+
let enc_bool b =
346
+
ignore (Jsonm.encode enc (`Lexeme (`Bool b)))
347
+
in
348
+
349
+
let enc_opt enc_fn = function
350
+
| None -> ()
351
+
| Some v -> enc_fn v
352
+
in
353
+
354
+
let enc_list enc_fn lst =
355
+
ignore (Jsonm.encode enc (`Lexeme `As));
356
+
List.iter enc_fn lst;
357
+
ignore (Jsonm.encode enc (`Lexeme `Ae))
358
+
in
359
+
360
+
let enc_author author =
361
+
ignore (Jsonm.encode enc (`Lexeme `Os));
362
+
(match Author.name author with
363
+
| Some name -> enc_field "name" (fun () -> enc_string name)
364
+
| None -> ());
365
+
(match Author.url author with
366
+
| Some url -> enc_field "url" (fun () -> enc_string url)
367
+
| None -> ());
368
+
(match Author.avatar author with
369
+
| Some avatar -> enc_field "avatar" (fun () -> enc_string avatar)
370
+
| None -> ());
371
+
ignore (Jsonm.encode enc (`Lexeme `Oe))
372
+
in
373
+
374
+
let enc_attachment att =
375
+
ignore (Jsonm.encode enc (`Lexeme `Os));
376
+
enc_field "url" (fun () -> enc_string (Attachment.url att));
377
+
enc_field "mime_type" (fun () -> enc_string (Attachment.mime_type att));
378
+
enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
379
+
(Attachment.title att);
380
+
enc_opt (fun size ->
381
+
enc_field "size_in_bytes" (fun () ->
382
+
ignore (Jsonm.encode enc (`Lexeme (`Float (Int64.to_float size))))))
383
+
(Attachment.size_in_bytes att);
384
+
enc_opt (fun dur ->
385
+
enc_field "duration_in_seconds" (fun () ->
386
+
ignore (Jsonm.encode enc (`Lexeme (`Float (float_of_int dur))))))
387
+
(Attachment.duration_in_seconds att);
388
+
ignore (Jsonm.encode enc (`Lexeme `Oe))
389
+
in
390
+
391
+
let enc_hub hub =
392
+
ignore (Jsonm.encode enc (`Lexeme `Os));
393
+
enc_field "type" (fun () -> enc_string (Hub.type_ hub));
394
+
enc_field "url" (fun () -> enc_string (Hub.url hub));
395
+
ignore (Jsonm.encode enc (`Lexeme `Oe))
396
+
in
397
+
398
+
let enc_item item =
399
+
ignore (Jsonm.encode enc (`Lexeme `Os));
400
+
enc_field "id" (fun () -> enc_string (Item.id item));
401
+
402
+
(* Encode content *)
403
+
(match Item.content item with
404
+
| `Html html ->
405
+
enc_field "content_html" (fun () -> enc_string html)
406
+
| `Text text ->
407
+
enc_field "content_text" (fun () -> enc_string text)
408
+
| `Both (html, text) ->
409
+
enc_field "content_html" (fun () -> enc_string html);
410
+
enc_field "content_text" (fun () -> enc_string text));
411
+
412
+
enc_opt (fun url -> enc_field "url" (fun () -> enc_string url))
413
+
(Item.url item);
414
+
enc_opt (fun url -> enc_field "external_url" (fun () -> enc_string url))
415
+
(Item.external_url item);
416
+
enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
417
+
(Item.title item);
418
+
enc_opt (fun summary -> enc_field "summary" (fun () -> enc_string summary))
419
+
(Item.summary item);
420
+
enc_opt (fun img -> enc_field "image" (fun () -> enc_string img))
421
+
(Item.image item);
422
+
enc_opt (fun img -> enc_field "banner_image" (fun () -> enc_string img))
423
+
(Item.banner_image item);
424
+
enc_opt (fun date -> enc_field "date_published" (fun () -> enc_string (format_rfc3339 date)))
425
+
(Item.date_published item);
426
+
enc_opt (fun date -> enc_field "date_modified" (fun () -> enc_string (format_rfc3339 date)))
427
+
(Item.date_modified item);
428
+
enc_opt (fun authors ->
429
+
enc_field "authors" (fun () -> enc_list enc_author authors))
430
+
(Item.authors item);
431
+
enc_opt (fun tags ->
432
+
enc_field "tags" (fun () -> enc_list enc_string tags))
433
+
(Item.tags item);
434
+
enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
435
+
(Item.language item);
436
+
enc_opt (fun atts ->
437
+
enc_field "attachments" (fun () -> enc_list enc_attachment atts))
438
+
(Item.attachments item);
439
+
440
+
ignore (Jsonm.encode enc (`Lexeme `Oe))
441
+
in
442
+
443
+
(* Encode the feed *)
444
+
ignore (Jsonm.encode enc (`Lexeme `Os));
445
+
enc_field "version" (fun () -> enc_string feed.version);
446
+
enc_field "title" (fun () -> enc_string feed.title);
447
+
enc_opt (fun url -> enc_field "home_page_url" (fun () -> enc_string url))
448
+
feed.home_page_url;
449
+
enc_opt (fun url -> enc_field "feed_url" (fun () -> enc_string url))
450
+
feed.feed_url;
451
+
enc_opt (fun desc -> enc_field "description" (fun () -> enc_string desc))
452
+
feed.description;
453
+
enc_opt (fun comment -> enc_field "user_comment" (fun () -> enc_string comment))
454
+
feed.user_comment;
455
+
enc_opt (fun url -> enc_field "next_url" (fun () -> enc_string url))
456
+
feed.next_url;
457
+
enc_opt (fun icon -> enc_field "icon" (fun () -> enc_string icon))
458
+
feed.icon;
459
+
enc_opt (fun favicon -> enc_field "favicon" (fun () -> enc_string favicon))
460
+
feed.favicon;
461
+
enc_opt (fun authors ->
462
+
enc_field "authors" (fun () -> enc_list enc_author authors))
463
+
feed.authors;
464
+
enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
465
+
feed.language;
466
+
enc_opt (fun expired -> enc_field "expired" (fun () -> enc_bool expired))
467
+
feed.expired;
468
+
enc_opt (fun hubs ->
469
+
enc_field "hubs" (fun () -> enc_list enc_hub hubs))
470
+
feed.hubs;
471
+
enc_field "items" (fun () -> enc_list enc_item feed.items);
472
+
ignore (Jsonm.encode enc (`Lexeme `Oe));
473
+
ignore (Jsonm.encode enc `End)
474
+
475
+
let of_string s =
476
+
let dec = Jsonm.decoder (`String s) in
477
+
of_jsonm dec
478
+
479
+
let to_string ?(minify=false) feed =
480
+
let buf = Buffer.create 1024 in
481
+
let enc = Jsonm.encoder ~minify (`Buffer buf) in
482
+
to_jsonm enc feed;
483
+
Buffer.contents buf
484
+
485
+
(* Validation *)
486
+
487
+
let validate feed =
488
+
let errors = ref [] in
489
+
let add_error msg = errors := msg :: !errors in
490
+
491
+
(* Check required fields *)
492
+
if feed.title = "" then
493
+
add_error "title is required and cannot be empty";
494
+
495
+
(* Check items have unique IDs *)
496
+
let ids = List.map Item.id feed.items in
497
+
let unique_ids = List.sort_uniq String.compare ids in
498
+
if List.length ids <> List.length unique_ids then
499
+
add_error "items must have unique IDs";
500
+
501
+
(* Validate authors *)
502
+
(match feed.authors with
503
+
| Some authors ->
504
+
List.iteri (fun i author ->
505
+
if not (Author.is_valid author) then
506
+
add_error (Printf.sprintf "feed author %d is invalid (needs at least one field)" i)
507
+
) authors
508
+
| None -> ());
509
+
510
+
(* Validate items *)
511
+
List.iteri (fun i item ->
512
+
if Item.id item = "" then
513
+
add_error (Printf.sprintf "item %d has empty ID" i);
514
+
515
+
(* Validate item authors *)
516
+
(match Item.authors item with
517
+
| Some authors ->
518
+
List.iteri (fun j author ->
519
+
if not (Author.is_valid author) then
520
+
add_error (Printf.sprintf "item %d author %d is invalid" i j)
521
+
) authors
522
+
| None -> ())
523
+
) feed.items;
524
+
525
+
if !errors = [] then Ok ()
526
+
else Error (List.rev !errors)
527
+
528
+
(* Comparison *)
529
+
530
+
let equal a b =
531
+
a.version = b.version &&
532
+
a.title = b.title &&
533
+
a.home_page_url = b.home_page_url &&
534
+
a.feed_url = b.feed_url &&
535
+
a.description = b.description &&
536
+
a.user_comment = b.user_comment &&
537
+
a.next_url = b.next_url &&
538
+
a.icon = b.icon &&
539
+
a.favicon = b.favicon &&
540
+
a.language = b.language &&
541
+
a.expired = b.expired &&
542
+
(* Note: We're doing structural equality on items *)
543
+
List.length a.items = List.length b.items
544
+
545
+
(* Pretty printing *)
546
+
547
+
let pp_summary ppf feed =
548
+
Format.fprintf ppf "%s (%d items)" feed.title (List.length feed.items)
549
+
550
+
let pp ppf feed =
551
+
Format.fprintf ppf "Feed: %s" feed.title;
552
+
(match feed.home_page_url with
553
+
| Some url -> Format.fprintf ppf " (%s)" url
554
+
| None -> ());
555
+
Format.fprintf ppf "@\n";
556
+
557
+
Format.fprintf ppf " Items: %d@\n" (List.length feed.items);
558
+
559
+
(match feed.authors with
560
+
| Some authors when authors <> [] ->
561
+
Format.fprintf ppf " Authors: ";
562
+
List.iteri (fun i author ->
563
+
if i > 0 then Format.fprintf ppf ", ";
564
+
Format.fprintf ppf "%a" Author.pp author
565
+
) authors;
566
+
Format.fprintf ppf "@\n"
567
+
| _ -> ());
568
+
569
+
(match feed.language with
570
+
| Some lang -> Format.fprintf ppf " Language: %s@\n" lang
571
+
| None -> ())
+376
lib/jsonfeed.mli
+376
lib/jsonfeed.mli
···
1
+
(** JSON Feed format parser and serializer.
2
+
3
+
This library implements the JSON Feed specification version 1.1, providing
4
+
type-safe parsing and serialization of JSON Feed documents. JSON Feed is a
5
+
syndication format similar to RSS and Atom, but using JSON instead of XML.
6
+
7
+
{b Key Features:}
8
+
- Type-safe construction with compile-time validation
9
+
- Support for all JSON Feed 1.1 fields
10
+
- RFC 3339 date parsing with Ptime integration
11
+
- Streaming parsing and serialization with Jsonm
12
+
- Comprehensive documentation and examples
13
+
14
+
{b Quick Start:}
15
+
{[
16
+
(* Create a simple feed *)
17
+
let feed = Jsonfeed.create
18
+
~title:"My Blog"
19
+
~home_page_url:"https://example.com"
20
+
~feed_url:"https://example.com/feed.json"
21
+
~items:[
22
+
Item.create
23
+
~id:"https://example.com/post/1"
24
+
~content:(Item.Html "<p>Hello, world!</p>")
25
+
~title:"First Post"
26
+
()
27
+
]
28
+
()
29
+
30
+
(* Serialize to string *)
31
+
let json = Jsonfeed.to_string feed
32
+
33
+
(* Parse from string *)
34
+
match Jsonfeed.of_string json with
35
+
| Ok feed -> Printf.printf "Feed: %s\n" (Jsonfeed.title feed)
36
+
| Error (`Msg err) -> Printf.eprintf "Error: %s\n" err
37
+
]}
38
+
39
+
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
40
+
41
+
42
+
(** The type representing a complete JSON Feed. *)
43
+
type t
44
+
45
+
(** Exception raised when attempting to parse an invalid feed. *)
46
+
exception Invalid_feed of string
47
+
48
+
(** {1 Construction} *)
49
+
50
+
(** [create ~title ?home_page_url ?feed_url ?description ?user_comment ?next_url
51
+
?icon ?favicon ?authors ?language ?expired ?hubs ~items ()]
52
+
creates a JSON Feed.
53
+
54
+
@param title The name of the feed (required)
55
+
@param home_page_url The URL of the resource the feed describes
56
+
@param feed_url The URL of the feed itself (serves as unique identifier)
57
+
@param description Additional information about the feed
58
+
@param user_comment A description of the feed's purpose for humans reading the raw JSON
59
+
@param next_url URL of the next page of items (for pagination)
60
+
@param icon The feed's icon URL (should be square, 512x512 or larger)
61
+
@param favicon The feed's favicon URL (should be square, 64x64 or larger)
62
+
@param authors The feed's default authors (inherited by items without authors)
63
+
@param language The primary language of the feed (RFC 5646 format, e.g. ["en-US"])
64
+
@param expired Whether the feed will update again ([true] means no more updates)
65
+
@param hubs Endpoints for real-time notifications
66
+
@param items The list of feed items (required)
67
+
68
+
{b Examples:}
69
+
{[
70
+
(* Minimal feed *)
71
+
let feed = Jsonfeed.create
72
+
~title:"My Blog"
73
+
~items:[] ()
74
+
75
+
(* Full-featured blog feed *)
76
+
let feed = Jsonfeed.create
77
+
~title:"Example Blog"
78
+
~home_page_url:"https://example.com"
79
+
~feed_url:"https://example.com/feed.json"
80
+
~description:"A blog about OCaml and functional programming"
81
+
~icon:"https://example.com/icon.png"
82
+
~authors:[
83
+
Author.create
84
+
~name:"Jane Doe"
85
+
~url:"https://example.com/about"
86
+
()
87
+
]
88
+
~language:"en-US"
89
+
~items:[
90
+
Item.create
91
+
~id:"https://example.com/posts/1"
92
+
~content:(Item.Html "<p>First post</p>")
93
+
~title:"Hello World"
94
+
();
95
+
Item.create
96
+
~id:"https://example.com/posts/2"
97
+
~content:(Item.Html "<p>Second post</p>")
98
+
~title:"Another Post"
99
+
()
100
+
]
101
+
()
102
+
103
+
(* Podcast feed with hubs *)
104
+
let hub = Hub.create
105
+
~type_:"WebSub"
106
+
~url:"https://pubsubhubbub.appspot.com/"
107
+
() in
108
+
let feed = Jsonfeed.create
109
+
~title:"My Podcast"
110
+
~home_page_url:"https://podcast.example.com"
111
+
~feed_url:"https://podcast.example.com/feed.json"
112
+
~hubs:[hub]
113
+
~items:[
114
+
Item.create
115
+
~id:"https://podcast.example.com/episodes/1"
116
+
~content:(Item.Html "<p>Episode description</p>")
117
+
~title:"Episode 1"
118
+
~attachments:[
119
+
Attachment.create
120
+
~url:"https://podcast.example.com/ep1.mp3"
121
+
~mime_type:"audio/mpeg"
122
+
~duration_in_seconds:1800
123
+
()
124
+
]
125
+
()
126
+
]
127
+
()
128
+
]} *)
129
+
val create :
130
+
title:string ->
131
+
?home_page_url:string ->
132
+
?feed_url:string ->
133
+
?description:string ->
134
+
?user_comment:string ->
135
+
?next_url:string ->
136
+
?icon:string ->
137
+
?favicon:string ->
138
+
?authors:Author.t list ->
139
+
?language:string ->
140
+
?expired:bool ->
141
+
?hubs:Hub.t list ->
142
+
items:Item.t list ->
143
+
unit ->
144
+
t
145
+
146
+
147
+
(** {1 Accessors} *)
148
+
149
+
(** [version t] returns the JSON Feed version URL.
150
+
151
+
This is always ["https://jsonfeed.org/version/1.1"] for feeds created
152
+
by this library, but may differ when parsing external feeds. *)
153
+
val version : t -> string
154
+
155
+
(** [title t] returns the feed's title. *)
156
+
val title : t -> string
157
+
158
+
(** [home_page_url t] returns the feed's home page URL, if set. *)
159
+
val home_page_url : t -> string option
160
+
161
+
(** [feed_url t] returns the feed's URL, if set. *)
162
+
val feed_url : t -> string option
163
+
164
+
(** [description t] returns the feed's description, if set. *)
165
+
val description : t -> string option
166
+
167
+
(** [user_comment t] returns the feed's user comment, if set. *)
168
+
val user_comment : t -> string option
169
+
170
+
(** [next_url t] returns the URL for the next page of items, if set. *)
171
+
val next_url : t -> string option
172
+
173
+
(** [icon t] returns the feed's icon URL, if set. *)
174
+
val icon : t -> string option
175
+
176
+
(** [favicon t] returns the feed's favicon URL, if set. *)
177
+
val favicon : t -> string option
178
+
179
+
(** [authors t] returns the feed's default authors, if set. *)
180
+
val authors : t -> Author.t list option
181
+
182
+
(** [language t] returns the feed's primary language, if set. *)
183
+
val language : t -> string option
184
+
185
+
(** [expired t] returns whether the feed will update again. *)
186
+
val expired : t -> bool option
187
+
188
+
(** [hubs t] returns the feed's hub endpoints, if set. *)
189
+
val hubs : t -> Hub.t list option
190
+
191
+
(** [items t] returns the feed's items. *)
192
+
val items : t -> Item.t list
193
+
194
+
195
+
(** {1 Parsing and Serialization} *)
196
+
197
+
(** Error type for parsing operations. *)
198
+
type error = [ `Msg of string ]
199
+
200
+
(** [of_jsonm decoder] parses a JSON Feed from a Jsonm decoder.
201
+
202
+
This is the lowest-level parsing function, suitable for integration
203
+
with streaming JSON processing pipelines.
204
+
205
+
@param decoder A Jsonm decoder positioned at the start of a JSON Feed document
206
+
@return [Ok feed] on success, [Error (`Msg err)] on parse error
207
+
208
+
{b Example:}
209
+
{[
210
+
let decoder = Jsonm.decoder (`String json_string) in
211
+
match Jsonfeed.of_jsonm decoder with
212
+
| Ok feed -> (* process feed *)
213
+
| Error (`Msg err) -> (* handle error *)
214
+
]} *)
215
+
val of_jsonm : Jsonm.decoder -> (t, [> error]) result
216
+
217
+
(** [to_jsonm encoder feed] serializes a JSON Feed to a Jsonm encoder.
218
+
219
+
This is the lowest-level serialization function, suitable for integration
220
+
with streaming JSON generation pipelines.
221
+
222
+
@param encoder A Jsonm encoder
223
+
@param feed The feed to serialize
224
+
225
+
{b Example:}
226
+
{[
227
+
let buffer = Buffer.create 1024 in
228
+
let encoder = Jsonm.encoder (`Buffer buffer) in
229
+
Jsonfeed.to_jsonm encoder feed;
230
+
let json = Buffer.contents buffer
231
+
]} *)
232
+
val to_jsonm : Jsonm.encoder -> t -> unit
233
+
234
+
(** [of_string s] parses a JSON Feed from a string.
235
+
236
+
@param s A JSON string containing a JSON Feed document
237
+
@return [Ok feed] on success, [Error (`Msg err)] on parse error
238
+
239
+
{b Example:}
240
+
{[
241
+
let json = {|{
242
+
"version": "https://jsonfeed.org/version/1.1",
243
+
"title": "My Feed",
244
+
"items": []
245
+
}|} in
246
+
match Jsonfeed.of_string json with
247
+
| Ok feed -> Printf.printf "Parsed: %s\n" (Jsonfeed.title feed)
248
+
| Error (`Msg err) -> Printf.eprintf "Error: %s\n" err
249
+
]} *)
250
+
val of_string : string -> (t, [> error]) result
251
+
252
+
(** [to_string ?minify feed] serializes a JSON Feed to a string.
253
+
254
+
@param minify If [true], produces compact JSON without whitespace.
255
+
If [false] (default), produces indented, human-readable JSON.
256
+
@param feed The feed to serialize
257
+
@return A JSON string
258
+
259
+
{b Example:}
260
+
{[
261
+
let json = Jsonfeed.to_string feed
262
+
let compact = Jsonfeed.to_string ~minify:true feed
263
+
]} *)
264
+
val to_string : ?minify:bool -> t -> string
265
+
266
+
267
+
(** {1 Date Utilities} *)
268
+
269
+
(** [parse_rfc3339 s] parses an RFC 3339 date/time string.
270
+
271
+
This function parses timestamps in the format required by JSON Feed,
272
+
such as ["2024-11-03T10:30:00Z"] or ["2024-11-03T10:30:00-08:00"].
273
+
274
+
@param s An RFC 3339 formatted date/time string
275
+
@return [Some time] on success, [None] if the string is invalid
276
+
277
+
{b Examples:}
278
+
{[
279
+
parse_rfc3339 "2024-11-03T10:30:00Z"
280
+
(* returns Some time *)
281
+
282
+
parse_rfc3339 "2024-11-03T10:30:00-08:00"
283
+
(* returns Some time *)
284
+
285
+
parse_rfc3339 "invalid"
286
+
(* returns None *)
287
+
]} *)
288
+
val parse_rfc3339 : string -> Ptime.t option
289
+
290
+
(** [format_rfc3339 time] formats a timestamp as an RFC 3339 string.
291
+
292
+
The output uses UTC timezone (Z suffix) and includes fractional seconds
293
+
if the timestamp has sub-second precision.
294
+
295
+
@param time A Ptime timestamp
296
+
@return An RFC 3339 formatted string
297
+
298
+
{b Example:}
299
+
{[
300
+
let now = Ptime_clock.now () in
301
+
let s = format_rfc3339 now
302
+
(* returns "2024-11-03T10:30:45.123Z" or similar *)
303
+
]} *)
304
+
val format_rfc3339 : Ptime.t -> string
305
+
306
+
307
+
(** {1 Validation} *)
308
+
309
+
(** [validate feed] validates a JSON Feed.
310
+
311
+
Checks that:
312
+
- All required fields are present
313
+
- All items have unique IDs
314
+
- All items have valid content
315
+
- All URLs are well-formed (if possible)
316
+
- Authors have at least one field set
317
+
318
+
@param feed The feed to validate
319
+
@return [Ok ()] if valid, [Error errors] with a list of validation issues
320
+
321
+
{b Example:}
322
+
{[
323
+
match Jsonfeed.validate feed with
324
+
| Ok () -> (* feed is valid *)
325
+
| Error errors ->
326
+
List.iter (Printf.eprintf "Validation error: %s\n") errors
327
+
]} *)
328
+
val validate : t -> (unit, string list) result
329
+
330
+
331
+
(** {1 Comparison} *)
332
+
333
+
(** [equal a b] tests equality between two feeds.
334
+
335
+
Feeds are compared structurally, including all fields and items. *)
336
+
val equal : t -> t -> bool
337
+
338
+
339
+
(** {1 Pretty Printing} *)
340
+
341
+
(** [pp ppf feed] pretty prints a feed to the formatter.
342
+
343
+
The output is human-readable and suitable for debugging. It shows
344
+
the feed's metadata and a summary of items.
345
+
346
+
{b Example output:}
347
+
{v
348
+
Feed: My Blog (https://example.com)
349
+
Items: 2
350
+
Authors: Jane Doe
351
+
Language: en-US
352
+
v} *)
353
+
val pp : Format.formatter -> t -> unit
354
+
355
+
(** [pp_summary ppf feed] prints a brief summary of the feed.
356
+
357
+
Shows only the title and item count.
358
+
359
+
{b Example output:}
360
+
{v My Blog (2 items) v} *)
361
+
val pp_summary : Format.formatter -> t -> unit
362
+
363
+
364
+
(** {1 Feed Content} *)
365
+
366
+
(** Author information for feeds and items. *)
367
+
module Author = Author
368
+
369
+
(** Attachments for feed items (audio, video, downloads). *)
370
+
module Attachment = Attachment
371
+
372
+
(** Hub endpoints for real-time notifications. *)
373
+
module Hub = Hub
374
+
375
+
(** Feed items (posts, episodes, entries). *)
376
+
module Item = Item
+8
test/dune
+8
test/dune
+331
test/test_jsonfeed.ml
+331
test/test_jsonfeed.ml
···
1
+
(** Tests for jsonfeed library *)
2
+
3
+
open Jsonfeed
4
+
5
+
(* Author tests *)
6
+
7
+
let test_author_create_with_name () =
8
+
let author = Author.create ~name:"Jane Doe" () in
9
+
Alcotest.(check (option string)) "name" (Some "Jane Doe") (Author.name author);
10
+
Alcotest.(check (option string)) "url" None (Author.url author);
11
+
Alcotest.(check (option string)) "avatar" None (Author.avatar author);
12
+
Alcotest.(check bool) "is_valid" true (Author.is_valid author)
13
+
14
+
let test_author_create_with_url () =
15
+
let author = Author.create ~url:"https://example.com" () in
16
+
Alcotest.(check (option string)) "name" None (Author.name author);
17
+
Alcotest.(check (option string)) "url" (Some "https://example.com") (Author.url author);
18
+
Alcotest.(check bool) "is_valid" true (Author.is_valid author)
19
+
20
+
let test_author_create_with_all_fields () =
21
+
let author = Author.create
22
+
~name:"Jane Doe"
23
+
~url:"https://example.com"
24
+
~avatar:"https://example.com/avatar.png"
25
+
() in
26
+
Alcotest.(check (option string)) "name" (Some "Jane Doe") (Author.name author);
27
+
Alcotest.(check (option string)) "url" (Some "https://example.com") (Author.url author);
28
+
Alcotest.(check (option string)) "avatar" (Some "https://example.com/avatar.png") (Author.avatar author);
29
+
Alcotest.(check bool) "is_valid" true (Author.is_valid author)
30
+
31
+
let test_author_create_no_fields_fails () =
32
+
Alcotest.check_raises "no fields"
33
+
(Invalid_argument "Author.create: at least one field (name, url, or avatar) must be provided")
34
+
(fun () -> ignore (Author.create ()))
35
+
36
+
let test_author_equal () =
37
+
let a1 = Author.create ~name:"Jane Doe" () in
38
+
let a2 = Author.create ~name:"Jane Doe" () in
39
+
let a3 = Author.create ~name:"John Smith" () in
40
+
Alcotest.(check bool) "equal same" true (Author.equal a1 a2);
41
+
Alcotest.(check bool) "equal different" false (Author.equal a1 a3)
42
+
43
+
let test_author_pp () =
44
+
let author = Author.create ~name:"Jane Doe" ~url:"https://example.com" () in
45
+
let s = Format.asprintf "%a" Author.pp author in
46
+
Alcotest.(check string) "pp with name and url" "Jane Doe <https://example.com>" s
47
+
48
+
let author_tests = [
49
+
"create with name", `Quick, test_author_create_with_name;
50
+
"create with url", `Quick, test_author_create_with_url;
51
+
"create with all fields", `Quick, test_author_create_with_all_fields;
52
+
"create with no fields fails", `Quick, test_author_create_no_fields_fails;
53
+
"equal", `Quick, test_author_equal;
54
+
"pp", `Quick, test_author_pp;
55
+
]
56
+
57
+
(* Attachment tests *)
58
+
59
+
let test_attachment_create_minimal () =
60
+
let att = Attachment.create
61
+
~url:"https://example.com/file.mp3"
62
+
~mime_type:"audio/mpeg"
63
+
() in
64
+
Alcotest.(check string) "url" "https://example.com/file.mp3" (Attachment.url att);
65
+
Alcotest.(check string) "mime_type" "audio/mpeg" (Attachment.mime_type att);
66
+
Alcotest.(check (option string)) "title" None (Attachment.title att);
67
+
Alcotest.(check (option int64)) "size_in_bytes" None (Attachment.size_in_bytes att);
68
+
Alcotest.(check (option int)) "duration_in_seconds" None (Attachment.duration_in_seconds att)
69
+
70
+
let test_attachment_create_complete () =
71
+
let att = Attachment.create
72
+
~url:"https://example.com/episode.mp3"
73
+
~mime_type:"audio/mpeg"
74
+
~title:"Episode 1"
75
+
~size_in_bytes:15_728_640L
76
+
~duration_in_seconds:1800
77
+
() in
78
+
Alcotest.(check string) "url" "https://example.com/episode.mp3" (Attachment.url att);
79
+
Alcotest.(check string) "mime_type" "audio/mpeg" (Attachment.mime_type att);
80
+
Alcotest.(check (option string)) "title" (Some "Episode 1") (Attachment.title att);
81
+
Alcotest.(check (option int64)) "size_in_bytes" (Some 15_728_640L) (Attachment.size_in_bytes att);
82
+
Alcotest.(check (option int)) "duration_in_seconds" (Some 1800) (Attachment.duration_in_seconds att)
83
+
84
+
let test_attachment_equal () =
85
+
let a1 = Attachment.create
86
+
~url:"https://example.com/file.mp3"
87
+
~mime_type:"audio/mpeg"
88
+
() in
89
+
let a2 = Attachment.create
90
+
~url:"https://example.com/file.mp3"
91
+
~mime_type:"audio/mpeg"
92
+
() in
93
+
let a3 = Attachment.create
94
+
~url:"https://example.com/other.mp3"
95
+
~mime_type:"audio/mpeg"
96
+
() in
97
+
Alcotest.(check bool) "equal same" true (Attachment.equal a1 a2);
98
+
Alcotest.(check bool) "equal different" false (Attachment.equal a1 a3)
99
+
100
+
let attachment_tests = [
101
+
"create minimal", `Quick, test_attachment_create_minimal;
102
+
"create complete", `Quick, test_attachment_create_complete;
103
+
"equal", `Quick, test_attachment_equal;
104
+
]
105
+
106
+
(* Hub tests *)
107
+
108
+
let test_hub_create () =
109
+
let hub = Hub.create ~type_:"WebSub" ~url:"https://example.com/hub" () in
110
+
Alcotest.(check string) "type_" "WebSub" (Hub.type_ hub);
111
+
Alcotest.(check string) "url" "https://example.com/hub" (Hub.url hub)
112
+
113
+
let test_hub_equal () =
114
+
let h1 = Hub.create ~type_:"WebSub" ~url:"https://example.com/hub" () in
115
+
let h2 = Hub.create ~type_:"WebSub" ~url:"https://example.com/hub" () in
116
+
let h3 = Hub.create ~type_:"rssCloud" ~url:"https://example.com/hub" () in
117
+
Alcotest.(check bool) "equal same" true (Hub.equal h1 h2);
118
+
Alcotest.(check bool) "equal different" false (Hub.equal h1 h3)
119
+
120
+
let hub_tests = [
121
+
"create", `Quick, test_hub_create;
122
+
"equal", `Quick, test_hub_equal;
123
+
]
124
+
125
+
(* Item tests *)
126
+
127
+
let test_item_create_html () =
128
+
let item = Item.create
129
+
~id:"https://example.com/1"
130
+
~content:(`Html "<p>Hello</p>")
131
+
() in
132
+
Alcotest.(check string) "id" "https://example.com/1" (Item.id item);
133
+
Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item);
134
+
Alcotest.(check (option string)) "content_text" None (Item.content_text item)
135
+
136
+
let test_item_create_text () =
137
+
let item = Item.create
138
+
~id:"https://example.com/2"
139
+
~content:(`Text "Hello world")
140
+
() in
141
+
Alcotest.(check string) "id" "https://example.com/2" (Item.id item);
142
+
Alcotest.(check (option string)) "content_html" None (Item.content_html item);
143
+
Alcotest.(check (option string)) "content_text" (Some "Hello world") (Item.content_text item)
144
+
145
+
let test_item_create_both () =
146
+
let item = Item.create
147
+
~id:"https://example.com/3"
148
+
~content:(`Both ("<p>Hello</p>", "Hello"))
149
+
() in
150
+
Alcotest.(check string) "id" "https://example.com/3" (Item.id item);
151
+
Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item);
152
+
Alcotest.(check (option string)) "content_text" (Some "Hello") (Item.content_text item)
153
+
154
+
let test_item_with_metadata () =
155
+
let item = Item.create
156
+
~id:"https://example.com/4"
157
+
~content:(`Html "<p>Test</p>")
158
+
~title:"Test Post"
159
+
~url:"https://example.com/posts/4"
160
+
~tags:["test"; "example"]
161
+
() in
162
+
Alcotest.(check (option string)) "title" (Some "Test Post") (Item.title item);
163
+
Alcotest.(check (option string)) "url" (Some "https://example.com/posts/4") (Item.url item);
164
+
Alcotest.(check (option (list string))) "tags" (Some ["test"; "example"]) (Item.tags item)
165
+
166
+
let test_item_equal () =
167
+
let i1 = Item.create ~id:"https://example.com/1" ~content:(`Text "test") () in
168
+
let i2 = Item.create ~id:"https://example.com/1" ~content:(`Html "<p>test</p>") () in
169
+
let i3 = Item.create ~id:"https://example.com/2" ~content:(`Text "test") () in
170
+
Alcotest.(check bool) "equal same id" true (Item.equal i1 i2);
171
+
Alcotest.(check bool) "equal different id" false (Item.equal i1 i3)
172
+
173
+
let item_tests = [
174
+
"create with HTML content", `Quick, test_item_create_html;
175
+
"create with text content", `Quick, test_item_create_text;
176
+
"create with both contents", `Quick, test_item_create_both;
177
+
"create with metadata", `Quick, test_item_with_metadata;
178
+
"equal", `Quick, test_item_equal;
179
+
]
180
+
181
+
(* Jsonfeed tests *)
182
+
183
+
let test_feed_create_minimal () =
184
+
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in
185
+
Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed);
186
+
Alcotest.(check string) "version" "https://jsonfeed.org/version/1.1" (Jsonfeed.version feed);
187
+
Alcotest.(check int) "items length" 0 (List.length (Jsonfeed.items feed))
188
+
189
+
let test_feed_create_with_items () =
190
+
let item = Item.create
191
+
~id:"https://example.com/1"
192
+
~content:(`Text "Hello")
193
+
() in
194
+
let feed = Jsonfeed.create
195
+
~title:"Test Feed"
196
+
~items:[item]
197
+
() in
198
+
Alcotest.(check int) "items length" 1 (List.length (Jsonfeed.items feed))
199
+
200
+
let test_feed_validate_valid () =
201
+
let feed = Jsonfeed.create ~title:"Test" ~items:[] () in
202
+
match Jsonfeed.validate feed with
203
+
| Ok () -> ()
204
+
| Error errors ->
205
+
Alcotest.fail (Printf.sprintf "Validation should succeed: %s"
206
+
(String.concat "; " errors))
207
+
208
+
let test_feed_validate_empty_title () =
209
+
let feed = Jsonfeed.create ~title:"" ~items:[] () in
210
+
match Jsonfeed.validate feed with
211
+
| Ok () -> Alcotest.fail "Should fail validation"
212
+
| Error errors ->
213
+
Alcotest.(check bool) "has error" true
214
+
(List.exists (fun s -> String.starts_with ~prefix:"title" s) errors)
215
+
216
+
let contains_substring s sub =
217
+
try
218
+
let _ = Str.search_forward (Str.regexp_string sub) s 0 in
219
+
true
220
+
with Not_found -> false
221
+
222
+
let test_feed_to_string () =
223
+
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in
224
+
let json = Jsonfeed.to_string feed in
225
+
Alcotest.(check bool) "contains version" true (contains_substring json "version");
226
+
Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed")
227
+
228
+
let test_feed_parse_minimal () =
229
+
let json = {|{
230
+
"version": "https://jsonfeed.org/version/1.1",
231
+
"title": "Test Feed",
232
+
"items": []
233
+
}|} in
234
+
match Jsonfeed.of_string json with
235
+
| Ok feed ->
236
+
Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed);
237
+
Alcotest.(check int) "items" 0 (List.length (Jsonfeed.items feed))
238
+
| Error (`Msg err) ->
239
+
Alcotest.fail (Printf.sprintf "Parse failed: %s" err)
240
+
241
+
let test_feed_parse_with_item () =
242
+
let json = {|{
243
+
"version": "https://jsonfeed.org/version/1.1",
244
+
"title": "Test Feed",
245
+
"items": [
246
+
{
247
+
"id": "https://example.com/1",
248
+
"content_html": "<p>Hello</p>"
249
+
}
250
+
]
251
+
}|} in
252
+
match Jsonfeed.of_string json with
253
+
| Ok feed ->
254
+
let items = Jsonfeed.items feed in
255
+
Alcotest.(check int) "items count" 1 (List.length items);
256
+
(match items with
257
+
| [item] ->
258
+
Alcotest.(check string) "item id" "https://example.com/1" (Item.id item);
259
+
Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item)
260
+
| _ -> Alcotest.fail "Expected 1 item")
261
+
| Error (`Msg err) ->
262
+
Alcotest.fail (Printf.sprintf "Parse failed: %s" err)
263
+
264
+
let test_feed_roundtrip () =
265
+
let author = Author.create ~name:"Test Author" () in
266
+
let item = Item.create
267
+
~id:"https://example.com/1"
268
+
~title:"Test Item"
269
+
~content:(`Html "<p>Hello, world!</p>")
270
+
~date_published:(Jsonfeed.parse_rfc3339 "2024-11-01T10:00:00Z" |> Option.get)
271
+
~tags:["test"; "example"]
272
+
() in
273
+
274
+
let feed1 = Jsonfeed.create
275
+
~title:"Test Feed"
276
+
~home_page_url:"https://example.com"
277
+
~authors:[author]
278
+
~items:[item]
279
+
() in
280
+
281
+
(* Serialize and parse *)
282
+
let json = Jsonfeed.to_string feed1 in
283
+
match Jsonfeed.of_string json with
284
+
| Ok feed2 ->
285
+
Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2);
286
+
Alcotest.(check (option string)) "home_page_url"
287
+
(Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2);
288
+
Alcotest.(check int) "items count"
289
+
(List.length (Jsonfeed.items feed1))
290
+
(List.length (Jsonfeed.items feed2))
291
+
| Error (`Msg err) ->
292
+
Alcotest.fail (Printf.sprintf "Round-trip failed: %s" err)
293
+
294
+
let test_feed_parse_invalid_missing_content () =
295
+
let json = {|{
296
+
"version": "https://jsonfeed.org/version/1.1",
297
+
"title": "Test",
298
+
"items": [
299
+
{
300
+
"id": "1"
301
+
}
302
+
]
303
+
}|} in
304
+
match Jsonfeed.of_string json with
305
+
| Ok _ -> Alcotest.fail "Should reject item without content"
306
+
| Error (`Msg err) ->
307
+
Alcotest.(check bool) "has error" true
308
+
(contains_substring err "content")
309
+
310
+
let jsonfeed_tests = [
311
+
"create minimal feed", `Quick, test_feed_create_minimal;
312
+
"create feed with items", `Quick, test_feed_create_with_items;
313
+
"validate valid feed", `Quick, test_feed_validate_valid;
314
+
"validate empty title", `Quick, test_feed_validate_empty_title;
315
+
"to_string", `Quick, test_feed_to_string;
316
+
"parse minimal feed", `Quick, test_feed_parse_minimal;
317
+
"parse feed with item", `Quick, test_feed_parse_with_item;
318
+
"round-trip", `Quick, test_feed_roundtrip;
319
+
"parse invalid missing content", `Quick, test_feed_parse_invalid_missing_content;
320
+
]
321
+
322
+
(* Main test suite *)
323
+
324
+
let () =
325
+
Alcotest.run "jsonfeed" [
326
+
"Author", author_tests;
327
+
"Attachment", attachment_tests;
328
+
"Hub", hub_tests;
329
+
"Item", item_tests;
330
+
"Jsonfeed", jsonfeed_tests;
331
+
]
+32
test/test_serialization.ml
+32
test/test_serialization.ml
···
1
+
(** Simple test to demonstrate JSON serialization works *)
2
+
3
+
open Jsonfeed
4
+
5
+
let () =
6
+
(* Create a simple feed *)
7
+
let author = Author.create ~name:"Test Author" () in
8
+
let item = Item.create
9
+
~id:"https://example.com/1"
10
+
~title:"Test Item"
11
+
~content:(`Html "<p>Hello, world!</p>")
12
+
() in
13
+
14
+
let feed = Jsonfeed.create
15
+
~title:"Test Feed"
16
+
~home_page_url:"https://example.com"
17
+
~authors:[author]
18
+
~items:[item]
19
+
() in
20
+
21
+
(* Serialize to JSON *)
22
+
let json = Jsonfeed.to_string feed in
23
+
24
+
(* Print it *)
25
+
Printf.printf "Generated JSON Feed:\n%s\n\n" json;
26
+
27
+
(* Validate *)
28
+
match Jsonfeed.validate feed with
29
+
| Ok () -> Printf.printf "✓ Feed is valid\n"
30
+
| Error errors ->
31
+
Printf.printf "✗ Feed has errors:\n";
32
+
List.iter (Printf.printf " - %s\n") errors
test/test_serialization.mli
test/test_serialization.mli
This is a binary file and will not be displayed.